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 bindkey
<F5
> updatecommits
724 bind .
<Control-q
> doquit
725 bind .
<Control-f
> dofind
726 bind .
<Control-g
> {findnext
0}
727 bind .
<Control-r
> dosearchback
728 bind .
<Control-s
> dosearch
729 bind .
<Control-equal
> {incrfont
1}
730 bind .
<Control-KP_Add
> {incrfont
1}
731 bind .
<Control-minus
> {incrfont
-1}
732 bind .
<Control-KP_Subtract
> {incrfont
-1}
733 wm protocol . WM_DELETE_WINDOW doquit
734 bind .
<Button-1
> "click %W"
735 bind $fstring <Key-Return
> dofind
736 bind $sha1entry <Key-Return
> gotocommit
737 bind $sha1entry <<PasteSelection>> clearsha1
738 bind $cflist <1> {sel_flist %W %x %y; break}
739 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
740 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
742 set maincursor [. cget -cursor]
743 set textcursor [$ctext cget -cursor]
744 set curtextcursor $textcursor
746 set rowctxmenu .rowctxmenu
747 menu $rowctxmenu -tearoff 0
748 $rowctxmenu add command -label "Diff this -> selected" \
749 -command {diffvssel 0}
750 $rowctxmenu add command -label "Diff selected -> this" \
751 -command {diffvssel 1}
752 $rowctxmenu add command -label "Make patch" -command mkpatch
753 $rowctxmenu add command -label "Create tag" -command mktag
754 $rowctxmenu add command -label "Write commit to file" -command writecommit
755 $rowctxmenu add command -label "Create new branch" -command mkbranch
756 $rowctxmenu add command -label "Cherry-pick this commit" \
759 set headctxmenu .headctxmenu
760 menu $headctxmenu -tearoff 0
761 $headctxmenu add command -label "Check out this branch" \
763 $headctxmenu add command -label "Remove this branch" \
767 # mouse-2 makes all windows scan vertically, but only the one
768 # the cursor is in scans horizontally
769 proc canvscan {op w x y} {
770 global canv canv2 canv3
771 foreach c [list $canv $canv2 $canv3] {
780 proc scrollcanv {cscroll f0 f1} {
786 # when we make a key binding for the toplevel, make sure
787 # it doesn't get triggered when that key is pressed in the
788 # find string entry widget.
789 proc bindkey {ev script} {
792 set escript [bind Entry $ev]
793 if {$escript == {}} {
794 set escript [bind Entry <Key>]
797 bind $e $ev "$escript; break"
801 # set the focus back to the toplevel for any click outside
812 global canv canv2 canv3 ctext cflist mainfont textfont uifont
813 global stuffsaved findmergefiles maxgraphpct
814 global maxwidth showneartags
815 global viewname viewfiles viewargs viewperm nextviewnum
816 global cmitmode wrapcomment
817 global colors bgcolor fgcolor diffcolors
819 if {$stuffsaved} return
820 if {![winfo viewable .]} return
822 set f [open "~/.gitk-new" w]
823 puts $f [list set mainfont $mainfont]
824 puts $f [list set textfont $textfont]
825 puts $f [list set uifont $uifont]
826 puts $f [list set findmergefiles $findmergefiles]
827 puts $f [list set maxgraphpct $maxgraphpct]
828 puts $f [list set maxwidth $maxwidth]
829 puts $f [list set cmitmode $cmitmode]
830 puts $f [list set wrapcomment $wrapcomment]
831 puts $f [list set showneartags $showneartags]
832 puts $f [list set bgcolor $bgcolor]
833 puts $f [list set fgcolor $fgcolor]
834 puts $f [list set colors $colors]
835 puts $f [list set diffcolors $diffcolors]
837 puts $f "set geometry(main) [wm geometry .]"
838 puts $f "set geometry(topwidth) [winfo width .tf]"
839 puts $f "set geometry(topheight) [winfo height .tf]"
840 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
841 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
842 puts $f "set geometry(botwidth) [winfo width .bleft]"
843 puts $f "set geometry(botheight) [winfo height .bleft]"
845 puts -nonewline $f "set permviews {"
846 for {set v 0} {$v < $nextviewnum} {incr v} {
848 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
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
991 -justify left -bg white -border 2 -relief sunken
992 pack $w.m -side top -fill both
993 button $w.ok -text Close -command "destroy $w"
994 pack $w.ok -side bottom
997 # Procedures for manipulating the file list window at the
998 # bottom right of the overall window.
1000 proc treeview {w l openlevs} {
1001 global treecontents treediropen treeheight treeparent treeindex
1011 set treecontents() {}
1012 $w conf -state normal
1014 while {[string range $f 0 $prefixend] ne $prefix} {
1015 if {$lev <= $openlevs} {
1016 $w mark set e:$treeindex($prefix) "end -1c"
1017 $w mark gravity e:$treeindex($prefix) left
1019 set treeheight($prefix) $ht
1020 incr ht [lindex $htstack end]
1021 set htstack [lreplace $htstack end end]
1022 set prefixend [lindex $prefendstack end]
1023 set prefendstack [lreplace $prefendstack end end]
1024 set prefix [string range $prefix 0 $prefixend]
1027 set tail [string range $f [expr {$prefixend+1}] end]
1028 while {[set slash [string first "/" $tail]] >= 0} {
1031 lappend prefendstack $prefixend
1032 incr prefixend [expr {$slash + 1}]
1033 set d [string range $tail 0 $slash]
1034 lappend treecontents($prefix) $d
1035 set oldprefix $prefix
1037 set treecontents($prefix) {}
1038 set treeindex($prefix) [incr ix]
1039 set treeparent($prefix) $oldprefix
1040 set tail [string range $tail [expr {$slash+1}] end]
1041 if {$lev <= $openlevs} {
1043 set treediropen($prefix) [expr {$lev < $openlevs}]
1044 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1045 $w mark set d:$ix "end -1c"
1046 $w mark gravity d:$ix left
1048 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1050 $w image create end -align center -image $bm -padx 1 \
1052 $w insert end $d [highlight_tag $prefix]
1053 $w mark set s:$ix "end -1c"
1054 $w mark gravity s:$ix left
1059 if {$lev <= $openlevs} {
1062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1064 $w insert end $tail [highlight_tag $f]
1066 lappend treecontents($prefix) $tail
1069 while {$htstack ne {}} {
1070 set treeheight($prefix) $ht
1071 incr ht [lindex $htstack end]
1072 set htstack [lreplace $htstack end end]
1074 $w conf -state disabled
1077 proc linetoelt {l} {
1078 global treeheight treecontents
1083 foreach e $treecontents($prefix) {
1088 if {[string index $e end] eq "/"} {
1089 set n $treeheight($prefix$e)
1101 proc highlight_tree {y prefix} {
1102 global treeheight treecontents cflist
1104 foreach e $treecontents($prefix) {
1106 if {[highlight_tag $path] ne {}} {
1107 $cflist tag add bold $y.0 "$y.0 lineend"
1110 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1111 set y [highlight_tree $y $path]
1117 proc treeclosedir {w dir} {
1118 global treediropen treeheight treeparent treeindex
1120 set ix $treeindex($dir)
1121 $w conf -state normal
1122 $w delete s:$ix e:$ix
1123 set treediropen($dir) 0
1124 $w image configure a:$ix -image tri-rt
1125 $w conf -state disabled
1126 set n [expr {1 - $treeheight($dir)}]
1127 while {$dir ne {}} {
1128 incr treeheight($dir) $n
1129 set dir $treeparent($dir)
1133 proc treeopendir {w dir} {
1134 global treediropen treeheight treeparent treecontents treeindex
1136 set ix $treeindex($dir)
1137 $w conf -state normal
1138 $w image configure a:$ix -image tri-dn
1139 $w mark set e:$ix s:$ix
1140 $w mark gravity e:$ix right
1143 set n [llength $treecontents($dir)]
1144 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1147 incr treeheight($x) $n
1149 foreach e $treecontents($dir) {
1151 if {[string index $e end] eq "/"} {
1152 set iy $treeindex($de)
1153 $w mark set d:$iy e:$ix
1154 $w mark gravity d:$iy left
1155 $w insert e:$ix $str
1156 set treediropen($de) 0
1157 $w image create e:$ix -align center -image tri-rt -padx 1 \
1159 $w insert e:$ix $e [highlight_tag $de]
1160 $w mark set s:$iy e:$ix
1161 $w mark gravity s:$iy left
1162 set treeheight($de) 1
1164 $w insert e:$ix $str
1165 $w insert e:$ix $e [highlight_tag $de]
1168 $w mark gravity e:$ix left
1169 $w conf -state disabled
1170 set treediropen($dir) 1
1171 set top [lindex [split [$w index @0,0] .] 0]
1172 set ht [$w cget -height]
1173 set l [lindex [split [$w index s:$ix] .] 0]
1176 } elseif {$l + $n + 1 > $top + $ht} {
1177 set top [expr {$l + $n + 2 - $ht}]
1185 proc treeclick {w x y} {
1186 global treediropen cmitmode ctext cflist cflist_top
1188 if {$cmitmode ne "tree"} return
1189 if {![info exists cflist_top]} return
1190 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1191 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1192 $cflist tag add highlight $l.0 "$l.0 lineend"
1198 set e [linetoelt $l]
1199 if {[string index $e end] ne "/"} {
1201 } elseif {$treediropen($e)} {
1208 proc setfilelist {id} {
1209 global treefilelist cflist
1211 treeview $cflist $treefilelist($id) 0
1214 image create bitmap tri-rt -background black -foreground blue -data {
1215 #define tri-rt_width 13
1216 #define tri-rt_height 13
1217 static unsigned char tri-rt_bits[] = {
1218 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1219 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1222 #define tri-rt-mask_width 13
1223 #define tri-rt-mask_height 13
1224 static unsigned char tri-rt-mask_bits[] = {
1225 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1226 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1229 image create bitmap tri-dn -background black -foreground blue -data {
1230 #define tri-dn_width 13
1231 #define tri-dn_height 13
1232 static unsigned char tri-dn_bits[] = {
1233 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1234 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1237 #define tri-dn-mask_width 13
1238 #define tri-dn-mask_height 13
1239 static unsigned char tri-dn-mask_bits[] = {
1240 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1241 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1245 proc init_flist {first} {
1246 global cflist cflist_top selectedline difffilestart
1248 $cflist conf -state normal
1249 $cflist delete 0.0 end
1251 $cflist insert end $first
1253 $cflist tag add highlight 1.0 "1.0 lineend"
1255 catch {unset cflist_top}
1257 $cflist conf -state disabled
1258 set difffilestart {}
1261 proc highlight_tag {f} {
1262 global highlight_paths
1264 foreach p $highlight_paths {
1265 if {[string match $p $f]} {
1272 proc highlight_filelist {} {
1273 global cmitmode cflist
1275 $cflist conf -state normal
1276 if {$cmitmode ne "tree"} {
1277 set end [lindex [split [$cflist index end] .] 0]
1278 for {set l 2} {$l < $end} {incr l} {
1279 set line [$cflist get $l.0 "$l.0 lineend"]
1280 if {[highlight_tag $line] ne {}} {
1281 $cflist tag add bold $l.0 "$l.0 lineend"
1287 $cflist conf -state disabled
1290 proc unhighlight_filelist {} {
1293 $cflist conf -state normal
1294 $cflist tag remove bold 1.0 end
1295 $cflist conf -state disabled
1298 proc add_flist {fl} {
1301 $cflist conf -state normal
1303 $cflist insert end "\n"
1304 $cflist insert end $f [highlight_tag $f]
1306 $cflist conf -state disabled
1309 proc sel_flist {w x y} {
1310 global ctext difffilestart cflist cflist_top cmitmode
1312 if {$cmitmode eq "tree"} return
1313 if {![info exists cflist_top]} return
1314 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1315 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1316 $cflist tag add highlight $l.0 "$l.0 lineend"
1321 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1325 # Functions for adding and removing shell-type quoting
1327 proc shellquote {str} {
1328 if {![string match "*\['\"\\ \t]*" $str]} {
1331 if {![string match "*\['\"\\]*" $str]} {
1334 if {![string match "*'*" $str]} {
1337 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1340 proc shellarglist {l} {
1346 append str [shellquote $a]
1351 proc shelldequote {str} {
1356 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1357 append ret [string range $str $used end]
1358 set used [string length $str]
1361 set first [lindex $first 0]
1362 set ch [string index $str $first]
1363 if {$first > $used} {
1364 append ret [string range $str $used [expr {$first - 1}]]
1367 if {$ch eq " " || $ch eq "\t"} break
1370 set first [string first "'" $str $used]
1372 error "unmatched single-quote"
1374 append ret [string range $str $used [expr {$first - 1}]]
1379 if {$used >= [string length $str]} {
1380 error "trailing backslash"
1382 append ret [string index $str $used]
1387 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1388 error "unmatched double-quote"
1390 set first [lindex $first 0]
1391 set ch [string index $str $first]
1392 if {$first > $used} {
1393 append ret [string range $str $used [expr {$first - 1}]]
1396 if {$ch eq "\""} break
1398 append ret [string index $str $used]
1402 return [list $used $ret]
1405 proc shellsplit {str} {
1408 set str [string trimleft $str]
1409 if {$str eq {}} break
1410 set dq [shelldequote $str]
1411 set n [lindex $dq 0]
1412 set word [lindex $dq 1]
1413 set str [string range $str $n end]
1419 # Code to implement multiple views
1421 proc newview {ishighlight} {
1422 global nextviewnum newviewname newviewperm uifont newishighlight
1423 global newviewargs revtreeargs
1425 set newishighlight $ishighlight
1427 if {[winfo exists $top]} {
1431 set newviewname($nextviewnum) "View $nextviewnum"
1432 set newviewperm($nextviewnum) 0
1433 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1434 vieweditor $top $nextviewnum "Gitk view definition"
1439 global viewname viewperm newviewname newviewperm
1440 global viewargs newviewargs
1442 set top .gitkvedit-$curview
1443 if {[winfo exists $top]} {
1447 set newviewname($curview) $viewname($curview)
1448 set newviewperm($curview) $viewperm($curview)
1449 set newviewargs($curview) [shellarglist $viewargs($curview)]
1450 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1453 proc vieweditor {top n title} {
1454 global newviewname newviewperm viewfiles
1458 wm title $top $title
1459 label $top.nl -text "Name" -font $uifont
1460 entry $top.name -width 20 -textvariable newviewname($n)
1461 grid $top.nl $top.name -sticky w -pady 5
1462 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1463 grid $top.perm - -pady 5 -sticky w
1464 message $top.al -aspect 1000 -font $uifont \
1465 -text "Commits to include (arguments to git rev-list):"
1466 grid $top.al - -sticky w -pady 5
1467 entry $top.args -width 50 -textvariable newviewargs($n) \
1469 grid $top.args - -sticky ew -padx 5
1470 message $top.l -aspect 1000 -font $uifont \
1471 -text "Enter files and directories to include, one per line:"
1472 grid $top.l - -sticky w
1473 text $top.t -width 40 -height 10 -background white
1474 if {[info exists viewfiles($n)]} {
1475 foreach f $viewfiles($n) {
1476 $top.t insert end $f
1477 $top.t insert end "\n"
1479 $top.t delete {end - 1c} end
1480 $top.t mark set insert 0.0
1482 grid $top.t - -sticky ew -padx 5
1484 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1485 button $top.buts.can -text "Cancel" -command [list destroy $top]
1486 grid $top.buts.ok $top.buts.can
1487 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1488 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1489 grid $top.buts - -pady 10 -sticky ew
1493 proc doviewmenu {m first cmd op argv} {
1494 set nmenu [$m index end]
1495 for {set i $first} {$i <= $nmenu} {incr i} {
1496 if {[$m entrycget $i -command] eq $cmd} {
1497 eval $m $op $i $argv
1503 proc allviewmenus {n op args} {
1506 doviewmenu .bar.view 5 [list showview $n] $op $args
1507 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1510 proc newviewok {top n} {
1511 global nextviewnum newviewperm newviewname newishighlight
1512 global viewname viewfiles viewperm selectedview curview
1513 global viewargs newviewargs viewhlmenu
1516 set newargs [shellsplit $newviewargs($n)]
1518 error_popup "Error in commit selection arguments: $err"
1524 foreach f [split [$top.t get 0.0 end] "\n"] {
1525 set ft [string trim $f]
1530 if {![info exists viewfiles($n)]} {
1531 # creating a new view
1533 set viewname($n) $newviewname($n)
1534 set viewperm($n) $newviewperm($n)
1535 set viewfiles($n) $files
1536 set viewargs($n) $newargs
1538 if {!$newishighlight} {
1539 after idle showview $n
1541 after idle addvhighlight $n
1544 # editing an existing view
1545 set viewperm($n) $newviewperm($n)
1546 if {$newviewname($n) ne $viewname($n)} {
1547 set viewname($n) $newviewname($n)
1548 doviewmenu .bar.view 5 [list showview $n] \
1549 entryconf [list -label $viewname($n)]
1550 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1551 entryconf [list -label $viewname($n) -value $viewname($n)]
1553 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1554 set viewfiles($n) $files
1555 set viewargs($n) $newargs
1556 if {$curview == $n} {
1557 after idle updatecommits
1561 catch {destroy $top}
1565 global curview viewdata viewperm hlview selectedhlview
1567 if {$curview == 0} return
1568 if {[info exists hlview] && $hlview == $curview} {
1569 set selectedhlview None
1572 allviewmenus $curview delete
1573 set viewdata($curview) {}
1574 set viewperm($curview) 0
1578 proc addviewmenu {n} {
1579 global viewname viewhlmenu
1581 .bar.view add radiobutton -label $viewname($n) \
1582 -command [list showview $n] -variable selectedview -value $n
1583 $viewhlmenu add radiobutton -label $viewname($n) \
1584 -command [list addvhighlight $n] -variable selectedhlview
1587 proc flatten {var} {
1591 foreach i [array names $var] {
1592 lappend ret $i [set $var\($i\)]
1597 proc unflatten {var l} {
1607 global curview viewdata viewfiles
1608 global displayorder parentlist childlist rowidlist rowoffsets
1609 global colormap rowtextx commitrow nextcolor canvxmax
1610 global numcommits rowrangelist commitlisted idrowranges
1611 global selectedline currentid canv canvy0
1612 global matchinglines treediffs
1613 global pending_select phase
1614 global commitidx rowlaidout rowoptim linesegends
1615 global commfd nextupdate
1617 global vparentlist vchildlist vdisporder vcmitlisted
1618 global hlview selectedhlview
1620 if {$n == $curview} return
1622 if {[info exists selectedline]} {
1623 set selid $currentid
1624 set y [yc $selectedline]
1625 set ymax [lindex [$canv cget -scrollregion] 3]
1626 set span [$canv yview]
1627 set ytop [expr {[lindex $span 0] * $ymax}]
1628 set ybot [expr {[lindex $span 1] * $ymax}]
1629 if {$ytop < $y && $y < $ybot} {
1630 set yscreen [expr {$y - $ytop}]
1632 set yscreen [expr {($ybot - $ytop) / 2}]
1638 if {$curview >= 0} {
1639 set vparentlist($curview) $parentlist
1640 set vchildlist($curview) $childlist
1641 set vdisporder($curview) $displayorder
1642 set vcmitlisted($curview) $commitlisted
1644 set viewdata($curview) \
1645 [list $phase $rowidlist $rowoffsets $rowrangelist \
1646 [flatten idrowranges] [flatten idinlist] \
1647 $rowlaidout $rowoptim $numcommits $linesegends]
1648 } elseif {![info exists viewdata($curview)]
1649 || [lindex $viewdata($curview) 0] ne {}} {
1650 set viewdata($curview) \
1651 [list {} $rowidlist $rowoffsets $rowrangelist]
1654 catch {unset matchinglines}
1655 catch {unset treediffs}
1657 if {[info exists hlview] && $hlview == $n} {
1659 set selectedhlview None
1664 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1665 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1667 if {![info exists viewdata($n)]} {
1668 set pending_select $selid
1674 set phase [lindex $v 0]
1675 set displayorder $vdisporder($n)
1676 set parentlist $vparentlist($n)
1677 set childlist $vchildlist($n)
1678 set commitlisted $vcmitlisted($n)
1679 set rowidlist [lindex $v 1]
1680 set rowoffsets [lindex $v 2]
1681 set rowrangelist [lindex $v 3]
1683 set numcommits [llength $displayorder]
1684 catch {unset idrowranges}
1686 unflatten idrowranges [lindex $v 4]
1687 unflatten idinlist [lindex $v 5]
1688 set rowlaidout [lindex $v 6]
1689 set rowoptim [lindex $v 7]
1690 set numcommits [lindex $v 8]
1691 set linesegends [lindex $v 9]
1694 catch {unset colormap}
1695 catch {unset rowtextx}
1697 set canvxmax [$canv cget -width]
1703 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1704 set row $commitrow($n,$selid)
1705 # try to get the selected row in the same position on the screen
1706 set ymax [lindex [$canv cget -scrollregion] 3]
1707 set ytop [expr {[yc $row] - $yscreen}]
1711 set yf [expr {$ytop * 1.0 / $ymax}]
1713 allcanvs yview moveto $yf
1717 if {$phase eq "getcommits"} {
1718 show_status "Reading commits..."
1720 if {[info exists commfd($n)]} {
1725 } elseif {$numcommits == 0} {
1726 show_status "No commits selected"
1730 # Stuff relating to the highlighting facility
1732 proc ishighlighted {row} {
1733 global vhighlights fhighlights nhighlights rhighlights
1735 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1736 return $nhighlights($row)
1738 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1739 return $vhighlights($row)
1741 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1742 return $fhighlights($row)
1744 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1745 return $rhighlights($row)
1750 proc bolden {row font} {
1751 global canv linehtag selectedline boldrows
1753 lappend boldrows $row
1754 $canv itemconf $linehtag($row) -font $font
1755 if {[info exists selectedline] && $row == $selectedline} {
1757 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1758 -outline {{}} -tags secsel \
1759 -fill [$canv cget -selectbackground]]
1764 proc bolden_name {row font} {
1765 global canv2 linentag selectedline boldnamerows
1767 lappend boldnamerows $row
1768 $canv2 itemconf $linentag($row) -font $font
1769 if {[info exists selectedline] && $row == $selectedline} {
1770 $canv2 delete secsel
1771 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1772 -outline {{}} -tags secsel \
1773 -fill [$canv2 cget -selectbackground]]
1779 global mainfont boldrows
1782 foreach row $boldrows {
1783 if {![ishighlighted $row]} {
1784 bolden $row $mainfont
1786 lappend stillbold $row
1789 set boldrows $stillbold
1792 proc addvhighlight {n} {
1793 global hlview curview viewdata vhl_done vhighlights commitidx
1795 if {[info exists hlview]} {
1799 if {$n != $curview && ![info exists viewdata($n)]} {
1800 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1801 set vparentlist($n) {}
1802 set vchildlist($n) {}
1803 set vdisporder($n) {}
1804 set vcmitlisted($n) {}
1807 set vhl_done $commitidx($hlview)
1808 if {$vhl_done > 0} {
1813 proc delvhighlight {} {
1814 global hlview vhighlights
1816 if {![info exists hlview]} return
1818 catch {unset vhighlights}
1822 proc vhighlightmore {} {
1823 global hlview vhl_done commitidx vhighlights
1824 global displayorder vdisporder curview mainfont
1826 set font [concat $mainfont bold]
1827 set max $commitidx($hlview)
1828 if {$hlview == $curview} {
1829 set disp $displayorder
1831 set disp $vdisporder($hlview)
1833 set vr [visiblerows]
1834 set r0 [lindex $vr 0]
1835 set r1 [lindex $vr 1]
1836 for {set i $vhl_done} {$i < $max} {incr i} {
1837 set id [lindex $disp $i]
1838 if {[info exists commitrow($curview,$id)]} {
1839 set row $commitrow($curview,$id)
1840 if {$r0 <= $row && $row <= $r1} {
1841 if {![highlighted $row]} {
1844 set vhighlights($row) 1
1851 proc askvhighlight {row id} {
1852 global hlview vhighlights commitrow iddrawn mainfont
1854 if {[info exists commitrow($hlview,$id)]} {
1855 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1856 bolden $row [concat $mainfont bold]
1858 set vhighlights($row) 1
1860 set vhighlights($row) 0
1864 proc hfiles_change {name ix op} {
1865 global highlight_files filehighlight fhighlights fh_serial
1866 global mainfont highlight_paths
1868 if {[info exists filehighlight]} {
1869 # delete previous highlights
1870 catch {close $filehighlight}
1872 catch {unset fhighlights}
1874 unhighlight_filelist
1876 set highlight_paths {}
1877 after cancel do_file_hl $fh_serial
1879 if {$highlight_files ne {}} {
1880 after 300 do_file_hl $fh_serial
1884 proc makepatterns {l} {
1887 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1888 if {[string index $ee end] eq "/"} {
1898 proc do_file_hl {serial} {
1899 global highlight_files filehighlight highlight_paths gdttype fhl_list
1901 if {$gdttype eq "touching paths:"} {
1902 if {[catch {set paths [shellsplit $highlight_files]}]} return
1903 set highlight_paths [makepatterns $paths]
1905 set gdtargs [concat -- $paths]
1907 set gdtargs [list "-S$highlight_files"]
1909 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1910 set filehighlight [open $cmd r+]
1911 fconfigure $filehighlight -blocking 0
1912 fileevent $filehighlight readable readfhighlight
1918 proc flushhighlights {} {
1919 global filehighlight fhl_list
1921 if {[info exists filehighlight]} {
1923 puts $filehighlight ""
1924 flush $filehighlight
1928 proc askfilehighlight {row id} {
1929 global filehighlight fhighlights fhl_list
1931 lappend fhl_list $id
1932 set fhighlights($row) -1
1933 puts $filehighlight $id
1936 proc readfhighlight {} {
1937 global filehighlight fhighlights commitrow curview mainfont iddrawn
1940 while {[gets $filehighlight line] >= 0} {
1941 set line [string trim $line]
1942 set i [lsearch -exact $fhl_list $line]
1943 if {$i < 0} continue
1944 for {set j 0} {$j < $i} {incr j} {
1945 set id [lindex $fhl_list $j]
1946 if {[info exists commitrow($curview,$id)]} {
1947 set fhighlights($commitrow($curview,$id)) 0
1950 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1951 if {$line eq {}} continue
1952 if {![info exists commitrow($curview,$line)]} continue
1953 set row $commitrow($curview,$line)
1954 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1955 bolden $row [concat $mainfont bold]
1957 set fhighlights($row) 1
1959 if {[eof $filehighlight]} {
1961 puts "oops, git-diff-tree died"
1962 catch {close $filehighlight}
1968 proc find_change {name ix op} {
1969 global nhighlights mainfont boldnamerows
1970 global findstring findpattern findtype
1972 # delete previous highlights, if any
1973 foreach row $boldnamerows {
1974 bolden_name $row $mainfont
1977 catch {unset nhighlights}
1979 if {$findtype ne "Regexp"} {
1980 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1982 set findpattern "*$e*"
1987 proc askfindhighlight {row id} {
1988 global nhighlights commitinfo iddrawn mainfont
1989 global findstring findtype findloc findpattern
1991 if {![info exists commitinfo($id)]} {
1994 set info $commitinfo($id)
1996 set fldtypes {Headline Author Date Committer CDate Comments}
1997 foreach f $info ty $fldtypes {
1998 if {$findloc ne "All fields" && $findloc ne $ty} {
2001 if {$findtype eq "Regexp"} {
2002 set doesmatch [regexp $findstring $f]
2003 } elseif {$findtype eq "IgnCase"} {
2004 set doesmatch [string match -nocase $findpattern $f]
2006 set doesmatch [string match $findpattern $f]
2009 if {$ty eq "Author"} {
2016 if {[info exists iddrawn($id)]} {
2017 if {$isbold && ![ishighlighted $row]} {
2018 bolden $row [concat $mainfont bold]
2021 bolden_name $row [concat $mainfont bold]
2024 set nhighlights($row) $isbold
2027 proc vrel_change {name ix op} {
2028 global highlight_related
2031 if {$highlight_related ne "None"} {
2032 after idle drawvisible
2036 # prepare for testing whether commits are descendents or ancestors of a
2037 proc rhighlight_sel {a} {
2038 global descendent desc_todo ancestor anc_todo
2039 global highlight_related rhighlights
2041 catch {unset descendent}
2042 set desc_todo [list $a]
2043 catch {unset ancestor}
2044 set anc_todo [list $a]
2045 if {$highlight_related ne "None"} {
2047 after idle drawvisible
2051 proc rhighlight_none {} {
2054 catch {unset rhighlights}
2058 proc is_descendent {a} {
2059 global curview children commitrow descendent desc_todo
2062 set la $commitrow($v,$a)
2066 for {set i 0} {$i < [llength $todo]} {incr i} {
2067 set do [lindex $todo $i]
2068 if {$commitrow($v,$do) < $la} {
2069 lappend leftover $do
2072 foreach nk $children($v,$do) {
2073 if {![info exists descendent($nk)]} {
2074 set descendent($nk) 1
2082 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2086 set descendent($a) 0
2087 set desc_todo $leftover
2090 proc is_ancestor {a} {
2091 global curview parentlist commitrow ancestor anc_todo
2094 set la $commitrow($v,$a)
2098 for {set i 0} {$i < [llength $todo]} {incr i} {
2099 set do [lindex $todo $i]
2100 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2101 lappend leftover $do
2104 foreach np [lindex $parentlist $commitrow($v,$do)] {
2105 if {![info exists ancestor($np)]} {
2114 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2119 set anc_todo $leftover
2122 proc askrelhighlight {row id} {
2123 global descendent highlight_related iddrawn mainfont rhighlights
2124 global selectedline ancestor
2126 if {![info exists selectedline]} return
2128 if {$highlight_related eq "Descendent" ||
2129 $highlight_related eq "Not descendent"} {
2130 if {![info exists descendent($id)]} {
2133 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2136 } elseif {$highlight_related eq "Ancestor" ||
2137 $highlight_related eq "Not ancestor"} {
2138 if {![info exists ancestor($id)]} {
2141 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2145 if {[info exists iddrawn($id)]} {
2146 if {$isbold && ![ishighlighted $row]} {
2147 bolden $row [concat $mainfont bold]
2150 set rhighlights($row) $isbold
2153 proc next_hlcont {} {
2154 global fhl_row fhl_dirn displayorder numcommits
2155 global vhighlights fhighlights nhighlights rhighlights
2156 global hlview filehighlight findstring highlight_related
2158 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2161 if {$row < 0 || $row >= $numcommits} {
2166 set id [lindex $displayorder $row]
2167 if {[info exists hlview]} {
2168 if {![info exists vhighlights($row)]} {
2169 askvhighlight $row $id
2171 if {$vhighlights($row) > 0} break
2173 if {$findstring ne {}} {
2174 if {![info exists nhighlights($row)]} {
2175 askfindhighlight $row $id
2177 if {$nhighlights($row) > 0} break
2179 if {$highlight_related ne "None"} {
2180 if {![info exists rhighlights($row)]} {
2181 askrelhighlight $row $id
2183 if {$rhighlights($row) > 0} break
2185 if {[info exists filehighlight]} {
2186 if {![info exists fhighlights($row)]} {
2187 # ask for a few more while we're at it...
2189 for {set n 0} {$n < 100} {incr n} {
2190 if {![info exists fhighlights($r)]} {
2191 askfilehighlight $r [lindex $displayorder $r]
2194 if {$r < 0 || $r >= $numcommits} break
2198 if {$fhighlights($row) < 0} {
2202 if {$fhighlights($row) > 0} break
2210 proc next_highlight {dirn} {
2211 global selectedline fhl_row fhl_dirn
2212 global hlview filehighlight findstring highlight_related
2214 if {![info exists selectedline]} return
2215 if {!([info exists hlview] || $findstring ne {} ||
2216 $highlight_related ne "None" || [info exists filehighlight])} return
2217 set fhl_row [expr {$selectedline + $dirn}]
2222 proc cancel_next_highlight {} {
2228 # Graph layout functions
2230 proc shortids {ids} {
2233 if {[llength $id] > 1} {
2234 lappend res [shortids $id]
2235 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2236 lappend res [string range $id 0 7]
2244 proc incrange {l x o} {
2247 set e [lindex $l $x]
2249 lset l $x [expr {$e + $o}]
2258 for {} {$n > 0} {incr n -1} {
2264 proc usedinrange {id l1 l2} {
2265 global children commitrow childlist curview
2267 if {[info exists commitrow($curview,$id)]} {
2268 set r $commitrow($curview,$id)
2269 if {$l1 <= $r && $r <= $l2} {
2270 return [expr {$r - $l1 + 1}]
2272 set kids [lindex $childlist $r]
2274 set kids $children($curview,$id)
2277 set r $commitrow($curview,$c)
2278 if {$l1 <= $r && $r <= $l2} {
2279 return [expr {$r - $l1 + 1}]
2285 proc sanity {row {full 0}} {
2286 global rowidlist rowoffsets
2289 set ids [lindex $rowidlist $row]
2292 if {$id eq {}} continue
2293 if {$col < [llength $ids] - 1 &&
2294 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2295 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2297 set o [lindex $rowoffsets $row $col]
2303 if {[lindex $rowidlist $y $x] != $id} {
2304 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2305 puts " id=[shortids $id] check started at row $row"
2306 for {set i $row} {$i >= $y} {incr i -1} {
2307 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2312 set o [lindex $rowoffsets $y $x]
2317 proc makeuparrow {oid x y z} {
2318 global rowidlist rowoffsets uparrowlen idrowranges
2320 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2323 set off0 [lindex $rowoffsets $y]
2324 for {set x0 $x} {1} {incr x0} {
2325 if {$x0 >= [llength $off0]} {
2326 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2329 set z [lindex $off0 $x0]
2335 set z [expr {$x0 - $x}]
2336 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2337 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2339 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2340 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2341 lappend idrowranges($oid) $y
2344 proc initlayout {} {
2345 global rowidlist rowoffsets displayorder commitlisted
2346 global rowlaidout rowoptim
2347 global idinlist rowchk rowrangelist idrowranges
2348 global numcommits canvxmax canv
2350 global parentlist childlist children
2351 global colormap rowtextx
2363 catch {unset idinlist}
2364 catch {unset rowchk}
2367 set canvxmax [$canv cget -width]
2368 catch {unset colormap}
2369 catch {unset rowtextx}
2370 catch {unset idrowranges}
2374 proc setcanvscroll {} {
2375 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2377 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2378 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2379 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2380 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2383 proc visiblerows {} {
2384 global canv numcommits linespc
2386 set ymax [lindex [$canv cget -scrollregion] 3]
2387 if {$ymax eq {} || $ymax == 0} return
2389 set y0 [expr {int([lindex $f 0] * $ymax)}]
2390 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2394 set y1 [expr {int([lindex $f 1] * $ymax)}]
2395 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2396 if {$r1 >= $numcommits} {
2397 set r1 [expr {$numcommits - 1}]
2399 return [list $r0 $r1]
2402 proc layoutmore {tmax} {
2403 global rowlaidout rowoptim commitidx numcommits optim_delay
2404 global uparrowlen curview
2407 if {$rowoptim - $optim_delay > $numcommits} {
2408 showstuff [expr {$rowoptim - $optim_delay}]
2409 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2410 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2414 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2416 } elseif {$commitidx($curview) > $rowlaidout} {
2417 set nr [expr {$commitidx($curview) - $rowlaidout}]
2418 # may need to increase this threshold if uparrowlen or
2419 # mingaplen are increased...
2424 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2425 if {$rowlaidout == $row} {
2431 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2437 proc showstuff {canshow} {
2438 global numcommits commitrow pending_select selectedline
2439 global linesegends idrowranges idrangedrawn curview
2441 if {$numcommits == 0} {
2443 set phase "incrdraw"
2447 set numcommits $canshow
2449 set rows [visiblerows]
2450 set r0 [lindex $rows 0]
2451 set r1 [lindex $rows 1]
2453 for {set r $row} {$r < $canshow} {incr r} {
2454 foreach id [lindex $linesegends [expr {$r+1}]] {
2456 foreach {s e} [rowranges $id] {
2458 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2459 && ![info exists idrangedrawn($id,$i)]} {
2461 set idrangedrawn($id,$i) 1
2466 if {$canshow > $r1} {
2469 while {$row < $canshow} {
2473 if {[info exists pending_select] &&
2474 [info exists commitrow($curview,$pending_select)] &&
2475 $commitrow($curview,$pending_select) < $numcommits} {
2476 selectline $commitrow($curview,$pending_select) 1
2478 if {![info exists selectedline] && ![info exists pending_select]} {
2483 proc layoutrows {row endrow last} {
2484 global rowidlist rowoffsets displayorder
2485 global uparrowlen downarrowlen maxwidth mingaplen
2486 global childlist parentlist
2487 global idrowranges linesegends
2488 global commitidx curview
2489 global idinlist rowchk rowrangelist
2491 set idlist [lindex $rowidlist $row]
2492 set offs [lindex $rowoffsets $row]
2493 while {$row < $endrow} {
2494 set id [lindex $displayorder $row]
2497 foreach p [lindex $parentlist $row] {
2498 if {![info exists idinlist($p)]} {
2500 } elseif {!$idinlist($p)} {
2505 set nev [expr {[llength $idlist] + [llength $newolds]
2506 + [llength $oldolds] - $maxwidth + 1}]
2509 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2510 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2511 set i [lindex $idlist $x]
2512 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2513 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2514 [expr {$row + $uparrowlen + $mingaplen}]]
2516 set idlist [lreplace $idlist $x $x]
2517 set offs [lreplace $offs $x $x]
2518 set offs [incrange $offs $x 1]
2520 set rm1 [expr {$row - 1}]
2522 lappend idrowranges($i) $rm1
2523 if {[incr nev -1] <= 0} break
2526 set rowchk($id) [expr {$row + $r}]
2529 lset rowidlist $row $idlist
2530 lset rowoffsets $row $offs
2532 lappend linesegends $lse
2533 set col [lsearch -exact $idlist $id]
2535 set col [llength $idlist]
2537 lset rowidlist $row $idlist
2539 if {[lindex $childlist $row] ne {}} {
2540 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2544 lset rowoffsets $row $offs
2546 makeuparrow $id $col $row $z
2552 if {[info exists idrowranges($id)]} {
2553 set ranges $idrowranges($id)
2555 unset idrowranges($id)
2557 lappend rowrangelist $ranges
2559 set offs [ntimes [llength $idlist] 0]
2560 set l [llength $newolds]
2561 set idlist [eval lreplace \$idlist $col $col $newolds]
2564 set offs [lrange $offs 0 [expr {$col - 1}]]
2565 foreach x $newolds {
2570 set tmp [expr {[llength $idlist] - [llength $offs]}]
2572 set offs [concat $offs [ntimes $tmp $o]]
2577 foreach i $newolds {
2579 set idrowranges($i) $row
2582 foreach oid $oldolds {
2583 set idinlist($oid) 1
2584 set idlist [linsert $idlist $col $oid]
2585 set offs [linsert $offs $col $o]
2586 makeuparrow $oid $col $row $o
2589 lappend rowidlist $idlist
2590 lappend rowoffsets $offs
2595 proc addextraid {id row} {
2596 global displayorder commitrow commitinfo
2597 global commitidx commitlisted
2598 global parentlist childlist children curview
2600 incr commitidx($curview)
2601 lappend displayorder $id
2602 lappend commitlisted 0
2603 lappend parentlist {}
2604 set commitrow($curview,$id) $row
2606 if {![info exists commitinfo($id)]} {
2607 set commitinfo($id) {"No commit information available"}
2609 if {![info exists children($curview,$id)]} {
2610 set children($curview,$id) {}
2612 lappend childlist $children($curview,$id)
2615 proc layouttail {} {
2616 global rowidlist rowoffsets idinlist commitidx curview
2617 global idrowranges rowrangelist
2619 set row $commitidx($curview)
2620 set idlist [lindex $rowidlist $row]
2621 while {$idlist ne {}} {
2622 set col [expr {[llength $idlist] - 1}]
2623 set id [lindex $idlist $col]
2626 lappend idrowranges($id) $row
2627 lappend rowrangelist $idrowranges($id)
2628 unset idrowranges($id)
2630 set offs [ntimes $col 0]
2631 set idlist [lreplace $idlist $col $col]
2632 lappend rowidlist $idlist
2633 lappend rowoffsets $offs
2636 foreach id [array names idinlist] {
2638 lset rowidlist $row [list $id]
2639 lset rowoffsets $row 0
2640 makeuparrow $id 0 $row 0
2641 lappend idrowranges($id) $row
2642 lappend rowrangelist $idrowranges($id)
2643 unset idrowranges($id)
2645 lappend rowidlist {}
2646 lappend rowoffsets {}
2650 proc insert_pad {row col npad} {
2651 global rowidlist rowoffsets
2653 set pad [ntimes $npad {}]
2654 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2655 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2656 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2659 proc optimize_rows {row col endrow} {
2660 global rowidlist rowoffsets idrowranges displayorder
2662 for {} {$row < $endrow} {incr row} {
2663 set idlist [lindex $rowidlist $row]
2664 set offs [lindex $rowoffsets $row]
2666 for {} {$col < [llength $offs]} {incr col} {
2667 if {[lindex $idlist $col] eq {}} {
2671 set z [lindex $offs $col]
2672 if {$z eq {}} continue
2674 set x0 [expr {$col + $z}]
2675 set y0 [expr {$row - 1}]
2676 set z0 [lindex $rowoffsets $y0 $x0]
2678 set id [lindex $idlist $col]
2679 set ranges [rowranges $id]
2680 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2684 if {$z < -1 || ($z < 0 && $isarrow)} {
2685 set npad [expr {-1 - $z + $isarrow}]
2686 set offs [incrange $offs $col $npad]
2687 insert_pad $y0 $x0 $npad
2689 optimize_rows $y0 $x0 $row
2691 set z [lindex $offs $col]
2692 set x0 [expr {$col + $z}]
2693 set z0 [lindex $rowoffsets $y0 $x0]
2694 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2695 set npad [expr {$z - 1 + $isarrow}]
2696 set y1 [expr {$row + 1}]
2697 set offs2 [lindex $rowoffsets $y1]
2701 if {$z eq {} || $x1 + $z < $col} continue
2702 if {$x1 + $z > $col} {
2705 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2708 set pad [ntimes $npad {}]
2709 set idlist [eval linsert \$idlist $col $pad]
2710 set tmp [eval linsert \$offs $col $pad]
2712 set offs [incrange $tmp $col [expr {-$npad}]]
2713 set z [lindex $offs $col]
2716 if {$z0 eq {} && !$isarrow} {
2717 # this line links to its first child on row $row-2
2718 set rm2 [expr {$row - 2}]
2719 set id [lindex $displayorder $rm2]
2720 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2722 set z0 [expr {$xc - $x0}]
2725 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2726 insert_pad $y0 $x0 1
2727 set offs [incrange $offs $col 1]
2728 optimize_rows $y0 [expr {$x0 + 1}] $row
2733 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2734 set o [lindex $offs $col]
2736 # check if this is the link to the first child
2737 set id [lindex $idlist $col]
2738 set ranges [rowranges $id]
2739 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2740 # it is, work out offset to child
2741 set y0 [expr {$row - 1}]
2742 set id [lindex $displayorder $y0]
2743 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2745 set o [expr {$x0 - $col}]
2749 if {$o eq {} || $o <= 0} break
2751 if {$o ne {} && [incr col] < [llength $idlist]} {
2752 set y1 [expr {$row + 1}]
2753 set offs2 [lindex $rowoffsets $y1]
2757 if {$z eq {} || $x1 + $z < $col} continue
2758 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2761 set idlist [linsert $idlist $col {}]
2762 set tmp [linsert $offs $col {}]
2764 set offs [incrange $tmp $col -1]
2767 lset rowidlist $row $idlist
2768 lset rowoffsets $row $offs
2774 global canvx0 linespc
2775 return [expr {$canvx0 + $col * $linespc}]
2779 global canvy0 linespc
2780 return [expr {$canvy0 + $row * $linespc}]
2783 proc linewidth {id} {
2784 global thickerline lthickness
2787 if {[info exists thickerline] && $id eq $thickerline} {
2788 set wid [expr {2 * $lthickness}]
2793 proc rowranges {id} {
2794 global phase idrowranges commitrow rowlaidout rowrangelist curview
2798 ([info exists commitrow($curview,$id)]
2799 && $commitrow($curview,$id) < $rowlaidout)} {
2800 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2801 } elseif {[info exists idrowranges($id)]} {
2802 set ranges $idrowranges($id)
2807 proc drawlineseg {id i} {
2808 global rowoffsets rowidlist
2810 global canv colormap linespc
2811 global numcommits commitrow curview
2813 set ranges [rowranges $id]
2815 if {[info exists commitrow($curview,$id)]
2816 && $commitrow($curview,$id) < $numcommits} {
2817 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2821 set startrow [lindex $ranges [expr {2 * $i}]]
2822 set row [lindex $ranges [expr {2 * $i + 1}]]
2823 if {$startrow == $row} return
2826 set col [lsearch -exact [lindex $rowidlist $row] $id]
2828 puts "oops: drawline: id $id not on row $row"
2834 set o [lindex $rowoffsets $row $col]
2837 # changing direction
2838 set x [xc $row $col]
2840 lappend coords $x $y
2846 set x [xc $row $col]
2848 lappend coords $x $y
2850 # draw the link to the first child as part of this line
2852 set child [lindex $displayorder $row]
2853 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2855 set x [xc $row $ccol]
2857 if {$ccol < $col - 1} {
2858 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2859 } elseif {$ccol > $col + 1} {
2860 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2862 lappend coords $x $y
2865 if {[llength $coords] < 4} return
2867 # This line has an arrow at the lower end: check if the arrow is
2868 # on a diagonal segment, and if so, work around the Tk 8.4
2869 # refusal to draw arrows on diagonal lines.
2870 set x0 [lindex $coords 0]
2871 set x1 [lindex $coords 2]
2873 set y0 [lindex $coords 1]
2874 set y1 [lindex $coords 3]
2875 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2876 # we have a nearby vertical segment, just trim off the diag bit
2877 set coords [lrange $coords 2 end]
2879 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2880 set xi [expr {$x0 - $slope * $linespc / 2}]
2881 set yi [expr {$y0 - $linespc / 2}]
2882 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2886 set arrow [expr {2 * ($i > 0) + $downarrow}]
2887 set arrow [lindex {none first last both} $arrow]
2888 set t [$canv create line $coords -width [linewidth $id] \
2889 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2894 proc drawparentlinks {id row col olds} {
2895 global rowidlist canv colormap
2897 set row2 [expr {$row + 1}]
2898 set x [xc $row $col]
2901 set ids [lindex $rowidlist $row2]
2902 # rmx = right-most X coord used
2905 set i [lsearch -exact $ids $p]
2907 puts "oops, parent $p of $id not in list"
2910 set x2 [xc $row2 $i]
2914 set ranges [rowranges $p]
2915 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2916 && $row2 < [lindex $ranges 1]} {
2917 # drawlineseg will do this one for us
2921 # should handle duplicated parents here...
2922 set coords [list $x $y]
2923 if {$i < $col - 1} {
2924 lappend coords [xc $row [expr {$i + 1}]] $y
2925 } elseif {$i > $col + 1} {
2926 lappend coords [xc $row [expr {$i - 1}]] $y
2928 lappend coords $x2 $y2
2929 set t [$canv create line $coords -width [linewidth $p] \
2930 -fill $colormap($p) -tags lines.$p]
2937 proc drawlines {id} {
2938 global colormap canv
2940 global children iddrawn commitrow rowidlist curview
2942 $canv delete lines.$id
2943 set nr [expr {[llength [rowranges $id]] / 2}]
2944 for {set i 0} {$i < $nr} {incr i} {
2945 if {[info exists idrangedrawn($id,$i)]} {
2949 foreach child $children($curview,$id) {
2950 if {[info exists iddrawn($child)]} {
2951 set row $commitrow($curview,$child)
2952 set col [lsearch -exact [lindex $rowidlist $row] $child]
2954 drawparentlinks $child $row $col [list $id]
2960 proc drawcmittext {id row col rmx} {
2961 global linespc canv canv2 canv3 canvy0 fgcolor
2962 global commitlisted commitinfo rowidlist
2963 global rowtextx idpos idtags idheads idotherrefs
2964 global linehtag linentag linedtag
2965 global mainfont canvxmax boldrows boldnamerows fgcolor
2967 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2968 set x [xc $row $col]
2970 set orad [expr {$linespc / 3}]
2971 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2972 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2973 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2975 $canv bind $t <1> {selcanvline {} %x %y}
2976 set xt [xc $row [llength [lindex $rowidlist $row]]]
2980 set rowtextx($row) $xt
2981 set idpos($id) [list $x $xt $y]
2982 if {[info exists idtags($id)] || [info exists idheads($id)]
2983 || [info exists idotherrefs($id)]} {
2984 set xt [drawtags $id $x $xt $y]
2986 set headline [lindex $commitinfo($id) 0]
2987 set name [lindex $commitinfo($id) 1]
2988 set date [lindex $commitinfo($id) 2]
2989 set date [formatdate $date]
2992 set isbold [ishighlighted $row]
2994 lappend boldrows $row
2997 lappend boldnamerows $row
3001 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3002 -text $headline -font $font -tags text]
3003 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3004 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3005 -text $name -font $nfont -tags text]
3006 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3007 -text $date -font $mainfont -tags text]
3008 set xr [expr {$xt + [font measure $mainfont $headline]}]
3009 if {$xr > $canvxmax} {
3015 proc drawcmitrow {row} {
3016 global displayorder rowidlist
3017 global idrangedrawn iddrawn
3018 global commitinfo parentlist numcommits
3019 global filehighlight fhighlights findstring nhighlights
3020 global hlview vhighlights
3021 global highlight_related rhighlights
3023 if {$row >= $numcommits} return
3024 foreach id [lindex $rowidlist $row] {
3025 if {$id eq {}} continue
3027 foreach {s e} [rowranges $id] {
3029 if {$row < $s} continue
3032 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3034 set idrangedrawn($id,$i) 1
3041 set id [lindex $displayorder $row]
3042 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3043 askvhighlight $row $id
3045 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3046 askfilehighlight $row $id
3048 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3049 askfindhighlight $row $id
3051 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3052 askrelhighlight $row $id
3054 if {[info exists iddrawn($id)]} return
3055 set col [lsearch -exact [lindex $rowidlist $row] $id]
3057 puts "oops, row $row id $id not in list"
3060 if {![info exists commitinfo($id)]} {
3064 set olds [lindex $parentlist $row]
3066 set rmx [drawparentlinks $id $row $col $olds]
3070 drawcmittext $id $row $col $rmx
3074 proc drawfrac {f0 f1} {
3075 global numcommits canv
3078 set ymax [lindex [$canv cget -scrollregion] 3]
3079 if {$ymax eq {} || $ymax == 0} return
3080 set y0 [expr {int($f0 * $ymax)}]
3081 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3085 set y1 [expr {int($f1 * $ymax)}]
3086 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3087 if {$endrow >= $numcommits} {
3088 set endrow [expr {$numcommits - 1}]
3090 for {} {$row <= $endrow} {incr row} {
3095 proc drawvisible {} {
3097 eval drawfrac [$canv yview]
3100 proc clear_display {} {
3101 global iddrawn idrangedrawn
3102 global vhighlights fhighlights nhighlights rhighlights
3105 catch {unset iddrawn}
3106 catch {unset idrangedrawn}
3107 catch {unset vhighlights}
3108 catch {unset fhighlights}
3109 catch {unset nhighlights}
3110 catch {unset rhighlights}
3113 proc findcrossings {id} {
3114 global rowidlist parentlist numcommits rowoffsets displayorder
3118 foreach {s e} [rowranges $id] {
3119 if {$e >= $numcommits} {
3120 set e [expr {$numcommits - 1}]
3122 if {$e <= $s} continue
3123 set x [lsearch -exact [lindex $rowidlist $e] $id]
3125 puts "findcrossings: oops, no [shortids $id] in row $e"
3128 for {set row $e} {[incr row -1] >= $s} {} {
3129 set olds [lindex $parentlist $row]
3130 set kid [lindex $displayorder $row]
3131 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3132 if {$kidx < 0} continue
3133 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3135 set px [lsearch -exact $nextrow $p]
3136 if {$px < 0} continue
3137 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3138 if {[lsearch -exact $ccross $p] >= 0} continue
3139 if {$x == $px + ($kidx < $px? -1: 1)} {
3141 } elseif {[lsearch -exact $cross $p] < 0} {
3146 set inc [lindex $rowoffsets $row $x]
3147 if {$inc eq {}} break
3151 return [concat $ccross {{}} $cross]
3154 proc assigncolor {id} {
3155 global colormap colors nextcolor
3156 global commitrow parentlist children children curview
3158 if {[info exists colormap($id)]} return
3159 set ncolors [llength $colors]
3160 if {[info exists children($curview,$id)]} {
3161 set kids $children($curview,$id)
3165 if {[llength $kids] == 1} {
3166 set child [lindex $kids 0]
3167 if {[info exists colormap($child)]
3168 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3169 set colormap($id) $colormap($child)
3175 foreach x [findcrossings $id] {
3177 # delimiter between corner crossings and other crossings
3178 if {[llength $badcolors] >= $ncolors - 1} break
3179 set origbad $badcolors
3181 if {[info exists colormap($x)]
3182 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3183 lappend badcolors $colormap($x)
3186 if {[llength $badcolors] >= $ncolors} {
3187 set badcolors $origbad
3189 set origbad $badcolors
3190 if {[llength $badcolors] < $ncolors - 1} {
3191 foreach child $kids {
3192 if {[info exists colormap($child)]
3193 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3194 lappend badcolors $colormap($child)
3196 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3197 if {[info exists colormap($p)]
3198 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3199 lappend badcolors $colormap($p)
3203 if {[llength $badcolors] >= $ncolors} {
3204 set badcolors $origbad
3207 for {set i 0} {$i <= $ncolors} {incr i} {
3208 set c [lindex $colors $nextcolor]
3209 if {[incr nextcolor] >= $ncolors} {
3212 if {[lsearch -exact $badcolors $c]} break
3214 set colormap($id) $c
3217 proc bindline {t id} {
3220 $canv bind $t <Enter> "lineenter %x %y $id"
3221 $canv bind $t <Motion> "linemotion %x %y $id"
3222 $canv bind $t <Leave> "lineleave $id"
3223 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3226 proc drawtags {id x xt y1} {
3227 global idtags idheads idotherrefs mainhead
3228 global linespc lthickness
3229 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3234 if {[info exists idtags($id)]} {
3235 set marks $idtags($id)
3236 set ntags [llength $marks]
3238 if {[info exists idheads($id)]} {
3239 set marks [concat $marks $idheads($id)]
3240 set nheads [llength $idheads($id)]
3242 if {[info exists idotherrefs($id)]} {
3243 set marks [concat $marks $idotherrefs($id)]
3249 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3250 set yt [expr {$y1 - 0.5 * $linespc}]
3251 set yb [expr {$yt + $linespc - 1}]
3255 foreach tag $marks {
3257 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3258 set wid [font measure [concat $mainfont bold] $tag]
3260 set wid [font measure $mainfont $tag]
3264 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3266 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3267 -width $lthickness -fill black -tags tag.$id]
3269 foreach tag $marks x $xvals wid $wvals {
3270 set xl [expr {$x + $delta}]
3271 set xr [expr {$x + $delta + $wid + $lthickness}]
3273 if {[incr ntags -1] >= 0} {
3275 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3276 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3277 -width 1 -outline black -fill yellow -tags tag.$id]
3278 $canv bind $t <1> [list showtag $tag 1]
3279 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3281 # draw a head or other ref
3282 if {[incr nheads -1] >= 0} {
3284 if {$tag eq $mainhead} {
3290 set xl [expr {$xl - $delta/2}]
3291 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3292 -width 1 -outline black -fill $col -tags tag.$id
3293 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3294 set rwid [font measure $mainfont $remoteprefix]
3295 set xi [expr {$x + 1}]
3296 set yti [expr {$yt + 1}]
3297 set xri [expr {$x + $rwid}]
3298 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3299 -width 0 -fill "#ffddaa" -tags tag.$id
3302 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3303 -font $font -tags [list tag.$id text]]
3305 $canv bind $t <1> [list showtag $tag 1]
3306 } elseif {$nheads >= 0} {
3307 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3313 proc xcoord {i level ln} {
3314 global canvx0 xspc1 xspc2
3316 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3317 if {$i > 0 && $i == $level} {
3318 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3319 } elseif {$i > $level} {
3320 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3325 proc show_status {msg} {
3326 global canv mainfont fgcolor
3329 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3330 -tags text -fill $fgcolor
3333 proc finishcommits {} {
3334 global commitidx phase curview
3335 global pending_select
3337 if {$commitidx($curview) > 0} {
3340 show_status "No commits selected"
3343 catch {unset pending_select}
3346 # Insert a new commit as the child of the commit on row $row.
3347 # The new commit will be displayed on row $row and the commits
3348 # on that row and below will move down one row.
3349 proc insertrow {row newcmit} {
3350 global displayorder parentlist childlist commitlisted
3351 global commitrow curview rowidlist rowoffsets numcommits
3352 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3353 global linesegends selectedline
3355 if {$row >= $numcommits} {
3356 puts "oops, inserting new row $row but only have $numcommits rows"
3359 set p [lindex $displayorder $row]
3360 set displayorder [linsert $displayorder $row $newcmit]
3361 set parentlist [linsert $parentlist $row $p]
3362 set kids [lindex $childlist $row]
3363 lappend kids $newcmit
3364 lset childlist $row $kids
3365 set childlist [linsert $childlist $row {}]
3366 set commitlisted [linsert $commitlisted $row 1]
3367 set l [llength $displayorder]
3368 for {set r $row} {$r < $l} {incr r} {
3369 set id [lindex $displayorder $r]
3370 set commitrow($curview,$id) $r
3373 set idlist [lindex $rowidlist $row]
3374 set offs [lindex $rowoffsets $row]
3377 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3383 if {[llength $kids] == 1} {
3384 set col [lsearch -exact $idlist $p]
3385 lset idlist $col $newcmit
3387 set col [llength $idlist]
3388 lappend idlist $newcmit
3390 lset rowoffsets $row $offs
3392 set rowidlist [linsert $rowidlist $row $idlist]
3393 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3395 set rowrangelist [linsert $rowrangelist $row {}]
3396 set l [llength $rowrangelist]
3397 for {set r 0} {$r < $l} {incr r} {
3398 set ranges [lindex $rowrangelist $r]
3399 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3403 lappend newranges [expr {$x + 1}]
3405 lappend newranges $x
3408 lset rowrangelist $r $newranges
3411 if {[llength $kids] > 1} {
3412 set rp1 [expr {$row + 1}]
3413 set ranges [lindex $rowrangelist $rp1]
3414 if {$ranges eq {}} {
3415 set ranges [list $row $rp1]
3416 } elseif {[lindex $ranges end-1] == $rp1} {
3417 lset ranges end-1 $row
3419 lset rowrangelist $rp1 $ranges
3421 foreach id [array names idrowranges] {
3422 set ranges $idrowranges($id)
3423 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3427 lappend newranges [expr {$x + 1}]
3429 lappend newranges $x
3432 set idrowranges($id) $newranges
3436 set linesegends [linsert $linesegends $row {}]
3442 if {[info exists selectedline] && $selectedline >= $row} {
3448 # Don't change the text pane cursor if it is currently the hand cursor,
3449 # showing that we are over a sha1 ID link.
3450 proc settextcursor {c} {
3451 global ctext curtextcursor
3453 if {[$ctext cget -cursor] == $curtextcursor} {
3454 $ctext config -cursor $c
3456 set curtextcursor $c
3459 proc nowbusy {what} {
3462 if {[array names isbusy] eq {}} {
3463 . config -cursor watch
3469 proc notbusy {what} {
3470 global isbusy maincursor textcursor
3472 catch {unset isbusy($what)}
3473 if {[array names isbusy] eq {}} {
3474 . config -cursor $maincursor
3475 settextcursor $textcursor
3481 global rowlaidout commitidx curview
3482 global pending_select
3485 layoutrows $rowlaidout $commitidx($curview) 1
3487 optimize_rows $row 0 $commitidx($curview)
3488 showstuff $commitidx($curview)
3489 if {[info exists pending_select]} {
3493 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3495 #puts "overall $drawmsecs ms for $numcommits commits"
3498 proc findmatches {f} {
3499 global findtype foundstring foundstrlen
3500 if {$findtype == "Regexp"} {
3501 set matches [regexp -indices -all -inline $foundstring $f]
3503 if {$findtype == "IgnCase"} {
3504 set str [string tolower $f]
3510 while {[set j [string first $foundstring $str $i]] >= 0} {
3511 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3512 set i [expr {$j + $foundstrlen}]
3519 global findtype findloc findstring markedmatches commitinfo
3520 global numcommits displayorder linehtag linentag linedtag
3521 global mainfont canv canv2 canv3 selectedline
3522 global matchinglines foundstring foundstrlen matchstring
3527 cancel_next_highlight
3529 set matchinglines {}
3530 if {$findtype == "IgnCase"} {
3531 set foundstring [string tolower $findstring]
3533 set foundstring $findstring
3535 set foundstrlen [string length $findstring]
3536 if {$foundstrlen == 0} return
3537 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3538 set matchstring "*$matchstring*"
3539 if {![info exists selectedline]} {
3542 set oldsel $selectedline
3545 set fldtypes {Headline Author Date Committer CDate Comments}
3547 foreach id $displayorder {
3548 set d $commitdata($id)
3550 if {$findtype == "Regexp"} {
3551 set doesmatch [regexp $foundstring $d]
3552 } elseif {$findtype == "IgnCase"} {
3553 set doesmatch [string match -nocase $matchstring $d]
3555 set doesmatch [string match $matchstring $d]
3557 if {!$doesmatch} continue
3558 if {![info exists commitinfo($id)]} {
3561 set info $commitinfo($id)
3563 foreach f $info ty $fldtypes {
3564 if {$findloc != "All fields" && $findloc != $ty} {
3567 set matches [findmatches $f]
3568 if {$matches == {}} continue
3570 if {$ty == "Headline"} {
3572 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3573 } elseif {$ty == "Author"} {
3575 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3576 } elseif {$ty == "Date"} {
3578 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3582 lappend matchinglines $l
3583 if {!$didsel && $l > $oldsel} {
3589 if {$matchinglines == {}} {
3591 } elseif {!$didsel} {
3592 findselectline [lindex $matchinglines 0]
3596 proc findselectline {l} {
3597 global findloc commentend ctext
3599 if {$findloc == "All fields" || $findloc == "Comments"} {
3600 # highlight the matches in the comments
3601 set f [$ctext get 1.0 $commentend]
3602 set matches [findmatches $f]
3603 foreach match $matches {
3604 set start [lindex $match 0]
3605 set end [expr {[lindex $match 1] + 1}]
3606 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3611 proc findnext {restart} {
3612 global matchinglines selectedline
3613 if {![info exists matchinglines]} {
3619 if {![info exists selectedline]} return
3620 foreach l $matchinglines {
3621 if {$l > $selectedline} {
3630 global matchinglines selectedline
3631 if {![info exists matchinglines]} {
3635 if {![info exists selectedline]} return
3637 foreach l $matchinglines {
3638 if {$l >= $selectedline} break
3642 findselectline $prev
3648 proc stopfindproc {{done 0}} {
3649 global findprocpid findprocfile findids
3650 global ctext findoldcursor phase maincursor textcursor
3651 global findinprogress
3653 catch {unset findids}
3654 if {[info exists findprocpid]} {
3656 catch {exec kill $findprocpid}
3658 catch {close $findprocfile}
3661 catch {unset findinprogress}
3665 # mark a commit as matching by putting a yellow background
3666 # behind the headline
3667 proc markheadline {l id} {
3668 global canv mainfont linehtag
3671 set bbox [$canv bbox $linehtag($l)]
3672 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3676 # mark the bits of a headline, author or date that match a find string
3677 proc markmatches {canv l str tag matches font} {
3678 set bbox [$canv bbox $tag]
3679 set x0 [lindex $bbox 0]
3680 set y0 [lindex $bbox 1]
3681 set y1 [lindex $bbox 3]
3682 foreach match $matches {
3683 set start [lindex $match 0]
3684 set end [lindex $match 1]
3685 if {$start > $end} continue
3686 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3687 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3688 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3689 [expr {$x0+$xlen+2}] $y1 \
3690 -outline {} -tags matches -fill yellow]
3695 proc unmarkmatches {} {
3696 global matchinglines findids
3697 allcanvs delete matches
3698 catch {unset matchinglines}
3699 catch {unset findids}
3702 proc selcanvline {w x y} {
3703 global canv canvy0 ctext linespc
3705 set ymax [lindex [$canv cget -scrollregion] 3]
3706 if {$ymax == {}} return
3707 set yfrac [lindex [$canv yview] 0]
3708 set y [expr {$y + $yfrac * $ymax}]
3709 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3714 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3720 proc commit_descriptor {p} {
3722 if {![info exists commitinfo($p)]} {
3726 if {[llength $commitinfo($p)] > 1} {
3727 set l [lindex $commitinfo($p) 0]
3732 # append some text to the ctext widget, and make any SHA1 ID
3733 # that we know about be a clickable link.
3734 proc appendwithlinks {text tags} {
3735 global ctext commitrow linknum curview
3737 set start [$ctext index "end - 1c"]
3738 $ctext insert end $text $tags
3739 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3743 set linkid [string range $text $s $e]
3744 if {![info exists commitrow($curview,$linkid)]} continue
3746 $ctext tag add link "$start + $s c" "$start + $e c"
3747 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3748 $ctext tag bind link$linknum <1> \
3749 [list selectline $commitrow($curview,$linkid) 1]
3752 $ctext tag conf link -foreground blue -underline 1
3753 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3754 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3757 proc viewnextline {dir} {
3761 set ymax [lindex [$canv cget -scrollregion] 3]
3762 set wnow [$canv yview]
3763 set wtop [expr {[lindex $wnow 0] * $ymax}]
3764 set newtop [expr {$wtop + $dir * $linespc}]
3767 } elseif {$newtop > $ymax} {
3770 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3773 # add a list of tag or branch names at position pos
3774 # returns the number of names inserted
3775 proc appendrefs {pos tags var} {
3776 global ctext commitrow linknum curview $var
3778 if {[catch {$ctext index $pos}]} {
3781 set tags [lsort $tags]
3784 set id [set $var\($tag\)]
3787 $ctext insert $pos $sep
3788 $ctext insert $pos $tag $lk
3789 $ctext tag conf $lk -foreground blue
3790 if {[info exists commitrow($curview,$id)]} {
3791 $ctext tag bind $lk <1> \
3792 [list selectline $commitrow($curview,$id) 1]
3793 $ctext tag conf $lk -underline 1
3794 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3795 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3799 return [llength $tags]
3802 proc taglist {ids} {
3807 foreach tag $idtags($id) {
3814 # called when we have finished computing the nearby tags
3815 proc dispneartags {} {
3816 global selectedline currentid ctext anc_tags desc_tags showneartags
3819 if {![info exists selectedline] || !$showneartags} return
3821 $ctext conf -state normal
3822 if {[info exists desc_heads($id)]} {
3823 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3824 $ctext insert "branch -2c" "es"
3827 if {[info exists anc_tags($id)]} {
3828 appendrefs follows [taglist $anc_tags($id)] tagids
3830 if {[info exists desc_tags($id)]} {
3831 appendrefs precedes [taglist $desc_tags($id)] tagids
3833 $ctext conf -state disabled
3836 proc selectline {l isnew} {
3837 global canv canv2 canv3 ctext commitinfo selectedline
3838 global displayorder linehtag linentag linedtag
3839 global canvy0 linespc parentlist childlist
3840 global currentid sha1entry
3841 global commentend idtags linknum
3842 global mergemax numcommits pending_select
3843 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3845 catch {unset pending_select}
3848 cancel_next_highlight
3849 if {$l < 0 || $l >= $numcommits} return
3850 set y [expr {$canvy0 + $l * $linespc}]
3851 set ymax [lindex [$canv cget -scrollregion] 3]
3852 set ytop [expr {$y - $linespc - 1}]
3853 set ybot [expr {$y + $linespc + 1}]
3854 set wnow [$canv yview]
3855 set wtop [expr {[lindex $wnow 0] * $ymax}]
3856 set wbot [expr {[lindex $wnow 1] * $ymax}]
3857 set wh [expr {$wbot - $wtop}]
3859 if {$ytop < $wtop} {
3860 if {$ybot < $wtop} {
3861 set newtop [expr {$y - $wh / 2.0}]
3864 if {$newtop > $wtop - $linespc} {
3865 set newtop [expr {$wtop - $linespc}]
3868 } elseif {$ybot > $wbot} {
3869 if {$ytop > $wbot} {
3870 set newtop [expr {$y - $wh / 2.0}]
3872 set newtop [expr {$ybot - $wh}]
3873 if {$newtop < $wtop + $linespc} {
3874 set newtop [expr {$wtop + $linespc}]
3878 if {$newtop != $wtop} {
3882 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3886 if {![info exists linehtag($l)]} return
3888 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3889 -tags secsel -fill [$canv cget -selectbackground]]
3891 $canv2 delete secsel
3892 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3893 -tags secsel -fill [$canv2 cget -selectbackground]]
3895 $canv3 delete secsel
3896 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3897 -tags secsel -fill [$canv3 cget -selectbackground]]
3901 addtohistory [list selectline $l 0]
3906 set id [lindex $displayorder $l]
3908 $sha1entry delete 0 end
3909 $sha1entry insert 0 $id
3910 $sha1entry selection from 0
3911 $sha1entry selection to end
3914 $ctext conf -state normal
3917 set info $commitinfo($id)
3918 set date [formatdate [lindex $info 2]]
3919 $ctext insert end "Author: [lindex $info 1] $date\n"
3920 set date [formatdate [lindex $info 4]]
3921 $ctext insert end "Committer: [lindex $info 3] $date\n"
3922 if {[info exists idtags($id)]} {
3923 $ctext insert end "Tags:"
3924 foreach tag $idtags($id) {
3925 $ctext insert end " $tag"
3927 $ctext insert end "\n"
3931 set olds [lindex $parentlist $l]
3932 if {[llength $olds] > 1} {
3935 if {$np >= $mergemax} {
3940 $ctext insert end "Parent: " $tag
3941 appendwithlinks [commit_descriptor $p] {}
3946 append headers "Parent: [commit_descriptor $p]"
3950 foreach c [lindex $childlist $l] {
3951 append headers "Child: [commit_descriptor $c]"
3954 # make anything that looks like a SHA1 ID be a clickable link
3955 appendwithlinks $headers {}
3956 if {$showneartags} {
3957 if {![info exists allcommits]} {
3960 $ctext insert end "Branch: "
3961 $ctext mark set branch "end -1c"
3962 $ctext mark gravity branch left
3963 if {[info exists desc_heads($id)]} {
3964 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3965 # turn "Branch" into "Branches"
3966 $ctext insert "branch -2c" "es"
3969 $ctext insert end "\nFollows: "
3970 $ctext mark set follows "end -1c"
3971 $ctext mark gravity follows left
3972 if {[info exists anc_tags($id)]} {
3973 appendrefs follows [taglist $anc_tags($id)] tagids
3975 $ctext insert end "\nPrecedes: "
3976 $ctext mark set precedes "end -1c"
3977 $ctext mark gravity precedes left
3978 if {[info exists desc_tags($id)]} {
3979 appendrefs precedes [taglist $desc_tags($id)] tagids
3981 $ctext insert end "\n"
3983 $ctext insert end "\n"
3984 appendwithlinks [lindex $info 5] {comment}
3986 $ctext tag delete Comments
3987 $ctext tag remove found 1.0 end
3988 $ctext conf -state disabled
3989 set commentend [$ctext index "end - 1c"]
3991 init_flist "Comments"
3992 if {$cmitmode eq "tree"} {
3994 } elseif {[llength $olds] <= 1} {
4001 proc selfirstline {} {
4006 proc sellastline {} {
4009 set l [expr {$numcommits - 1}]
4013 proc selnextline {dir} {
4015 if {![info exists selectedline]} return
4016 set l [expr {$selectedline + $dir}]
4021 proc selnextpage {dir} {
4022 global canv linespc selectedline numcommits
4024 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4028 allcanvs yview scroll [expr {$dir * $lpp}] units
4030 if {![info exists selectedline]} return
4031 set l [expr {$selectedline + $dir * $lpp}]
4034 } elseif {$l >= $numcommits} {
4035 set l [expr $numcommits - 1]
4041 proc unselectline {} {
4042 global selectedline currentid
4044 catch {unset selectedline}
4045 catch {unset currentid}
4046 allcanvs delete secsel
4048 cancel_next_highlight
4051 proc reselectline {} {
4054 if {[info exists selectedline]} {
4055 selectline $selectedline 0
4059 proc addtohistory {cmd} {
4060 global history historyindex curview
4062 set elt [list $curview $cmd]
4063 if {$historyindex > 0
4064 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4068 if {$historyindex < [llength $history]} {
4069 set history [lreplace $history $historyindex end $elt]
4071 lappend history $elt
4074 if {$historyindex > 1} {
4075 .tf.bar.leftbut conf -state normal
4077 .tf.bar.leftbut conf -state disabled
4079 .tf.bar.rightbut conf -state disabled
4085 set view [lindex $elt 0]
4086 set cmd [lindex $elt 1]
4087 if {$curview != $view} {
4094 global history historyindex
4096 if {$historyindex > 1} {
4097 incr historyindex -1
4098 godo [lindex $history [expr {$historyindex - 1}]]
4099 .tf.bar.rightbut conf -state normal
4101 if {$historyindex <= 1} {
4102 .tf.bar.leftbut conf -state disabled
4107 global history historyindex
4109 if {$historyindex < [llength $history]} {
4110 set cmd [lindex $history $historyindex]
4113 .tf.bar.leftbut conf -state normal
4115 if {$historyindex >= [llength $history]} {
4116 .tf.bar.rightbut conf -state disabled
4121 global treefilelist treeidlist diffids diffmergeid treepending
4124 catch {unset diffmergeid}
4125 if {![info exists treefilelist($id)]} {
4126 if {![info exists treepending]} {
4127 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4131 set treefilelist($id) {}
4132 set treeidlist($id) {}
4133 fconfigure $gtf -blocking 0
4134 fileevent $gtf readable [list gettreeline $gtf $id]
4141 proc gettreeline {gtf id} {
4142 global treefilelist treeidlist treepending cmitmode diffids
4144 while {[gets $gtf line] >= 0} {
4145 if {[lindex $line 1] ne "blob"} continue
4146 set sha1 [lindex $line 2]
4147 set fname [lindex $line 3]
4148 lappend treefilelist($id) $fname
4149 lappend treeidlist($id) $sha1
4151 if {![eof $gtf]} return
4154 if {$cmitmode ne "tree"} {
4155 if {![info exists diffmergeid]} {
4156 gettreediffs $diffids
4158 } elseif {$id ne $diffids} {
4166 global treefilelist treeidlist diffids
4167 global ctext commentend
4169 set i [lsearch -exact $treefilelist($diffids) $f]
4171 puts "oops, $f not in list for id $diffids"
4174 set blob [lindex $treeidlist($diffids) $i]
4175 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4176 puts "oops, error reading blob $blob: $err"
4179 fconfigure $bf -blocking 0
4180 fileevent $bf readable [list getblobline $bf $diffids]
4181 $ctext config -state normal
4182 clear_ctext $commentend
4183 $ctext insert end "\n"
4184 $ctext insert end "$f\n" filesep
4185 $ctext config -state disabled
4186 $ctext yview $commentend
4189 proc getblobline {bf id} {
4190 global diffids cmitmode ctext
4192 if {$id ne $diffids || $cmitmode ne "tree"} {
4196 $ctext config -state normal
4197 while {[gets $bf line] >= 0} {
4198 $ctext insert end "$line\n"
4201 # delete last newline
4202 $ctext delete "end - 2c" "end - 1c"
4205 $ctext config -state disabled
4208 proc mergediff {id l} {
4209 global diffmergeid diffopts mdifffd
4215 # this doesn't seem to actually affect anything...
4216 set env(GIT_DIFF_OPTS) $diffopts
4217 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4218 if {[catch {set mdf [open $cmd r]} err]} {
4219 error_popup "Error getting merge diffs: $err"
4222 fconfigure $mdf -blocking 0
4223 set mdifffd($id) $mdf
4224 set np [llength [lindex $parentlist $l]]
4225 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4226 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4229 proc getmergediffline {mdf id np} {
4230 global diffmergeid ctext cflist nextupdate mergemax
4231 global difffilestart mdifffd
4233 set n [gets $mdf line]
4240 if {![info exists diffmergeid] || $id != $diffmergeid
4241 || $mdf != $mdifffd($id)} {
4244 $ctext conf -state normal
4245 if {[regexp {^diff --cc (.*)} $line match fname]} {
4246 # start of a new file
4247 $ctext insert end "\n"
4248 set here [$ctext index "end - 1c"]
4249 lappend difffilestart $here
4250 add_flist [list $fname]
4251 set l [expr {(78 - [string length $fname]) / 2}]
4252 set pad [string range "----------------------------------------" 1 $l]
4253 $ctext insert end "$pad $fname $pad\n" filesep
4254 } elseif {[regexp {^@@} $line]} {
4255 $ctext insert end "$line\n" hunksep
4256 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4259 # parse the prefix - one ' ', '-' or '+' for each parent
4264 for {set j 0} {$j < $np} {incr j} {
4265 set c [string range $line $j $j]
4268 } elseif {$c == "-"} {
4270 } elseif {$c == "+"} {
4279 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4280 # line doesn't appear in result, parents in $minuses have the line
4281 set num [lindex $minuses 0]
4282 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4283 # line appears in result, parents in $pluses don't have the line
4284 lappend tags mresult
4285 set num [lindex $spaces 0]
4288 if {$num >= $mergemax} {
4293 $ctext insert end "$line\n" $tags
4295 $ctext conf -state disabled
4296 if {[clock clicks -milliseconds] >= $nextupdate} {
4298 fileevent $mdf readable {}
4300 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4304 proc startdiff {ids} {
4305 global treediffs diffids treepending diffmergeid
4308 catch {unset diffmergeid}
4309 if {![info exists treediffs($ids)]} {
4310 if {![info exists treepending]} {
4318 proc addtocflist {ids} {
4319 global treediffs cflist
4320 add_flist $treediffs($ids)
4324 proc gettreediffs {ids} {
4325 global treediff treepending
4326 set treepending $ids
4329 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4331 fconfigure $gdtf -blocking 0
4332 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4335 proc gettreediffline {gdtf ids} {
4336 global treediff treediffs treepending diffids diffmergeid
4339 set n [gets $gdtf line]
4341 if {![eof $gdtf]} return
4343 set treediffs($ids) $treediff
4345 if {$cmitmode eq "tree"} {
4347 } elseif {$ids != $diffids} {
4348 if {![info exists diffmergeid]} {
4349 gettreediffs $diffids
4356 set file [lindex $line 5]
4357 lappend treediff $file
4360 proc getblobdiffs {ids} {
4361 global diffopts blobdifffd diffids env curdifftag curtagstart
4362 global nextupdate diffinhdr treediffs
4364 set env(GIT_DIFF_OPTS) $diffopts
4365 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4366 if {[catch {set bdf [open $cmd r]} err]} {
4367 puts "error getting diffs: $err"
4371 fconfigure $bdf -blocking 0
4372 set blobdifffd($ids) $bdf
4373 set curdifftag Comments
4375 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4376 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4379 proc setinlist {var i val} {
4382 while {[llength [set $var]] < $i} {
4385 if {[llength [set $var]] == $i} {
4392 proc getblobdiffline {bdf ids} {
4393 global diffids blobdifffd ctext curdifftag curtagstart
4394 global diffnexthead diffnextnote difffilestart
4395 global nextupdate diffinhdr treediffs
4397 set n [gets $bdf line]
4401 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4402 $ctext tag add $curdifftag $curtagstart end
4407 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4410 $ctext conf -state normal
4411 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4412 # start of a new file
4413 $ctext insert end "\n"
4414 $ctext tag add $curdifftag $curtagstart end
4415 set here [$ctext index "end - 1c"]
4416 set curtagstart $here
4418 set i [lsearch -exact $treediffs($ids) $fname]
4420 setinlist difffilestart $i $here
4422 if {$newname ne $fname} {
4423 set i [lsearch -exact $treediffs($ids) $newname]
4425 setinlist difffilestart $i $here
4428 set curdifftag "f:$fname"
4429 $ctext tag delete $curdifftag
4430 set l [expr {(78 - [string length $header]) / 2}]
4431 set pad [string range "----------------------------------------" 1 $l]
4432 $ctext insert end "$pad $header $pad\n" filesep
4434 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4436 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4438 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4439 $line match f1l f1c f2l f2c rest]} {
4440 $ctext insert end "$line\n" hunksep
4443 set x [string range $line 0 0]
4444 if {$x == "-" || $x == "+"} {
4445 set tag [expr {$x == "+"}]
4446 $ctext insert end "$line\n" d$tag
4447 } elseif {$x == " "} {
4448 $ctext insert end "$line\n"
4449 } elseif {$diffinhdr || $x == "\\"} {
4450 # e.g. "\ No newline at end of file"
4451 $ctext insert end "$line\n" filesep
4453 # Something else we don't recognize
4454 if {$curdifftag != "Comments"} {
4455 $ctext insert end "\n"
4456 $ctext tag add $curdifftag $curtagstart end
4457 set curtagstart [$ctext index "end - 1c"]
4458 set curdifftag Comments
4460 $ctext insert end "$line\n" filesep
4463 $ctext conf -state disabled
4464 if {[clock clicks -milliseconds] >= $nextupdate} {
4466 fileevent $bdf readable {}
4468 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4473 global difffilestart ctext
4474 set prev [lindex $difffilestart 0]
4475 set here [$ctext index @0,0]
4476 foreach loc $difffilestart {
4477 if {[$ctext compare $loc >= $here]} {
4487 global difffilestart ctext
4488 set here [$ctext index @0,0]
4489 foreach loc $difffilestart {
4490 if {[$ctext compare $loc > $here]} {
4497 proc clear_ctext {{first 1.0}} {
4498 global ctext smarktop smarkbot
4500 set l [lindex [split $first .] 0]
4501 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4504 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4507 $ctext delete $first end
4510 proc incrsearch {name ix op} {
4511 global ctext searchstring searchdirn
4513 $ctext tag remove found 1.0 end
4514 if {[catch {$ctext index anchor}]} {
4515 # no anchor set, use start of selection, or of visible area
4516 set sel [$ctext tag ranges sel]
4518 $ctext mark set anchor [lindex $sel 0]
4519 } elseif {$searchdirn eq "-forwards"} {
4520 $ctext mark set anchor @0,0
4522 $ctext mark set anchor @0,[winfo height $ctext]
4525 if {$searchstring ne {}} {
4526 set here [$ctext search $searchdirn -- $searchstring anchor]
4535 global sstring ctext searchstring searchdirn
4538 $sstring icursor end
4539 set searchdirn -forwards
4540 if {$searchstring ne {}} {
4541 set sel [$ctext tag ranges sel]
4543 set start "[lindex $sel 0] + 1c"
4544 } elseif {[catch {set start [$ctext index anchor]}]} {
4547 set match [$ctext search -count mlen -- $searchstring $start]
4548 $ctext tag remove sel 1.0 end
4554 set mend "$match + $mlen c"
4555 $ctext tag add sel $match $mend
4556 $ctext mark unset anchor
4560 proc dosearchback {} {
4561 global sstring ctext searchstring searchdirn
4564 $sstring icursor end
4565 set searchdirn -backwards
4566 if {$searchstring ne {}} {
4567 set sel [$ctext tag ranges sel]
4569 set start [lindex $sel 0]
4570 } elseif {[catch {set start [$ctext index anchor]}]} {
4571 set start @0,[winfo height $ctext]
4573 set match [$ctext search -backwards -count ml -- $searchstring $start]
4574 $ctext tag remove sel 1.0 end
4580 set mend "$match + $ml c"
4581 $ctext tag add sel $match $mend
4582 $ctext mark unset anchor
4586 proc searchmark {first last} {
4587 global ctext searchstring
4591 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4592 if {$match eq {}} break
4593 set mend "$match + $mlen c"
4594 $ctext tag add found $match $mend
4598 proc searchmarkvisible {doall} {
4599 global ctext smarktop smarkbot
4601 set topline [lindex [split [$ctext index @0,0] .] 0]
4602 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4603 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4604 # no overlap with previous
4605 searchmark $topline $botline
4606 set smarktop $topline
4607 set smarkbot $botline
4609 if {$topline < $smarktop} {
4610 searchmark $topline [expr {$smarktop-1}]
4611 set smarktop $topline
4613 if {$botline > $smarkbot} {
4614 searchmark [expr {$smarkbot+1}] $botline
4615 set smarkbot $botline
4620 proc scrolltext {f0 f1} {
4623 .bleft.sb set $f0 $f1
4624 if {$searchstring ne {}} {
4630 global linespc charspc canvx0 canvy0 mainfont
4631 global xspc1 xspc2 lthickness
4633 set linespc [font metrics $mainfont -linespace]
4634 set charspc [font measure $mainfont "m"]
4635 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4636 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4637 set lthickness [expr {int($linespc / 9) + 1}]
4638 set xspc1(0) $linespc
4646 set ymax [lindex [$canv cget -scrollregion] 3]
4647 if {$ymax eq {} || $ymax == 0} return
4648 set span [$canv yview]
4651 allcanvs yview moveto [lindex $span 0]
4653 if {[info exists selectedline]} {
4654 selectline $selectedline 0
4655 allcanvs yview moveto [lindex $span 0]
4659 proc incrfont {inc} {
4660 global mainfont textfont ctext canv phase
4661 global stopped entries
4663 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4664 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4666 $ctext conf -font $textfont
4667 $ctext tag conf filesep -font [concat $textfont bold]
4668 foreach e $entries {
4669 $e conf -font $mainfont
4671 if {$phase eq "getcommits"} {
4672 $canv itemconf textitems -font $mainfont
4678 global sha1entry sha1string
4679 if {[string length $sha1string] == 40} {
4680 $sha1entry delete 0 end
4684 proc sha1change {n1 n2 op} {
4685 global sha1string currentid sha1but
4686 if {$sha1string == {}
4687 || ([info exists currentid] && $sha1string == $currentid)} {
4692 if {[$sha1but cget -state] == $state} return
4693 if {$state == "normal"} {
4694 $sha1but conf -state normal -relief raised -text "Goto: "
4696 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4700 proc gotocommit {} {
4701 global sha1string currentid commitrow tagids headids
4702 global displayorder numcommits curview
4704 if {$sha1string == {}
4705 || ([info exists currentid] && $sha1string == $currentid)} return
4706 if {[info exists tagids($sha1string)]} {
4707 set id $tagids($sha1string)
4708 } elseif {[info exists headids($sha1string)]} {
4709 set id $headids($sha1string)
4711 set id [string tolower $sha1string]
4712 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4714 foreach i $displayorder {
4715 if {[string match $id* $i]} {
4719 if {$matches ne {}} {
4720 if {[llength $matches] > 1} {
4721 error_popup "Short SHA1 id $id is ambiguous"
4724 set id [lindex $matches 0]
4728 if {[info exists commitrow($curview,$id)]} {
4729 selectline $commitrow($curview,$id) 1
4732 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4737 error_popup "$type $sha1string is not known"
4740 proc lineenter {x y id} {
4741 global hoverx hovery hoverid hovertimer
4742 global commitinfo canv
4744 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4748 if {[info exists hovertimer]} {
4749 after cancel $hovertimer
4751 set hovertimer [after 500 linehover]
4755 proc linemotion {x y id} {
4756 global hoverx hovery hoverid hovertimer
4758 if {[info exists hoverid] && $id == $hoverid} {
4761 if {[info exists hovertimer]} {
4762 after cancel $hovertimer
4764 set hovertimer [after 500 linehover]
4768 proc lineleave {id} {
4769 global hoverid hovertimer canv
4771 if {[info exists hoverid] && $id == $hoverid} {
4773 if {[info exists hovertimer]} {
4774 after cancel $hovertimer
4782 global hoverx hovery hoverid hovertimer
4783 global canv linespc lthickness
4784 global commitinfo mainfont
4786 set text [lindex $commitinfo($hoverid) 0]
4787 set ymax [lindex [$canv cget -scrollregion] 3]
4788 if {$ymax == {}} return
4789 set yfrac [lindex [$canv yview] 0]
4790 set x [expr {$hoverx + 2 * $linespc}]
4791 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4792 set x0 [expr {$x - 2 * $lthickness}]
4793 set y0 [expr {$y - 2 * $lthickness}]
4794 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4795 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4796 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4797 -fill \#ffff80 -outline black -width 1 -tags hover]
4799 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4804 proc clickisonarrow {id y} {
4807 set ranges [rowranges $id]
4808 set thresh [expr {2 * $lthickness + 6}]
4809 set n [expr {[llength $ranges] - 1}]
4810 for {set i 1} {$i < $n} {incr i} {
4811 set row [lindex $ranges $i]
4812 if {abs([yc $row] - $y) < $thresh} {
4819 proc arrowjump {id n y} {
4822 # 1 <-> 2, 3 <-> 4, etc...
4823 set n [expr {(($n - 1) ^ 1) + 1}]
4824 set row [lindex [rowranges $id] $n]
4826 set ymax [lindex [$canv cget -scrollregion] 3]
4827 if {$ymax eq {} || $ymax <= 0} return
4828 set view [$canv yview]
4829 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4830 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4834 allcanvs yview moveto $yfrac
4837 proc lineclick {x y id isnew} {
4838 global ctext commitinfo children canv thickerline curview
4840 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4845 # draw this line thicker than normal
4849 set ymax [lindex [$canv cget -scrollregion] 3]
4850 if {$ymax eq {}} return
4851 set yfrac [lindex [$canv yview] 0]
4852 set y [expr {$y + $yfrac * $ymax}]
4854 set dirn [clickisonarrow $id $y]
4856 arrowjump $id $dirn $y
4861 addtohistory [list lineclick $x $y $id 0]
4863 # fill the details pane with info about this line
4864 $ctext conf -state normal
4866 $ctext tag conf link -foreground blue -underline 1
4867 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4868 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4869 $ctext insert end "Parent:\t"
4870 $ctext insert end $id [list link link0]
4871 $ctext tag bind link0 <1> [list selbyid $id]
4872 set info $commitinfo($id)
4873 $ctext insert end "\n\t[lindex $info 0]\n"
4874 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4875 set date [formatdate [lindex $info 2]]
4876 $ctext insert end "\tDate:\t$date\n"
4877 set kids $children($curview,$id)
4879 $ctext insert end "\nChildren:"
4881 foreach child $kids {
4883 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4884 set info $commitinfo($child)
4885 $ctext insert end "\n\t"
4886 $ctext insert end $child [list link link$i]
4887 $ctext tag bind link$i <1> [list selbyid $child]
4888 $ctext insert end "\n\t[lindex $info 0]"
4889 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4890 set date [formatdate [lindex $info 2]]
4891 $ctext insert end "\n\tDate:\t$date\n"
4894 $ctext conf -state disabled
4898 proc normalline {} {
4900 if {[info exists thickerline]} {
4908 global commitrow curview
4909 if {[info exists commitrow($curview,$id)]} {
4910 selectline $commitrow($curview,$id) 1
4916 if {![info exists startmstime]} {
4917 set startmstime [clock clicks -milliseconds]
4919 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4922 proc rowmenu {x y id} {
4923 global rowctxmenu commitrow selectedline rowmenuid curview
4925 if {![info exists selectedline]
4926 || $commitrow($curview,$id) eq $selectedline} {
4931 $rowctxmenu entryconfigure "Diff this*" -state $state
4932 $rowctxmenu entryconfigure "Diff selected*" -state $state
4933 $rowctxmenu entryconfigure "Make patch" -state $state
4935 tk_popup $rowctxmenu $x $y
4938 proc diffvssel {dirn} {
4939 global rowmenuid selectedline displayorder
4941 if {![info exists selectedline]} return
4943 set oldid [lindex $displayorder $selectedline]
4944 set newid $rowmenuid
4946 set oldid $rowmenuid
4947 set newid [lindex $displayorder $selectedline]
4949 addtohistory [list doseldiff $oldid $newid]
4950 doseldiff $oldid $newid
4953 proc doseldiff {oldid newid} {
4957 $ctext conf -state normal
4960 $ctext insert end "From "
4961 $ctext tag conf link -foreground blue -underline 1
4962 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4963 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4964 $ctext tag bind link0 <1> [list selbyid $oldid]
4965 $ctext insert end $oldid [list link link0]
4966 $ctext insert end "\n "
4967 $ctext insert end [lindex $commitinfo($oldid) 0]
4968 $ctext insert end "\n\nTo "
4969 $ctext tag bind link1 <1> [list selbyid $newid]
4970 $ctext insert end $newid [list link link1]
4971 $ctext insert end "\n "
4972 $ctext insert end [lindex $commitinfo($newid) 0]
4973 $ctext insert end "\n"
4974 $ctext conf -state disabled
4975 $ctext tag delete Comments
4976 $ctext tag remove found 1.0 end
4977 startdiff [list $oldid $newid]
4981 global rowmenuid currentid commitinfo patchtop patchnum
4983 if {![info exists currentid]} return
4984 set oldid $currentid
4985 set oldhead [lindex $commitinfo($oldid) 0]
4986 set newid $rowmenuid
4987 set newhead [lindex $commitinfo($newid) 0]
4990 catch {destroy $top}
4992 label $top.title -text "Generate patch"
4993 grid $top.title - -pady 10
4994 label $top.from -text "From:"
4995 entry $top.fromsha1 -width 40 -relief flat
4996 $top.fromsha1 insert 0 $oldid
4997 $top.fromsha1 conf -state readonly
4998 grid $top.from $top.fromsha1 -sticky w
4999 entry $top.fromhead -width 60 -relief flat
5000 $top.fromhead insert 0 $oldhead
5001 $top.fromhead conf -state readonly
5002 grid x $top.fromhead -sticky w
5003 label $top.to -text "To:"
5004 entry $top.tosha1 -width 40 -relief flat
5005 $top.tosha1 insert 0 $newid
5006 $top.tosha1 conf -state readonly
5007 grid $top.to $top.tosha1 -sticky w
5008 entry $top.tohead -width 60 -relief flat
5009 $top.tohead insert 0 $newhead
5010 $top.tohead conf -state readonly
5011 grid x $top.tohead -sticky w
5012 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5013 grid $top.rev x -pady 10
5014 label $top.flab -text "Output file:"
5015 entry $top.fname -width 60
5016 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5018 grid $top.flab $top.fname -sticky w
5020 button $top.buts.gen -text "Generate" -command mkpatchgo
5021 button $top.buts.can -text "Cancel" -command mkpatchcan
5022 grid $top.buts.gen $top.buts.can
5023 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5024 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5025 grid $top.buts - -pady 10 -sticky ew
5029 proc mkpatchrev {} {
5032 set oldid [$patchtop.fromsha1 get]
5033 set oldhead [$patchtop.fromhead get]
5034 set newid [$patchtop.tosha1 get]
5035 set newhead [$patchtop.tohead get]
5036 foreach e [list fromsha1 fromhead tosha1 tohead] \
5037 v [list $newid $newhead $oldid $oldhead] {
5038 $patchtop.$e conf -state normal
5039 $patchtop.$e delete 0 end
5040 $patchtop.$e insert 0 $v
5041 $patchtop.$e conf -state readonly
5048 set oldid [$patchtop.fromsha1 get]
5049 set newid [$patchtop.tosha1 get]
5050 set fname [$patchtop.fname get]
5051 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5052 error_popup "Error creating patch: $err"
5054 catch {destroy $patchtop}
5058 proc mkpatchcan {} {
5061 catch {destroy $patchtop}
5066 global rowmenuid mktagtop commitinfo
5070 catch {destroy $top}
5072 label $top.title -text "Create tag"
5073 grid $top.title - -pady 10
5074 label $top.id -text "ID:"
5075 entry $top.sha1 -width 40 -relief flat
5076 $top.sha1 insert 0 $rowmenuid
5077 $top.sha1 conf -state readonly
5078 grid $top.id $top.sha1 -sticky w
5079 entry $top.head -width 60 -relief flat
5080 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5081 $top.head conf -state readonly
5082 grid x $top.head -sticky w
5083 label $top.tlab -text "Tag name:"
5084 entry $top.tag -width 60
5085 grid $top.tlab $top.tag -sticky w
5087 button $top.buts.gen -text "Create" -command mktaggo
5088 button $top.buts.can -text "Cancel" -command mktagcan
5089 grid $top.buts.gen $top.buts.can
5090 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5091 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5092 grid $top.buts - -pady 10 -sticky ew
5097 global mktagtop env tagids idtags
5099 set id [$mktagtop.sha1 get]
5100 set tag [$mktagtop.tag get]
5102 error_popup "No tag name specified"
5105 if {[info exists tagids($tag)]} {
5106 error_popup "Tag \"$tag\" already exists"
5111 set fname [file join $dir "refs/tags" $tag]
5112 set f [open $fname w]
5116 error_popup "Error creating tag: $err"
5120 set tagids($tag) $id
5121 lappend idtags($id) $tag
5126 proc redrawtags {id} {
5127 global canv linehtag commitrow idpos selectedline curview
5128 global mainfont canvxmax
5130 if {![info exists commitrow($curview,$id)]} return
5131 drawcmitrow $commitrow($curview,$id)
5132 $canv delete tag.$id
5133 set xt [eval drawtags $id $idpos($id)]
5134 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5135 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5136 set xr [expr {$xt + [font measure $mainfont $text]}]
5137 if {$xr > $canvxmax} {
5141 if {[info exists selectedline]
5142 && $selectedline == $commitrow($curview,$id)} {
5143 selectline $selectedline 0
5150 catch {destroy $mktagtop}
5159 proc writecommit {} {
5160 global rowmenuid wrcomtop commitinfo wrcomcmd
5162 set top .writecommit
5164 catch {destroy $top}
5166 label $top.title -text "Write commit to file"
5167 grid $top.title - -pady 10
5168 label $top.id -text "ID:"
5169 entry $top.sha1 -width 40 -relief flat
5170 $top.sha1 insert 0 $rowmenuid
5171 $top.sha1 conf -state readonly
5172 grid $top.id $top.sha1 -sticky w
5173 entry $top.head -width 60 -relief flat
5174 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5175 $top.head conf -state readonly
5176 grid x $top.head -sticky w
5177 label $top.clab -text "Command:"
5178 entry $top.cmd -width 60 -textvariable wrcomcmd
5179 grid $top.clab $top.cmd -sticky w -pady 10
5180 label $top.flab -text "Output file:"
5181 entry $top.fname -width 60
5182 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5183 grid $top.flab $top.fname -sticky w
5185 button $top.buts.gen -text "Write" -command wrcomgo
5186 button $top.buts.can -text "Cancel" -command wrcomcan
5187 grid $top.buts.gen $top.buts.can
5188 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5189 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5190 grid $top.buts - -pady 10 -sticky ew
5197 set id [$wrcomtop.sha1 get]
5198 set cmd "echo $id | [$wrcomtop.cmd get]"
5199 set fname [$wrcomtop.fname get]
5200 if {[catch {exec sh -c $cmd >$fname &} err]} {
5201 error_popup "Error writing commit: $err"
5203 catch {destroy $wrcomtop}
5210 catch {destroy $wrcomtop}
5215 global rowmenuid mkbrtop
5218 catch {destroy $top}
5220 label $top.title -text "Create new branch"
5221 grid $top.title - -pady 10
5222 label $top.id -text "ID:"
5223 entry $top.sha1 -width 40 -relief flat
5224 $top.sha1 insert 0 $rowmenuid
5225 $top.sha1 conf -state readonly
5226 grid $top.id $top.sha1 -sticky w
5227 label $top.nlab -text "Name:"
5228 entry $top.name -width 40
5229 grid $top.nlab $top.name -sticky w
5231 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5232 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5233 grid $top.buts.go $top.buts.can
5234 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5235 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5236 grid $top.buts - -pady 10 -sticky ew
5241 global headids idheads
5243 set name [$top.name get]
5244 set id [$top.sha1 get]
5246 error_popup "Please specify a name for the new branch"
5249 catch {destroy $top}
5253 exec git branch $name $id
5259 # XXX should update list of heads displayed for selected commit
5265 proc cherrypick {} {
5266 global rowmenuid curview commitrow
5267 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5269 if {[info exists desc_heads($rowmenuid)]
5270 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5271 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5272 included in branch $mainhead -- really re-apply it?"]
5277 set oldhead [exec git rev-parse HEAD]
5278 # Unfortunately git-cherry-pick writes stuff to stderr even when
5279 # no error occurs, and exec takes that as an indication of error...
5280 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5285 set newhead [exec git rev-parse HEAD]
5286 if {$newhead eq $oldhead} {
5288 error_popup "No changes committed"
5291 set allparents($newhead) $oldhead
5292 lappend allchildren($oldhead) $newhead
5293 set desc_heads($newhead) $mainhead
5294 if {[info exists anc_tags($oldhead)]} {
5295 set anc_tags($newhead) $anc_tags($oldhead)
5297 set desc_tags($newhead) {}
5298 if {[info exists commitrow($curview,$oldhead)]} {
5299 insertrow $commitrow($curview,$oldhead) $newhead
5300 if {$mainhead ne {}} {
5301 movedhead $newhead $mainhead
5309 # context menu for a head
5310 proc headmenu {x y id head} {
5311 global headmenuid headmenuhead headctxmenu
5314 set headmenuhead $head
5315 tk_popup $headctxmenu $x $y
5319 global headmenuid headmenuhead mainhead headids
5321 # check the tree is clean first??
5322 set oldmainhead $mainhead
5326 exec git checkout $headmenuhead
5332 set mainhead $headmenuhead
5333 if {[info exists headids($oldmainhead)]} {
5334 redrawtags $headids($oldmainhead)
5336 redrawtags $headmenuid
5341 global desc_heads headmenuid headmenuhead mainhead
5342 global headids idheads
5344 set head $headmenuhead
5346 if {$head eq $mainhead} {
5347 error_popup "Cannot delete the currently checked-out branch"
5350 if {$desc_heads($id) eq $head} {
5351 # the stuff on this branch isn't on any other branch
5352 if {![confirm_popup "The commits on branch $head aren't on any other\
5353 branch.\nReally delete branch $head?"]} return
5357 if {[catch {exec git branch -D $head} err]} {
5362 removedhead $id $head
5367 # Stuff for finding nearby tags
5368 proc getallcommits {} {
5369 global allcstart allcommits allcfd allids
5372 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5374 fconfigure $fd -blocking 0
5375 set allcommits "reading"
5380 proc discardallcommits {} {
5381 global allparents allchildren allcommits allcfd
5382 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5384 if {![info exists allcommits]} return
5385 if {$allcommits eq "reading"} {
5386 catch {close $allcfd}
5388 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5389 alldtags tagisdesc desc_heads} {
5394 proc restartgetall {fd} {
5397 fileevent $fd readable [list getallclines $fd]
5398 set allcstart [clock clicks -milliseconds]
5401 proc combine_dtags {l1 l2} {
5402 global tagisdesc notfirstd
5404 set res [lsort -unique [concat $l1 $l2]]
5405 for {set i 0} {$i < [llength $res]} {incr i} {
5406 set x [lindex $res $i]
5407 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5408 set y [lindex $res $j]
5409 if {[info exists tagisdesc($x,$y)]} {
5410 if {$tagisdesc($x,$y) > 0} {
5411 # x is a descendent of y, exclude x
5412 set res [lreplace $res $i $i]
5416 # y is a descendent of x, exclude y
5417 set res [lreplace $res $j $j]
5420 # no relation, keep going
5428 proc combine_atags {l1 l2} {
5431 set res [lsort -unique [concat $l1 $l2]]
5432 for {set i 0} {$i < [llength $res]} {incr i} {
5433 set x [lindex $res $i]
5434 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5435 set y [lindex $res $j]
5436 if {[info exists tagisdesc($x,$y)]} {
5437 if {$tagisdesc($x,$y) < 0} {
5438 # x is an ancestor of y, exclude x
5439 set res [lreplace $res $i $i]
5443 # y is an ancestor of x, exclude y
5444 set res [lreplace $res $j $j]
5447 # no relation, keep going
5455 proc forward_pass {id children} {
5456 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5460 foreach child $children {
5461 if {[info exists idtags($child)]} {
5462 set ctags [list $child]
5464 set ctags $desc_tags($child)
5468 } elseif {$ctags ne $dtags} {
5469 set dtags [combine_dtags $dtags $ctags]
5471 set cheads $desc_heads($child)
5472 if {$dheads eq {}} {
5474 } elseif {$cheads ne $dheads} {
5475 set dheads [lsort -unique [concat $dheads $cheads]]
5478 set desc_tags($id) $dtags
5479 if {[info exists idtags($id)]} {
5481 foreach tag $dtags {
5482 set adt [concat $adt $alldtags($tag)]
5484 set adt [lsort -unique $adt]
5485 set alldtags($id) $adt
5487 set tagisdesc($id,$tag) -1
5488 set tagisdesc($tag,$id) 1
5491 if {[info exists idheads($id)]} {
5492 set dheads [concat $dheads $idheads($id)]
5494 set desc_heads($id) $dheads
5497 proc getallclines {fd} {
5498 global allparents allchildren allcommits allcstart
5499 global desc_tags anc_tags idtags tagisdesc allids
5500 global idheads travindex
5502 while {[gets $fd line] >= 0} {
5503 set id [lindex $line 0]
5505 set olds [lrange $line 1 end]
5506 set allparents($id) $olds
5507 if {![info exists allchildren($id)]} {
5508 set allchildren($id) {}
5511 lappend allchildren($p) $id
5513 # compute nearest tagged descendents as we go
5514 # also compute descendent heads
5515 forward_pass $id $allchildren($id)
5516 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5517 fileevent $fd readable {}
5518 after idle restartgetall $fd
5523 set travindex [llength $allids]
5524 set allcommits "traversing"
5525 after idle restartatags
5526 if {[catch {close $fd} err]} {
5527 error_popup "Error reading full commit graph: $err.\n\
5528 Results may be incomplete."
5533 # walk backward through the tree and compute nearest tagged ancestors
5534 proc restartatags {} {
5535 global allids allparents idtags anc_tags travindex
5537 set t0 [clock clicks -milliseconds]
5539 while {[incr i -1] >= 0} {
5540 set id [lindex $allids $i]
5542 foreach p $allparents($id) {
5543 if {[info exists idtags($p)]} {
5546 set ptags $anc_tags($p)
5550 } elseif {$ptags ne $atags} {
5551 set atags [combine_atags $atags $ptags]
5554 set anc_tags($id) $atags
5555 if {[clock clicks -milliseconds] - $t0 >= 50} {
5557 after idle restartatags
5561 set allcommits "done"
5567 # update the desc_tags and anc_tags arrays for a new tag just added
5568 proc addedtag {id} {
5569 global desc_tags anc_tags allparents allchildren allcommits
5570 global idtags tagisdesc alldtags
5572 if {![info exists desc_tags($id)]} return
5573 set adt $desc_tags($id)
5574 foreach t $desc_tags($id) {
5575 set adt [concat $adt $alldtags($t)]
5577 set adt [lsort -unique $adt]
5578 set alldtags($id) $adt
5580 set tagisdesc($id,$t) -1
5581 set tagisdesc($t,$id) 1
5583 if {[info exists anc_tags($id)]} {
5584 set todo $anc_tags($id)
5585 while {$todo ne {}} {
5586 set do [lindex $todo 0]
5587 set todo [lrange $todo 1 end]
5588 if {[info exists tagisdesc($id,$do)]} continue
5589 set tagisdesc($do,$id) -1
5590 set tagisdesc($id,$do) 1
5591 if {[info exists anc_tags($do)]} {
5592 set todo [concat $todo $anc_tags($do)]
5597 set lastold $desc_tags($id)
5598 set lastnew [list $id]
5601 set todo $allparents($id)
5602 while {$todo ne {}} {
5603 set do [lindex $todo 0]
5604 set todo [lrange $todo 1 end]
5605 if {![info exists desc_tags($do)]} continue
5606 if {$desc_tags($do) ne $lastold} {
5607 set lastold $desc_tags($do)
5608 set lastnew [combine_dtags $lastold [list $id]]
5611 if {$lastold eq $lastnew} continue
5612 set desc_tags($do) $lastnew
5614 if {![info exists idtags($do)]} {
5615 set todo [concat $todo $allparents($do)]
5619 if {![info exists anc_tags($id)]} return
5620 set lastold $anc_tags($id)
5621 set lastnew [list $id]
5624 set todo $allchildren($id)
5625 while {$todo ne {}} {
5626 set do [lindex $todo 0]
5627 set todo [lrange $todo 1 end]
5628 if {![info exists anc_tags($do)]} continue
5629 if {$anc_tags($do) ne $lastold} {
5630 set lastold $anc_tags($do)
5631 set lastnew [combine_atags $lastold [list $id]]
5634 if {$lastold eq $lastnew} continue
5635 set anc_tags($do) $lastnew
5637 if {![info exists idtags($do)]} {
5638 set todo [concat $todo $allchildren($do)]
5643 # update the desc_heads array for a new head just added
5644 proc addedhead {hid head} {
5645 global desc_heads allparents headids idheads
5647 set headids($head) $hid
5648 lappend idheads($hid) $head
5650 set todo [list $hid]
5651 while {$todo ne {}} {
5652 set do [lindex $todo 0]
5653 set todo [lrange $todo 1 end]
5654 if {![info exists desc_heads($do)] ||
5655 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5656 set oldheads $desc_heads($do)
5657 lappend desc_heads($do) $head
5658 set heads $desc_heads($do)
5660 set p $allparents($do)
5661 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5662 $desc_heads($p) ne $oldheads} break
5664 set desc_heads($do) $heads
5666 set todo [concat $todo $p]
5670 # update the desc_heads array for a head just removed
5671 proc removedhead {hid head} {
5672 global desc_heads allparents headids idheads
5674 unset headids($head)
5675 if {$idheads($hid) eq $head} {
5678 set i [lsearch -exact $idheads($hid) $head]
5680 set idheads($hid) [lreplace $idheads($hid) $i $i]
5684 set todo [list $hid]
5685 while {$todo ne {}} {
5686 set do [lindex $todo 0]
5687 set todo [lrange $todo 1 end]
5688 if {![info exists desc_heads($do)]} continue
5689 set i [lsearch -exact $desc_heads($do) $head]
5690 if {$i < 0} continue
5691 set oldheads $desc_heads($do)
5692 set heads [lreplace $desc_heads($do) $i $i]
5694 set desc_heads($do) $heads
5695 set p $allparents($do)
5696 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5697 $desc_heads($p) ne $oldheads} break
5700 set todo [concat $todo $p]
5704 # update things for a head moved to a child of its previous location
5705 proc movedhead {id name} {
5706 global headids idheads
5708 set oldid $headids($name)
5709 set headids($name) $id
5710 if {$idheads($oldid) eq $name} {
5711 unset idheads($oldid)
5713 set i [lsearch -exact $idheads($oldid) $name]
5715 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5718 lappend idheads($id) $name
5721 proc changedrefs {} {
5722 global desc_heads desc_tags anc_tags allcommits allids
5723 global allchildren allparents idtags travindex
5725 if {![info exists allcommits]} return
5726 catch {unset desc_heads}
5727 catch {unset desc_tags}
5728 catch {unset anc_tags}
5729 catch {unset alldtags}
5730 catch {unset tagisdesc}
5731 foreach id $allids {
5732 forward_pass $id $allchildren($id)
5734 if {$allcommits ne "reading"} {
5735 set travindex [llength $allids]
5736 if {$allcommits ne "traversing"} {
5737 set allcommits "traversing"
5738 after idle restartatags
5743 proc rereadrefs {} {
5744 global idtags idheads idotherrefs mainhead
5746 set refids [concat [array names idtags] \
5747 [array names idheads] [array names idotherrefs]]
5748 foreach id $refids {
5749 if {![info exists ref($id)]} {
5750 set ref($id) [listrefs $id]
5753 set oldmainhead $mainhead
5756 set refids [lsort -unique [concat $refids [array names idtags] \
5757 [array names idheads] [array names idotherrefs]]]
5758 foreach id $refids {
5759 set v [listrefs $id]
5760 if {![info exists ref($id)] || $ref($id) != $v ||
5761 ($id eq $oldmainhead && $id ne $mainhead) ||
5762 ($id eq $mainhead && $id ne $oldmainhead)} {
5768 proc listrefs {id} {
5769 global idtags idheads idotherrefs
5772 if {[info exists idtags($id)]} {
5776 if {[info exists idheads($id)]} {
5780 if {[info exists idotherrefs($id)]} {
5781 set z $idotherrefs($id)
5783 return [list $x $y $z]
5786 proc showtag {tag isnew} {
5787 global ctext tagcontents tagids linknum
5790 addtohistory [list showtag $tag 0]
5792 $ctext conf -state normal
5795 if {[info exists tagcontents($tag)]} {
5796 set text $tagcontents($tag)
5798 set text "Tag: $tag\nId: $tagids($tag)"
5800 appendwithlinks $text {}
5801 $ctext conf -state disabled
5813 global maxwidth maxgraphpct diffopts
5814 global oldprefs prefstop showneartags
5815 global bgcolor fgcolor ctext diffcolors
5819 if {[winfo exists $top]} {
5823 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5824 set oldprefs($v) [set $v]
5827 wm title $top "Gitk preferences"
5828 label $top.ldisp -text "Commit list display options"
5829 grid $top.ldisp - -sticky w -pady 10
5830 label $top.spacer -text " "
5831 label $top.maxwidthl -text "Maximum graph width (lines)" \
5833 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5834 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5835 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5837 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5838 grid x $top.maxpctl $top.maxpct -sticky w
5840 label $top.ddisp -text "Diff display options"
5841 grid $top.ddisp - -sticky w -pady 10
5842 label $top.diffoptl -text "Options for diff program" \
5844 entry $top.diffopt -width 20 -textvariable diffopts
5845 grid x $top.diffoptl $top.diffopt -sticky w
5847 label $top.ntag.l -text "Display nearby tags" -font optionfont
5848 checkbutton $top.ntag.b -variable showneartags
5849 pack $top.ntag.b $top.ntag.l -side left
5850 grid x $top.ntag -sticky w
5852 label $top.cdisp -text "Colors: press to choose"
5853 grid $top.cdisp - -sticky w -pady 10
5854 label $top.bg -padx 40 -relief sunk -background $bgcolor
5855 button $top.bgbut -text "Background" -font optionfont \
5856 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5857 grid x $top.bgbut $top.bg -sticky w
5858 label $top.fg -padx 40 -relief sunk -background $fgcolor
5859 button $top.fgbut -text "Foreground" -font optionfont \
5860 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5861 grid x $top.fgbut $top.fg -sticky w
5862 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5863 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5864 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5865 [list $ctext tag conf d0 -foreground]]
5866 grid x $top.diffoldbut $top.diffold -sticky w
5867 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5868 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5869 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5870 [list $ctext tag conf d1 -foreground]]
5871 grid x $top.diffnewbut $top.diffnew -sticky w
5872 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5873 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5874 -command [list choosecolor diffcolors 2 $top.hunksep \
5875 "diff hunk header" \
5876 [list $ctext tag conf hunksep -foreground]]
5877 grid x $top.hunksepbut $top.hunksep -sticky w
5880 button $top.buts.ok -text "OK" -command prefsok
5881 button $top.buts.can -text "Cancel" -command prefscan
5882 grid $top.buts.ok $top.buts.can
5883 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5884 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5885 grid $top.buts - - -pady 10 -sticky ew
5888 proc choosecolor {v vi w x cmd} {
5891 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5892 -title "Gitk: choose color for $x"]
5893 if {$c eq {}} return
5894 $w conf -background $c
5903 $w conf -background $c
5911 $w conf -foreground $c
5913 allcanvs itemconf text -fill $c
5914 $canv itemconf circle -outline $c
5918 global maxwidth maxgraphpct diffopts
5919 global oldprefs prefstop showneartags
5921 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5922 set $v $oldprefs($v)
5924 catch {destroy $prefstop}
5929 global maxwidth maxgraphpct
5930 global oldprefs prefstop showneartags
5932 catch {destroy $prefstop}
5934 if {$maxwidth != $oldprefs(maxwidth)
5935 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5937 } elseif {$showneartags != $oldprefs(showneartags)} {
5942 proc formatdate {d} {
5943 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5946 # This list of encoding names and aliases is distilled from
5947 # http://www.iana.org/assignments/character-sets.
5948 # Not all of them are supported by Tcl.
5949 set encoding_aliases {
5950 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5951 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5952 { ISO-10646-UTF-1 csISO10646UTF1 }
5953 { ISO_646.basic:1983 ref csISO646basic1983 }
5954 { INVARIANT csINVARIANT }
5955 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5956 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5957 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5958 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5959 { NATS-DANO iso-ir-9-1 csNATSDANO }
5960 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5961 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5962 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5963 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5964 { ISO-2022-KR csISO2022KR }
5966 { ISO-2022-JP csISO2022JP }
5967 { ISO-2022-JP-2 csISO2022JP2 }
5968 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5970 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5971 { IT iso-ir-15 ISO646-IT csISO15Italian }
5972 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5973 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5974 { greek7-old iso-ir-18 csISO18Greek7Old }
5975 { latin-greek iso-ir-19 csISO19LatinGreek }
5976 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5977 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5978 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5979 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5980 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5981 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5982 { INIS iso-ir-49 csISO49INIS }
5983 { INIS-8 iso-ir-50 csISO50INIS8 }
5984 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5985 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5986 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5987 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5988 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5989 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5991 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5992 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5993 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5994 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5995 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5996 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5997 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5998 { greek7 iso-ir-88 csISO88Greek7 }
5999 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6000 { iso-ir-90 csISO90 }
6001 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6002 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6003 csISO92JISC62991984b }
6004 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6005 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6006 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6007 csISO95JIS62291984handadd }
6008 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6009 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6010 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6011 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6013 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6014 { T.61-7bit iso-ir-102 csISO102T617bit }
6015 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6016 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6017 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6018 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6019 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6020 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6021 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6022 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6023 arabic csISOLatinArabic }
6024 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6025 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6026 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6027 greek greek8 csISOLatinGreek }
6028 { T.101-G2 iso-ir-128 csISO128T101G2 }
6029 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6031 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6032 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6033 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6034 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6035 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6036 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6037 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6038 csISOLatinCyrillic }
6039 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6040 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6041 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6042 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6043 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6044 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6045 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6046 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6047 { ISO_10367-box iso-ir-155 csISO10367Box }
6048 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6049 { latin-lap lap iso-ir-158 csISO158Lap }
6050 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6051 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6054 { JIS_X0201 X0201 csHalfWidthKatakana }
6055 { KSC5636 ISO646-KR csKSC5636 }
6056 { ISO-10646-UCS-2 csUnicode }
6057 { ISO-10646-UCS-4 csUCS4 }
6058 { DEC-MCS dec csDECMCS }
6059 { hp-roman8 roman8 r8 csHPRoman8 }
6060 { macintosh mac csMacintosh }
6061 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6063 { IBM038 EBCDIC-INT cp038 csIBM038 }
6064 { IBM273 CP273 csIBM273 }
6065 { IBM274 EBCDIC-BE CP274 csIBM274 }
6066 { IBM275 EBCDIC-BR cp275 csIBM275 }
6067 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6068 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6069 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6070 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6071 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6072 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6073 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6074 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6075 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6076 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6077 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6078 { IBM437 cp437 437 csPC8CodePage437 }
6079 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6080 { IBM775 cp775 csPC775Baltic }
6081 { IBM850 cp850 850 csPC850Multilingual }
6082 { IBM851 cp851 851 csIBM851 }
6083 { IBM852 cp852 852 csPCp852 }
6084 { IBM855 cp855 855 csIBM855 }
6085 { IBM857 cp857 857 csIBM857 }
6086 { IBM860 cp860 860 csIBM860 }
6087 { IBM861 cp861 861 cp-is csIBM861 }
6088 { IBM862 cp862 862 csPC862LatinHebrew }
6089 { IBM863 cp863 863 csIBM863 }
6090 { IBM864 cp864 csIBM864 }
6091 { IBM865 cp865 865 csIBM865 }
6092 { IBM866 cp866 866 csIBM866 }
6093 { IBM868 CP868 cp-ar csIBM868 }
6094 { IBM869 cp869 869 cp-gr csIBM869 }
6095 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6096 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6097 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6098 { IBM891 cp891 csIBM891 }
6099 { IBM903 cp903 csIBM903 }
6100 { IBM904 cp904 904 csIBBM904 }
6101 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6102 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6103 { IBM1026 CP1026 csIBM1026 }
6104 { EBCDIC-AT-DE csIBMEBCDICATDE }
6105 { EBCDIC-AT-DE-A csEBCDICATDEA }
6106 { EBCDIC-CA-FR csEBCDICCAFR }
6107 { EBCDIC-DK-NO csEBCDICDKNO }
6108 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6109 { EBCDIC-FI-SE csEBCDICFISE }
6110 { EBCDIC-FI-SE-A csEBCDICFISEA }
6111 { EBCDIC-FR csEBCDICFR }
6112 { EBCDIC-IT csEBCDICIT }
6113 { EBCDIC-PT csEBCDICPT }
6114 { EBCDIC-ES csEBCDICES }
6115 { EBCDIC-ES-A csEBCDICESA }
6116 { EBCDIC-ES-S csEBCDICESS }
6117 { EBCDIC-UK csEBCDICUK }
6118 { EBCDIC-US csEBCDICUS }
6119 { UNKNOWN-8BIT csUnknown8BiT }
6120 { MNEMONIC csMnemonic }
6125 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6126 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6127 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6128 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6129 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6130 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6131 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6132 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6133 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6134 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6135 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6136 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6137 { IBM1047 IBM-1047 }
6138 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6139 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6140 { UNICODE-1-1 csUnicode11 }
6143 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6144 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6146 { ISO-8859-15 ISO_8859-15 Latin-9 }
6147 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6148 { GBK CP936 MS936 windows-936 }
6149 { JIS_Encoding csJISEncoding }
6150 { Shift_JIS MS_Kanji csShiftJIS }
6151 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6153 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6154 { ISO-10646-UCS-Basic csUnicodeASCII }
6155 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6156 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6157 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6158 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6159 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6160 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6161 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6162 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6163 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6164 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6165 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6166 { Ventura-US csVenturaUS }
6167 { Ventura-International csVenturaInternational }
6168 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6169 { PC8-Turkish csPC8Turkish }
6170 { IBM-Symbols csIBMSymbols }
6171 { IBM-Thai csIBMThai }
6172 { HP-Legal csHPLegal }
6173 { HP-Pi-font csHPPiFont }
6174 { HP-Math8 csHPMath8 }
6175 { Adobe-Symbol-Encoding csHPPSMath }
6176 { HP-DeskTop csHPDesktop }
6177 { Ventura-Math csVenturaMath }
6178 { Microsoft-Publishing csMicrosoftPublishing }
6179 { Windows-31J csWindows31J }
6184 proc tcl_encoding {enc} {
6185 global encoding_aliases
6186 set names [encoding names]
6187 set lcnames [string tolower $names]
6188 set enc [string tolower $enc]
6189 set i [lsearch -exact $lcnames $enc]
6191 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6192 if {[regsub {^iso[-_]} $enc iso encx]} {
6193 set i [lsearch -exact $lcnames $encx]
6197 foreach l $encoding_aliases {
6198 set ll [string tolower $l]
6199 if {[lsearch -exact $ll $enc] < 0} continue
6200 # look through the aliases for one that tcl knows about
6202 set i [lsearch -exact $lcnames $e]
6204 if {[regsub {^iso[-_]} $e iso ex]} {
6205 set i [lsearch -exact $lcnames $ex]
6214 return [lindex $names $i]
6221 set diffopts "-U 5 -p"
6222 set wrcomcmd "git diff-tree --stdin -p --pretty"
6226 set gitencoding [exec git config --get i18n.commitencoding]
6228 if {$gitencoding == ""} {
6229 set gitencoding "utf-8"
6231 set tclencoding [tcl_encoding $gitencoding]
6232 if {$tclencoding == {}} {
6233 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6236 set mainfont {Helvetica 9}
6237 set textfont {Courier 9}
6238 set uifont {Helvetica 9 bold}
6239 set findmergefiles 0
6247 set cmitmode "patch"
6248 set wrapcomment "none"
6251 set colors {green red blue magenta darkgrey brown orange}
6254 set diffcolors {red "#00a000" blue}
6256 catch {source ~/.gitk}
6258 font create optionfont -family sans-serif -size -12
6262 switch -regexp -- $arg {
6264 "^-d" { set datemode 1 }
6266 lappend revtreeargs $arg
6271 # check that we can find a .git directory somewhere...
6273 if {![file isdirectory $gitdir]} {
6274 show_error {} . "Cannot find the git directory \"$gitdir\"."
6278 set cmdline_files {}
6279 set i [lsearch -exact $revtreeargs "--"]
6281 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6282 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6283 } elseif {$revtreeargs ne {}} {
6285 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6286 set cmdline_files [split $f "\n"]
6287 set n [llength $cmdline_files]
6288 set revtreeargs [lrange $revtreeargs 0 end-$n]
6290 # unfortunately we get both stdout and stderr in $err,
6291 # so look for "fatal:".
6292 set i [string first "fatal:" $err]
6294 set err [string range $err [expr {$i + 6}] end]
6296 show_error {} . "Bad arguments to gitk:\n$err"
6305 set highlight_paths {}
6306 set searchdirn -forwards
6315 set selectedhlview None
6326 wm title . "[file tail $argv0]: [file tail [pwd]]"
6329 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6330 # create a view for the files/dirs specified on the command line
6334 set viewname(1) "Command line"
6335 set viewfiles(1) $cmdline_files
6336 set viewargs(1) $revtreeargs
6339 .bar.view entryconf Edit* -state normal
6340 .bar.view entryconf Delete* -state normal
6343 if {[info exists permviews]} {
6344 foreach v $permviews {
6347 set viewname($n) [lindex $v 0]
6348 set viewfiles($n) [lindex $v 1]
6349 set viewargs($n) [lindex $v 2]