2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
26 set commitidx
($view) 0
27 set args
$viewargs($view)
28 if {$viewfiles($view) ne
{}} {
29 set args
[concat
$args "--" $viewfiles($view)]
31 set order
"--topo-order"
33 set order
"--date-order"
36 set fd
[open
[concat | git rev-list
--header $order \
37 --parents --boundary --default HEAD
$args] r
]
39 puts stderr
"Error executing git rev-list: $err"
43 set leftover
($view) {}
44 fconfigure
$fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure
$fd -encoding $tclencoding
48 fileevent
$fd readable
[list getcommitlines
$fd $view]
52 proc stop_rev_list
{} {
55 if {![info exists commfd
($curview)]} return
56 set fd
$commfd($curview)
62 unset commfd
($curview)
66 global phase canv mainfont curview
70 start_rev_list
$curview
71 show_status
"Reading commits..."
74 proc getcommitlines
{fd view
} {
75 global commitlisted nextupdate
76 global leftover commfd
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children curview hlview
79 global vparentlist vchildlist vdisporder vcmitlisted
81 set stuff
[read $fd 500000]
83 if {![eof
$fd]} return
87 # set it blocking so we wait for the process to terminate
88 fconfigure
$fd -blocking 1
89 if {[catch
{close
$fd} err
]} {
91 if {$view != $curview} {
92 set fv
" for the \"$viewname($view)\" view"
94 if {[string range
$err 0 4] == "usage"} {
95 set err
"Gitk: error reading commits$fv:\
96 bad arguments to git rev-list."
97 if {$viewname($view) eq
"Command line"} {
99 " (Note: arguments to gitk are passed to git rev-list\
100 to allow selection of commits to be displayed.)"
103 set err
"Error reading commits$fv: $err"
107 if {$view == $curview} {
108 after idle finishcommits
115 set i
[string first
"\0" $stuff $start]
117 append leftover
($view) [string range
$stuff $start end
]
121 set cmit
$leftover($view)
122 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
123 set leftover
($view) {}
125 set cmit
[string range
$stuff $start [expr {$i - 1}]]
127 set start
[expr {$i + 1}]
128 set j
[string first
"\n" $cmit]
132 set ids
[string range
$cmit 0 [expr {$j - 1}]]
133 if {[string range
$ids 0 0] == "-"} {
135 set ids
[string range
$ids 1 end
]
139 if {[string length
$id] != 40} {
147 if {[string length
$shortcmit] > 80} {
148 set shortcmit
"[string range $shortcmit 0 80]..."
150 error_popup
"Can't parse git rev-list output: {$shortcmit}"
153 set id
[lindex
$ids 0]
155 set olds
[lrange
$ids 1 end
]
158 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
159 lappend children
($view,$p) $id
166 if {![info exists children
($view,$id)]} {
167 set children
($view,$id) {}
169 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
170 set commitrow
($view,$id) $commitidx($view)
171 incr commitidx
($view)
172 if {$view == $curview} {
173 lappend parentlist
$olds
174 lappend childlist
$children($view,$id)
175 lappend displayorder
$id
176 lappend commitlisted
$listed
178 lappend vparentlist
($view) $olds
179 lappend vchildlist
($view) $children($view,$id)
180 lappend vdisporder
($view) $id
181 lappend vcmitlisted
($view) $listed
186 if {$view == $curview} {
187 while {[layoutmore
$nextupdate]} doupdate
188 } elseif
{[info exists hlview
] && $view == $hlview} {
192 if {[clock clicks
-milliseconds] >= $nextupdate} {
198 global commfd nextupdate numcommits
200 foreach v
[array names commfd
] {
201 fileevent
$commfd($v) readable
{}
204 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
205 foreach v
[array names commfd
] {
207 fileevent
$fd readable
[list getcommitlines
$fd $v]
211 proc readcommit
{id
} {
212 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
213 parsecommit
$id $contents 0
216 proc updatecommits
{} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
225 foreach id
$displayorder {
226 catch
{unset children
($n,$id)}
227 catch
{unset commitrow
($n,$id)}
230 catch
{unset selectedline
}
231 catch
{unset thickerline
}
232 catch
{unset viewdata
($n)}
238 proc parsecommit
{id contents listed
} {
239 global commitinfo cdate
248 set hdrend
[string first
"\n\n" $contents]
250 # should never happen...
251 set hdrend
[string length
$contents]
253 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
254 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
255 foreach line
[split $header "\n"] {
256 set tag
[lindex
$line 0]
257 if {$tag == "author"} {
258 set audate
[lindex
$line end-1
]
259 set auname
[lrange
$line 1 end-2
]
260 } elseif
{$tag == "committer"} {
261 set comdate
[lindex
$line end-1
]
262 set comname
[lrange
$line 1 end-2
]
266 # take the first line of the comment as the headline
267 set i
[string first
"\n" $comment]
269 set headline
[string trim
[string range
$comment 0 $i]]
271 set headline
$comment
274 # git rev-list indents the comment by 4 spaces;
275 # if we got this via git cat-file, add the indentation
277 foreach line
[split $comment "\n"] {
278 append newcomment
" "
279 append newcomment
$line
280 append newcomment
"\n"
282 set comment
$newcomment
284 if {$comdate != {}} {
285 set cdate
($id) $comdate
287 set commitinfo
($id) [list
$headline $auname $audate \
288 $comname $comdate $comment]
291 proc getcommit
{id
} {
292 global commitdata commitinfo
294 if {[info exists commitdata
($id)]} {
295 parsecommit
$id $commitdata($id) 1
298 if {![info exists commitinfo
($id)]} {
299 set commitinfo
($id) {"No commit information available"}
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs mainhead
309 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
312 set refd
[open
[list | git show-ref
] r
]
313 while {0 <= [set n
[gets
$refd line
]]} {
314 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
318 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
321 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
325 if {[regexp
{^remotes
/} $path match
]} {
328 if {$type == "tags"} {
329 set tagids
($name) $id
330 lappend idtags
($id) $name
335 set commit
[exec git rev-parse
"$id^0"]
336 if {$commit != $id} {
337 set tagids
($name) $commit
338 lappend idtags
($commit) $name
342 set tagcontents
($name) [exec git cat-file tag
$id]
344 } elseif
{ $type == "heads" } {
345 set headids
($name) $id
346 lappend idheads
($id) $name
348 set otherrefids
($name) $id
349 lappend idotherrefs
($id) $name
355 set thehead
[exec git symbolic-ref HEAD
]
356 if {[string match
"refs/heads/*" $thehead]} {
357 set mainhead
[string range
$thehead 11 end
]
362 proc show_error
{w top msg
} {
363 message
$w.m
-text $msg -justify center
-aspect 400
364 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
365 button
$w.ok
-text OK
-command "destroy $top"
366 pack
$w.ok
-side bottom
-fill x
367 bind $top <Visibility
> "grab $top; focus $top"
368 bind $top <Key-Return
> "destroy $top"
372 proc error_popup msg
{
376 show_error
$w $w $msg
379 proc confirm_popup msg
{
385 message
$w.m
-text $msg -justify center
-aspect 400
386 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
387 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
388 pack
$w.ok
-side left
-fill x
389 button
$w.cancel
-text Cancel
-command "destroy $w"
390 pack
$w.cancel
-side right
-fill x
391 bind $w <Visibility
> "grab $w; focus $w"
397 global canv canv2 canv3 linespc charspc ctext cflist
398 global textfont mainfont uifont
399 global findtype findtypemenu findloc findstring fstring geometry
400 global entries sha1entry sha1string sha1but
401 global maincursor textcursor curtextcursor
402 global rowctxmenu mergemax wrapcomment
403 global highlight_files gdttype
404 global searchstring sstring
405 global bgcolor fgcolor bglist fglist diffcolors
409 .bar add cascade
-label "File" -menu .bar.
file
410 .bar configure
-font $uifont
412 .bar.
file add
command -label "Update" -command updatecommits
413 .bar.
file add
command -label "Reread references" -command rereadrefs
414 .bar.
file add
command -label "Quit" -command doquit
415 .bar.
file configure
-font $uifont
417 .bar add cascade
-label "Edit" -menu .bar.edit
418 .bar.edit add
command -label "Preferences" -command doprefs
419 .bar.edit configure
-font $uifont
421 menu .bar.view
-font $uifont
422 .bar add cascade
-label "View" -menu .bar.view
423 .bar.view add
command -label "New view..." -command {newview
0}
424 .bar.view add
command -label "Edit view..." -command editview \
426 .bar.view add
command -label "Delete view" -command delview
-state disabled
427 .bar.view add separator
428 .bar.view add radiobutton
-label "All files" -command {showview
0} \
429 -variable selectedview
-value 0
432 .bar add cascade
-label "Help" -menu .bar.
help
433 .bar.
help add
command -label "About gitk" -command about
434 .bar.
help add
command -label "Key bindings" -command keys
435 .bar.
help configure
-font $uifont
436 . configure
-menu .bar
438 # the gui has upper and lower half, parts of a paned window.
439 panedwindow .ctop
-orient vertical
441 # possibly use assumed geometry
442 if {![info exists geometry
(pwsash0
)]} {
443 set geometry
(topheight
) [expr {15 * $linespc}]
444 set geometry
(topwidth
) [expr {80 * $charspc}]
445 set geometry
(botheight
) [expr {15 * $linespc}]
446 set geometry
(botwidth
) [expr {50 * $charspc}]
447 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
448 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
451 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
452 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
454 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
456 # create three canvases
457 set cscroll .tf.histframe.csb
458 set canv .tf.histframe.pwclist.canv
460 -background $bgcolor -bd 0 \
461 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
462 .tf.histframe.pwclist add
$canv
463 set canv2 .tf.histframe.pwclist.canv2
465 -background $bgcolor -bd 0 -yscrollincr $linespc
466 .tf.histframe.pwclist add
$canv2
467 set canv3 .tf.histframe.pwclist.canv3
469 -background $bgcolor -bd 0 -yscrollincr $linespc
470 .tf.histframe.pwclist add
$canv3
471 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
472 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
474 # a scroll bar to rule them
475 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
476 pack
$cscroll -side right
-fill y
477 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
478 lappend bglist
$canv $canv2 $canv3
479 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
481 # we have two button bars at bottom of top frame. Bar 1
483 frame .tf.lbar
-height 15
485 set sha1entry .tf.bar.sha1
486 set entries
$sha1entry
487 set sha1but .tf.bar.sha1label
488 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
489 -command gotocommit
-width 8 -font $uifont
490 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
491 pack .tf.bar.sha1label
-side left
492 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
493 trace add variable sha1string
write sha1change
494 pack
$sha1entry -side left
-pady 2
496 image create bitmap bm-left
-data {
497 #define left_width 16
498 #define left_height 16
499 static unsigned char left_bits
[] = {
500 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
501 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
502 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
504 image create bitmap bm-right
-data {
505 #define right_width 16
506 #define right_height 16
507 static unsigned char right_bits
[] = {
508 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
509 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
510 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
512 button .tf.bar.leftbut
-image bm-left
-command goback \
513 -state disabled
-width 26
514 pack .tf.bar.leftbut
-side left
-fill y
515 button .tf.bar.rightbut
-image bm-right
-command goforw \
516 -state disabled
-width 26
517 pack .tf.bar.rightbut
-side left
-fill y
519 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
520 pack .tf.bar.findbut
-side left
522 set fstring .tf.bar.findstring
523 lappend entries
$fstring
524 entry
$fstring -width 30 -font $textfont -textvariable findstring
525 trace add variable findstring
write find_change
526 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
528 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
529 findtype Exact IgnCase Regexp
]
530 trace add variable findtype
write find_change
531 .tf.bar.findtype configure
-font $uifont
532 .tf.bar.findtype.menu configure
-font $uifont
533 set findloc
"All fields"
534 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
535 Comments Author Committer
536 trace add variable findloc
write find_change
537 .tf.bar.findloc configure
-font $uifont
538 .tf.bar.findloc.menu configure
-font $uifont
539 pack .tf.bar.findloc
-side right
540 pack .tf.bar.findtype
-side right
542 # build up the bottom bar of upper window
543 label .tf.lbar.flabel
-text "Highlight: Commits " \
545 pack .tf.lbar.flabel
-side left
-fill y
546 set gdttype
"touching paths:"
547 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
548 "adding/removing string:"]
549 trace add variable gdttype
write hfiles_change
550 $gm conf
-font $uifont
551 .tf.lbar.gdttype conf
-font $uifont
552 pack .tf.lbar.gdttype
-side left
-fill y
553 entry .tf.lbar.fent
-width 25 -font $textfont \
554 -textvariable highlight_files
555 trace add variable highlight_files
write hfiles_change
556 lappend entries .tf.lbar.fent
557 pack .tf.lbar.fent
-side left
-fill x
-expand 1
558 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
559 pack .tf.lbar.vlabel
-side left
-fill y
560 global viewhlmenu selectedhlview
561 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
562 $viewhlmenu entryconf None
-command delvhighlight
563 $viewhlmenu conf
-font $uifont
564 .tf.lbar.vhl conf
-font $uifont
565 pack .tf.lbar.vhl
-side left
-fill y
566 label .tf.lbar.rlabel
-text " OR " -font $uifont
567 pack .tf.lbar.rlabel
-side left
-fill y
568 global highlight_related
569 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
570 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
571 $m conf
-font $uifont
572 .tf.lbar.relm conf
-font $uifont
573 trace add variable highlight_related
write vrel_change
574 pack .tf.lbar.relm
-side left
-fill y
576 # Finish putting the upper half of the viewer together
577 pack .tf.lbar
-in .tf
-side bottom
-fill x
578 pack .tf.bar
-in .tf
-side bottom
-fill x
579 pack .tf.histframe
-fill both
-side top
-expand 1
581 .ctop paneconfigure .tf
-height $geometry(topheight
)
582 .ctop paneconfigure .tf
-width $geometry(topwidth
)
584 # now build up the bottom
585 panedwindow .pwbottom
-orient horizontal
587 # lower left, a text box over search bar, scroll bar to the right
588 # if we know window height, then that will set the lower text height, otherwise
589 # we set lower text height which will drive window height
590 if {[info exists geometry
(main
)]} {
591 frame .bleft
-width $geometry(botwidth
)
593 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
597 button .bleft.top.search
-text "Search" -command dosearch \
599 pack .bleft.top.search
-side left
-padx 5
600 set sstring .bleft.top.sstring
601 entry
$sstring -width 20 -font $textfont -textvariable searchstring
602 lappend entries
$sstring
603 trace add variable searchstring
write incrsearch
604 pack
$sstring -side left
-expand 1 -fill x
605 set ctext .bleft.ctext
606 text
$ctext -background $bgcolor -foreground $fgcolor \
607 -state disabled
-font $textfont \
608 -yscrollcommand scrolltext
-wrap none
609 scrollbar .bleft.sb
-command "$ctext yview"
610 pack .bleft.top
-side top
-fill x
611 pack .bleft.sb
-side right
-fill y
612 pack
$ctext -side left
-fill both
-expand 1
613 lappend bglist
$ctext
614 lappend fglist
$ctext
616 $ctext tag conf comment
-wrap $wrapcomment
617 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
618 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
619 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
620 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
621 $ctext tag conf m0
-fore red
622 $ctext tag conf m1
-fore blue
623 $ctext tag conf m2
-fore green
624 $ctext tag conf m3
-fore purple
625 $ctext tag conf
m4 -fore brown
626 $ctext tag conf m5
-fore "#009090"
627 $ctext tag conf m6
-fore magenta
628 $ctext tag conf m7
-fore "#808000"
629 $ctext tag conf m8
-fore "#009000"
630 $ctext tag conf m9
-fore "#ff0080"
631 $ctext tag conf m10
-fore cyan
632 $ctext tag conf m11
-fore "#b07070"
633 $ctext tag conf m12
-fore "#70b0f0"
634 $ctext tag conf m13
-fore "#70f0b0"
635 $ctext tag conf m14
-fore "#f0b070"
636 $ctext tag conf m15
-fore "#ff70b0"
637 $ctext tag conf mmax
-fore darkgrey
639 $ctext tag conf mresult
-font [concat
$textfont bold
]
640 $ctext tag conf msep
-font [concat
$textfont bold
]
641 $ctext tag conf found
-back yellow
644 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
649 radiobutton .bright.mode.
patch -text "Patch" \
650 -command reselectline
-variable cmitmode
-value "patch"
651 radiobutton .bright.mode.tree
-text "Tree" \
652 -command reselectline
-variable cmitmode
-value "tree"
653 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
654 pack .bright.mode
-side top
-fill x
655 set cflist .bright.cfiles
656 set indent
[font measure
$mainfont "nn"]
658 -background $bgcolor -foreground $fgcolor \
660 -tabs [list
$indent [expr {2 * $indent}]] \
661 -yscrollcommand ".bright.sb set" \
662 -cursor [. cget
-cursor] \
663 -spacing1 1 -spacing3 1
664 lappend bglist
$cflist
665 lappend fglist
$cflist
666 scrollbar .bright.sb
-command "$cflist yview"
667 pack .bright.sb
-side right
-fill y
668 pack
$cflist -side left
-fill both
-expand 1
669 $cflist tag configure highlight \
670 -background [$cflist cget
-selectbackground]
671 $cflist tag configure bold
-font [concat
$mainfont bold
]
673 .pwbottom add .bright
676 # restore window position if known
677 if {[info exists geometry
(main
)]} {
678 wm geometry .
"$geometry(main)"
681 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
682 pack .ctop
-fill both
-expand 1
683 bindall
<1> {selcanvline
%W
%x
%y
}
684 #bindall <B1-Motion> {selcanvline %W %x %y}
685 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
686 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
687 bindall
<2> "canvscan mark %W %x %y"
688 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
689 bindkey
<Home
> selfirstline
690 bindkey
<End
> sellastline
691 bind .
<Key-Up
> "selnextline -1"
692 bind .
<Key-Down
> "selnextline 1"
693 bind .
<Shift-Key-Up
> "next_highlight -1"
694 bind .
<Shift-Key-Down
> "next_highlight 1"
695 bindkey
<Key-Right
> "goforw"
696 bindkey
<Key-Left
> "goback"
697 bind .
<Key-Prior
> "selnextpage -1"
698 bind .
<Key-Next
> "selnextpage 1"
699 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
700 bind .
<Control-End
> "allcanvs yview moveto 1.0"
701 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
702 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
703 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
704 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
705 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
706 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
707 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
708 bindkey p
"selnextline -1"
709 bindkey n
"selnextline 1"
712 bindkey i
"selnextline -1"
713 bindkey k
"selnextline 1"
716 bindkey b
"$ctext yview scroll -1 pages"
717 bindkey d
"$ctext yview scroll 18 units"
718 bindkey u
"$ctext yview scroll -18 units"
719 bindkey
/ {findnext
1}
720 bindkey
<Key-Return
> {findnext
0}
723 bind .
<Control-q
> doquit
724 bind .
<Control-f
> dofind
725 bind .
<Control-g
> {findnext
0}
726 bind .
<Control-r
> dosearchback
727 bind .
<Control-s
> dosearch
728 bind .
<Control-equal
> {incrfont
1}
729 bind .
<Control-KP_Add
> {incrfont
1}
730 bind .
<Control-minus
> {incrfont
-1}
731 bind .
<Control-KP_Subtract
> {incrfont
-1}
732 wm protocol . WM_DELETE_WINDOW doquit
733 bind .
<Button-1
> "click %W"
734 bind $fstring <Key-Return
> dofind
735 bind $sha1entry <Key-Return
> gotocommit
736 bind $sha1entry <<PasteSelection>> clearsha1
737 bind $cflist <1> {sel_flist %W %x %y; break}
738 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
739 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
741 set maincursor [. cget -cursor]
742 set textcursor [$ctext cget -cursor]
743 set curtextcursor $textcursor
745 set rowctxmenu .rowctxmenu
746 menu $rowctxmenu -tearoff 0
747 $rowctxmenu add command -label "Diff this -> selected" \
748 -command {diffvssel 0}
749 $rowctxmenu add command -label "Diff selected -> this" \
750 -command {diffvssel 1}
751 $rowctxmenu add command -label "Make patch" -command mkpatch
752 $rowctxmenu add command -label "Create tag" -command mktag
753 $rowctxmenu add command -label "Write commit to file" -command writecommit
754 $rowctxmenu add command -label "Create new branch" -command mkbranch
755 $rowctxmenu add command -label "Cherry-pick this commit" \
758 set headctxmenu .headctxmenu
759 menu $headctxmenu -tearoff 0
760 $headctxmenu add command -label "Check out this branch" \
762 $headctxmenu add command -label "Remove this branch" \
766 # mouse-2 makes all windows scan vertically, but only the one
767 # the cursor is in scans horizontally
768 proc canvscan {op w x y} {
769 global canv canv2 canv3
770 foreach c [list $canv $canv2 $canv3] {
779 proc scrollcanv {cscroll f0 f1} {
785 # when we make a key binding for the toplevel, make sure
786 # it doesn't get triggered when that key is pressed in the
787 # find string entry widget.
788 proc bindkey {ev script} {
791 set escript [bind Entry $ev]
792 if {$escript == {}} {
793 set escript [bind Entry <Key>]
796 bind $e $ev "$escript; break"
800 # set the focus back to the toplevel for any click outside
811 global canv canv2 canv3 ctext cflist mainfont textfont uifont
812 global stuffsaved findmergefiles maxgraphpct
813 global maxwidth showneartags
814 global viewname viewfiles viewargs viewperm nextviewnum
815 global cmitmode wrapcomment
816 global colors bgcolor fgcolor diffcolors
818 if {$stuffsaved} return
819 if {![winfo viewable .]} return
821 set f [open "~/.gitk-new" w]
822 puts $f [list set mainfont $mainfont]
823 puts $f [list set textfont $textfont]
824 puts $f [list set uifont $uifont]
825 puts $f [list set findmergefiles $findmergefiles]
826 puts $f [list set maxgraphpct $maxgraphpct]
827 puts $f [list set maxwidth $maxwidth]
828 puts $f [list set cmitmode $cmitmode]
829 puts $f [list set wrapcomment $wrapcomment]
830 puts $f [list set showneartags $showneartags]
831 puts $f [list set bgcolor $bgcolor]
832 puts $f [list set fgcolor $fgcolor]
833 puts $f [list set colors $colors]
834 puts $f [list set diffcolors $diffcolors]
836 puts $f "set geometry(main) [wm geometry .]"
837 puts $f "set geometry(topwidth) [winfo width .tf]"
838 puts $f "set geometry(topheight) [winfo height .tf]"
839 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
840 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
841 puts $f "set geometry(botwidth) [winfo width .bleft]"
842 puts $f "set geometry(botheight) [winfo height .bleft]"
844 puts -nonewline $f "set permviews {"
845 for {set v 0} {$v < $nextviewnum} {incr v} {
847 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
852 file rename -force "~/.gitk-new" "~/.gitk"
857 proc resizeclistpanes {win w} {
859 if {[info exists oldwidth($win)]} {
860 set s0 [$win sash coord 0]
861 set s1 [$win sash coord 1]
863 set sash0 [expr {int($w/2 - 2)}]
864 set sash1 [expr {int($w*5/6 - 2)}]
866 set factor [expr {1.0 * $w / $oldwidth($win)}]
867 set sash0 [expr {int($factor * [lindex $s0 0])}]
868 set sash1 [expr {int($factor * [lindex $s1 0])}]
872 if {$sash1 < $sash0 + 20} {
873 set sash1 [expr {$sash0 + 20}]
875 if {$sash1 > $w - 10} {
876 set sash1 [expr {$w - 10}]
877 if {$sash0 > $sash1 - 20} {
878 set sash0 [expr {$sash1 - 20}]
882 $win sash place 0 $sash0 [lindex $s0 1]
883 $win sash place 1 $sash1 [lindex $s1 1]
885 set oldwidth($win) $w
888 proc resizecdetpanes {win w} {
890 if {[info exists oldwidth($win)]} {
891 set s0 [$win sash coord 0]
893 set sash0 [expr {int($w*3/4 - 2)}]
895 set factor [expr {1.0 * $w / $oldwidth($win)}]
896 set sash0 [expr {int($factor * [lindex $s0 0])}]
900 if {$sash0 > $w - 15} {
901 set sash0 [expr {$w - 15}]
904 $win sash place 0 $sash0 [lindex $s0 1]
906 set oldwidth($win) $w
910 global canv canv2 canv3
916 proc bindall {event action} {
917 global canv canv2 canv3
918 bind $canv $event $action
919 bind $canv2 $event $action
920 bind $canv3 $event $action
925 if {[winfo exists $w]} {
930 wm title $w "About gitk"
932 Gitk - a commit viewer for git
934 Copyright © 2005-2006 Paul Mackerras
936 Use and redistribute under the terms of the GNU General Public License} \
937 -justify center -aspect 400
938 pack $w.m -side top -fill x -padx 20 -pady 20
939 button $w.ok -text Close -command "destroy $w"
940 pack $w.ok -side bottom
945 if {[winfo exists $w]} {
950 wm title $w "Gitk key bindings"
955 <Home> Move to first commit
956 <End> Move to last commit
957 <Up>, p, i Move up one commit
958 <Down>, n, k Move down one commit
959 <Left>, z, j Go back in history list
960 <Right>, x, l Go forward in history list
961 <PageUp> Move up one page in commit list
962 <PageDown> Move down one page in commit list
963 <Ctrl-Home> Scroll to top of commit list
964 <Ctrl-End> Scroll to bottom of commit list
965 <Ctrl-Up> Scroll commit list up one line
966 <Ctrl-Down> Scroll commit list down one line
967 <Ctrl-PageUp> Scroll commit list up one page
968 <Ctrl-PageDown> Scroll commit list down one page
969 <Shift-Up> Move to previous highlighted line
970 <Shift-Down> Move to next highlighted line
971 <Delete>, b Scroll diff view up one page
972 <Backspace> Scroll diff view up one page
973 <Space> Scroll diff view down one page
974 u Scroll diff view up 18 lines
975 d Scroll diff view down 18 lines
977 <Ctrl-G> Move to next find hit
978 <Return> Move to next find hit
979 / Move to next find hit, or redo find
980 ? Move to previous find hit
981 f Scroll diff view to next file
982 <Ctrl-S> Search for next hit in diff view
983 <Ctrl-R> Search for previous hit in diff view
984 <Ctrl-KP+> Increase font size
985 <Ctrl-plus> Increase font size
986 <Ctrl-KP-> Decrease font size
987 <Ctrl-minus> Decrease font size
989 -justify left -bg white -border 2 -relief sunken
990 pack $w.m -side top -fill both
991 button $w.ok -text Close -command "destroy $w"
992 pack $w.ok -side bottom
995 # Procedures for manipulating the file list window at the
996 # bottom right of the overall window.
998 proc treeview {w l openlevs} {
999 global treecontents treediropen treeheight treeparent treeindex
1009 set treecontents() {}
1010 $w conf -state normal
1012 while {[string range $f 0 $prefixend] ne $prefix} {
1013 if {$lev <= $openlevs} {
1014 $w mark set e:$treeindex($prefix) "end -1c"
1015 $w mark gravity e:$treeindex($prefix) left
1017 set treeheight($prefix) $ht
1018 incr ht [lindex $htstack end]
1019 set htstack [lreplace $htstack end end]
1020 set prefixend [lindex $prefendstack end]
1021 set prefendstack [lreplace $prefendstack end end]
1022 set prefix [string range $prefix 0 $prefixend]
1025 set tail [string range $f [expr {$prefixend+1}] end]
1026 while {[set slash [string first "/" $tail]] >= 0} {
1029 lappend prefendstack $prefixend
1030 incr prefixend [expr {$slash + 1}]
1031 set d [string range $tail 0 $slash]
1032 lappend treecontents($prefix) $d
1033 set oldprefix $prefix
1035 set treecontents($prefix) {}
1036 set treeindex($prefix) [incr ix]
1037 set treeparent($prefix) $oldprefix
1038 set tail [string range $tail [expr {$slash+1}] end]
1039 if {$lev <= $openlevs} {
1041 set treediropen($prefix) [expr {$lev < $openlevs}]
1042 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1043 $w mark set d:$ix "end -1c"
1044 $w mark gravity d:$ix left
1046 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1048 $w image create end -align center -image $bm -padx 1 \
1050 $w insert end $d [highlight_tag $prefix]
1051 $w mark set s:$ix "end -1c"
1052 $w mark gravity s:$ix left
1057 if {$lev <= $openlevs} {
1060 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1062 $w insert end $tail [highlight_tag $f]
1064 lappend treecontents($prefix) $tail
1067 while {$htstack ne {}} {
1068 set treeheight($prefix) $ht
1069 incr ht [lindex $htstack end]
1070 set htstack [lreplace $htstack end end]
1072 $w conf -state disabled
1075 proc linetoelt {l} {
1076 global treeheight treecontents
1081 foreach e $treecontents($prefix) {
1086 if {[string index $e end] eq "/"} {
1087 set n $treeheight($prefix$e)
1099 proc highlight_tree {y prefix} {
1100 global treeheight treecontents cflist
1102 foreach e $treecontents($prefix) {
1104 if {[highlight_tag $path] ne {}} {
1105 $cflist tag add bold $y.0 "$y.0 lineend"
1108 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1109 set y [highlight_tree $y $path]
1115 proc treeclosedir {w dir} {
1116 global treediropen treeheight treeparent treeindex
1118 set ix $treeindex($dir)
1119 $w conf -state normal
1120 $w delete s:$ix e:$ix
1121 set treediropen($dir) 0
1122 $w image configure a:$ix -image tri-rt
1123 $w conf -state disabled
1124 set n [expr {1 - $treeheight($dir)}]
1125 while {$dir ne {}} {
1126 incr treeheight($dir) $n
1127 set dir $treeparent($dir)
1131 proc treeopendir {w dir} {
1132 global treediropen treeheight treeparent treecontents treeindex
1134 set ix $treeindex($dir)
1135 $w conf -state normal
1136 $w image configure a:$ix -image tri-dn
1137 $w mark set e:$ix s:$ix
1138 $w mark gravity e:$ix right
1141 set n [llength $treecontents($dir)]
1142 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1145 incr treeheight($x) $n
1147 foreach e $treecontents($dir) {
1149 if {[string index $e end] eq "/"} {
1150 set iy $treeindex($de)
1151 $w mark set d:$iy e:$ix
1152 $w mark gravity d:$iy left
1153 $w insert e:$ix $str
1154 set treediropen($de) 0
1155 $w image create e:$ix -align center -image tri-rt -padx 1 \
1157 $w insert e:$ix $e [highlight_tag $de]
1158 $w mark set s:$iy e:$ix
1159 $w mark gravity s:$iy left
1160 set treeheight($de) 1
1162 $w insert e:$ix $str
1163 $w insert e:$ix $e [highlight_tag $de]
1166 $w mark gravity e:$ix left
1167 $w conf -state disabled
1168 set treediropen($dir) 1
1169 set top [lindex [split [$w index @0,0] .] 0]
1170 set ht [$w cget -height]
1171 set l [lindex [split [$w index s:$ix] .] 0]
1174 } elseif {$l + $n + 1 > $top + $ht} {
1175 set top [expr {$l + $n + 2 - $ht}]
1183 proc treeclick {w x y} {
1184 global treediropen cmitmode ctext cflist cflist_top
1186 if {$cmitmode ne "tree"} return
1187 if {![info exists cflist_top]} return
1188 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1189 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1190 $cflist tag add highlight $l.0 "$l.0 lineend"
1196 set e [linetoelt $l]
1197 if {[string index $e end] ne "/"} {
1199 } elseif {$treediropen($e)} {
1206 proc setfilelist {id} {
1207 global treefilelist cflist
1209 treeview $cflist $treefilelist($id) 0
1212 image create bitmap tri-rt -background black -foreground blue -data {
1213 #define tri-rt_width 13
1214 #define tri-rt_height 13
1215 static unsigned char tri-rt_bits[] = {
1216 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1217 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1220 #define tri-rt-mask_width 13
1221 #define tri-rt-mask_height 13
1222 static unsigned char tri-rt-mask_bits[] = {
1223 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1224 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1227 image create bitmap tri-dn -background black -foreground blue -data {
1228 #define tri-dn_width 13
1229 #define tri-dn_height 13
1230 static unsigned char tri-dn_bits[] = {
1231 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1232 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1235 #define tri-dn-mask_width 13
1236 #define tri-dn-mask_height 13
1237 static unsigned char tri-dn-mask_bits[] = {
1238 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1239 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1243 proc init_flist {first} {
1244 global cflist cflist_top selectedline difffilestart
1246 $cflist conf -state normal
1247 $cflist delete 0.0 end
1249 $cflist insert end $first
1251 $cflist tag add highlight 1.0 "1.0 lineend"
1253 catch {unset cflist_top}
1255 $cflist conf -state disabled
1256 set difffilestart {}
1259 proc highlight_tag {f} {
1260 global highlight_paths
1262 foreach p $highlight_paths {
1263 if {[string match $p $f]} {
1270 proc highlight_filelist {} {
1271 global cmitmode cflist
1273 $cflist conf -state normal
1274 if {$cmitmode ne "tree"} {
1275 set end [lindex [split [$cflist index end] .] 0]
1276 for {set l 2} {$l < $end} {incr l} {
1277 set line [$cflist get $l.0 "$l.0 lineend"]
1278 if {[highlight_tag $line] ne {}} {
1279 $cflist tag add bold $l.0 "$l.0 lineend"
1285 $cflist conf -state disabled
1288 proc unhighlight_filelist {} {
1291 $cflist conf -state normal
1292 $cflist tag remove bold 1.0 end
1293 $cflist conf -state disabled
1296 proc add_flist {fl} {
1299 $cflist conf -state normal
1301 $cflist insert end "\n"
1302 $cflist insert end $f [highlight_tag $f]
1304 $cflist conf -state disabled
1307 proc sel_flist {w x y} {
1308 global ctext difffilestart cflist cflist_top cmitmode
1310 if {$cmitmode eq "tree"} return
1311 if {![info exists cflist_top]} return
1312 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1313 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1314 $cflist tag add highlight $l.0 "$l.0 lineend"
1319 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1323 # Functions for adding and removing shell-type quoting
1325 proc shellquote {str} {
1326 if {![string match "*\['\"\\ \t]*" $str]} {
1329 if {![string match "*\['\"\\]*" $str]} {
1332 if {![string match "*'*" $str]} {
1335 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1338 proc shellarglist {l} {
1344 append str [shellquote $a]
1349 proc shelldequote {str} {
1354 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1355 append ret [string range $str $used end]
1356 set used [string length $str]
1359 set first [lindex $first 0]
1360 set ch [string index $str $first]
1361 if {$first > $used} {
1362 append ret [string range $str $used [expr {$first - 1}]]
1365 if {$ch eq " " || $ch eq "\t"} break
1368 set first [string first "'" $str $used]
1370 error "unmatched single-quote"
1372 append ret [string range $str $used [expr {$first - 1}]]
1377 if {$used >= [string length $str]} {
1378 error "trailing backslash"
1380 append ret [string index $str $used]
1385 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1386 error "unmatched double-quote"
1388 set first [lindex $first 0]
1389 set ch [string index $str $first]
1390 if {$first > $used} {
1391 append ret [string range $str $used [expr {$first - 1}]]
1394 if {$ch eq "\""} break
1396 append ret [string index $str $used]
1400 return [list $used $ret]
1403 proc shellsplit {str} {
1406 set str [string trimleft $str]
1407 if {$str eq {}} break
1408 set dq [shelldequote $str]
1409 set n [lindex $dq 0]
1410 set word [lindex $dq 1]
1411 set str [string range $str $n end]
1417 # Code to implement multiple views
1419 proc newview {ishighlight} {
1420 global nextviewnum newviewname newviewperm uifont newishighlight
1421 global newviewargs revtreeargs
1423 set newishighlight $ishighlight
1425 if {[winfo exists $top]} {
1429 set newviewname($nextviewnum) "View $nextviewnum"
1430 set newviewperm($nextviewnum) 0
1431 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1432 vieweditor $top $nextviewnum "Gitk view definition"
1437 global viewname viewperm newviewname newviewperm
1438 global viewargs newviewargs
1440 set top .gitkvedit-$curview
1441 if {[winfo exists $top]} {
1445 set newviewname($curview) $viewname($curview)
1446 set newviewperm($curview) $viewperm($curview)
1447 set newviewargs($curview) [shellarglist $viewargs($curview)]
1448 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1451 proc vieweditor {top n title} {
1452 global newviewname newviewperm viewfiles
1456 wm title $top $title
1457 label $top.nl -text "Name" -font $uifont
1458 entry $top.name -width 20 -textvariable newviewname($n)
1459 grid $top.nl $top.name -sticky w -pady 5
1460 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1461 grid $top.perm - -pady 5 -sticky w
1462 message $top.al -aspect 1000 -font $uifont \
1463 -text "Commits to include (arguments to git rev-list):"
1464 grid $top.al - -sticky w -pady 5
1465 entry $top.args -width 50 -textvariable newviewargs($n) \
1467 grid $top.args - -sticky ew -padx 5
1468 message $top.l -aspect 1000 -font $uifont \
1469 -text "Enter files and directories to include, one per line:"
1470 grid $top.l - -sticky w
1471 text $top.t -width 40 -height 10 -background white
1472 if {[info exists viewfiles($n)]} {
1473 foreach f $viewfiles($n) {
1474 $top.t insert end $f
1475 $top.t insert end "\n"
1477 $top.t delete {end - 1c} end
1478 $top.t mark set insert 0.0
1480 grid $top.t - -sticky ew -padx 5
1482 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1483 button $top.buts.can -text "Cancel" -command [list destroy $top]
1484 grid $top.buts.ok $top.buts.can
1485 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1486 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1487 grid $top.buts - -pady 10 -sticky ew
1491 proc doviewmenu {m first cmd op argv} {
1492 set nmenu [$m index end]
1493 for {set i $first} {$i <= $nmenu} {incr i} {
1494 if {[$m entrycget $i -command] eq $cmd} {
1495 eval $m $op $i $argv
1501 proc allviewmenus {n op args} {
1504 doviewmenu .bar.view 5 [list showview $n] $op $args
1505 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1508 proc newviewok {top n} {
1509 global nextviewnum newviewperm newviewname newishighlight
1510 global viewname viewfiles viewperm selectedview curview
1511 global viewargs newviewargs viewhlmenu
1514 set newargs [shellsplit $newviewargs($n)]
1516 error_popup "Error in commit selection arguments: $err"
1522 foreach f [split [$top.t get 0.0 end] "\n"] {
1523 set ft [string trim $f]
1528 if {![info exists viewfiles($n)]} {
1529 # creating a new view
1531 set viewname($n) $newviewname($n)
1532 set viewperm($n) $newviewperm($n)
1533 set viewfiles($n) $files
1534 set viewargs($n) $newargs
1536 if {!$newishighlight} {
1537 after idle showview $n
1539 after idle addvhighlight $n
1542 # editing an existing view
1543 set viewperm($n) $newviewperm($n)
1544 if {$newviewname($n) ne $viewname($n)} {
1545 set viewname($n) $newviewname($n)
1546 doviewmenu .bar.view 5 [list showview $n] \
1547 entryconf [list -label $viewname($n)]
1548 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1549 entryconf [list -label $viewname($n) -value $viewname($n)]
1551 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1552 set viewfiles($n) $files
1553 set viewargs($n) $newargs
1554 if {$curview == $n} {
1555 after idle updatecommits
1559 catch {destroy $top}
1563 global curview viewdata viewperm hlview selectedhlview
1565 if {$curview == 0} return
1566 if {[info exists hlview] && $hlview == $curview} {
1567 set selectedhlview None
1570 allviewmenus $curview delete
1571 set viewdata($curview) {}
1572 set viewperm($curview) 0
1576 proc addviewmenu {n} {
1577 global viewname viewhlmenu
1579 .bar.view add radiobutton -label $viewname($n) \
1580 -command [list showview $n] -variable selectedview -value $n
1581 $viewhlmenu add radiobutton -label $viewname($n) \
1582 -command [list addvhighlight $n] -variable selectedhlview
1585 proc flatten {var} {
1589 foreach i [array names $var] {
1590 lappend ret $i [set $var\($i\)]
1595 proc unflatten {var l} {
1605 global curview viewdata viewfiles
1606 global displayorder parentlist childlist rowidlist rowoffsets
1607 global colormap rowtextx commitrow nextcolor canvxmax
1608 global numcommits rowrangelist commitlisted idrowranges
1609 global selectedline currentid canv canvy0
1610 global matchinglines treediffs
1611 global pending_select phase
1612 global commitidx rowlaidout rowoptim linesegends
1613 global commfd nextupdate
1615 global vparentlist vchildlist vdisporder vcmitlisted
1616 global hlview selectedhlview
1618 if {$n == $curview} return
1620 if {[info exists selectedline]} {
1621 set selid $currentid
1622 set y [yc $selectedline]
1623 set ymax [lindex [$canv cget -scrollregion] 3]
1624 set span [$canv yview]
1625 set ytop [expr {[lindex $span 0] * $ymax}]
1626 set ybot [expr {[lindex $span 1] * $ymax}]
1627 if {$ytop < $y && $y < $ybot} {
1628 set yscreen [expr {$y - $ytop}]
1630 set yscreen [expr {($ybot - $ytop) / 2}]
1636 if {$curview >= 0} {
1637 set vparentlist($curview) $parentlist
1638 set vchildlist($curview) $childlist
1639 set vdisporder($curview) $displayorder
1640 set vcmitlisted($curview) $commitlisted
1642 set viewdata($curview) \
1643 [list $phase $rowidlist $rowoffsets $rowrangelist \
1644 [flatten idrowranges] [flatten idinlist] \
1645 $rowlaidout $rowoptim $numcommits $linesegends]
1646 } elseif {![info exists viewdata($curview)]
1647 || [lindex $viewdata($curview) 0] ne {}} {
1648 set viewdata($curview) \
1649 [list {} $rowidlist $rowoffsets $rowrangelist]
1652 catch {unset matchinglines}
1653 catch {unset treediffs}
1655 if {[info exists hlview] && $hlview == $n} {
1657 set selectedhlview None
1662 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1663 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1665 if {![info exists viewdata($n)]} {
1666 set pending_select $selid
1672 set phase [lindex $v 0]
1673 set displayorder $vdisporder($n)
1674 set parentlist $vparentlist($n)
1675 set childlist $vchildlist($n)
1676 set commitlisted $vcmitlisted($n)
1677 set rowidlist [lindex $v 1]
1678 set rowoffsets [lindex $v 2]
1679 set rowrangelist [lindex $v 3]
1681 set numcommits [llength $displayorder]
1682 catch {unset idrowranges}
1684 unflatten idrowranges [lindex $v 4]
1685 unflatten idinlist [lindex $v 5]
1686 set rowlaidout [lindex $v 6]
1687 set rowoptim [lindex $v 7]
1688 set numcommits [lindex $v 8]
1689 set linesegends [lindex $v 9]
1692 catch {unset colormap}
1693 catch {unset rowtextx}
1695 set canvxmax [$canv cget -width]
1701 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1702 set row $commitrow($n,$selid)
1703 # try to get the selected row in the same position on the screen
1704 set ymax [lindex [$canv cget -scrollregion] 3]
1705 set ytop [expr {[yc $row] - $yscreen}]
1709 set yf [expr {$ytop * 1.0 / $ymax}]
1711 allcanvs yview moveto $yf
1715 if {$phase eq "getcommits"} {
1716 show_status "Reading commits..."
1718 if {[info exists commfd($n)]} {
1723 } elseif {$numcommits == 0} {
1724 show_status "No commits selected"
1728 # Stuff relating to the highlighting facility
1730 proc ishighlighted {row} {
1731 global vhighlights fhighlights nhighlights rhighlights
1733 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1734 return $nhighlights($row)
1736 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1737 return $vhighlights($row)
1739 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1740 return $fhighlights($row)
1742 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1743 return $rhighlights($row)
1748 proc bolden {row font} {
1749 global canv linehtag selectedline boldrows
1751 lappend boldrows $row
1752 $canv itemconf $linehtag($row) -font $font
1753 if {[info exists selectedline] && $row == $selectedline} {
1755 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1756 -outline {{}} -tags secsel \
1757 -fill [$canv cget -selectbackground]]
1762 proc bolden_name {row font} {
1763 global canv2 linentag selectedline boldnamerows
1765 lappend boldnamerows $row
1766 $canv2 itemconf $linentag($row) -font $font
1767 if {[info exists selectedline] && $row == $selectedline} {
1768 $canv2 delete secsel
1769 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1770 -outline {{}} -tags secsel \
1771 -fill [$canv2 cget -selectbackground]]
1777 global mainfont boldrows
1780 foreach row $boldrows {
1781 if {![ishighlighted $row]} {
1782 bolden $row $mainfont
1784 lappend stillbold $row
1787 set boldrows $stillbold
1790 proc addvhighlight {n} {
1791 global hlview curview viewdata vhl_done vhighlights commitidx
1793 if {[info exists hlview]} {
1797 if {$n != $curview && ![info exists viewdata($n)]} {
1798 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1799 set vparentlist($n) {}
1800 set vchildlist($n) {}
1801 set vdisporder($n) {}
1802 set vcmitlisted($n) {}
1805 set vhl_done $commitidx($hlview)
1806 if {$vhl_done > 0} {
1811 proc delvhighlight {} {
1812 global hlview vhighlights
1814 if {![info exists hlview]} return
1816 catch {unset vhighlights}
1820 proc vhighlightmore {} {
1821 global hlview vhl_done commitidx vhighlights
1822 global displayorder vdisporder curview mainfont
1824 set font [concat $mainfont bold]
1825 set max $commitidx($hlview)
1826 if {$hlview == $curview} {
1827 set disp $displayorder
1829 set disp $vdisporder($hlview)
1831 set vr [visiblerows]
1832 set r0 [lindex $vr 0]
1833 set r1 [lindex $vr 1]
1834 for {set i $vhl_done} {$i < $max} {incr i} {
1835 set id [lindex $disp $i]
1836 if {[info exists commitrow($curview,$id)]} {
1837 set row $commitrow($curview,$id)
1838 if {$r0 <= $row && $row <= $r1} {
1839 if {![highlighted $row]} {
1842 set vhighlights($row) 1
1849 proc askvhighlight {row id} {
1850 global hlview vhighlights commitrow iddrawn mainfont
1852 if {[info exists commitrow($hlview,$id)]} {
1853 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1854 bolden $row [concat $mainfont bold]
1856 set vhighlights($row) 1
1858 set vhighlights($row) 0
1862 proc hfiles_change {name ix op} {
1863 global highlight_files filehighlight fhighlights fh_serial
1864 global mainfont highlight_paths
1866 if {[info exists filehighlight]} {
1867 # delete previous highlights
1868 catch {close $filehighlight}
1870 catch {unset fhighlights}
1872 unhighlight_filelist
1874 set highlight_paths {}
1875 after cancel do_file_hl $fh_serial
1877 if {$highlight_files ne {}} {
1878 after 300 do_file_hl $fh_serial
1882 proc makepatterns {l} {
1885 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1886 if {[string index $ee end] eq "/"} {
1896 proc do_file_hl {serial} {
1897 global highlight_files filehighlight highlight_paths gdttype fhl_list
1899 if {$gdttype eq "touching paths:"} {
1900 if {[catch {set paths [shellsplit $highlight_files]}]} return
1901 set highlight_paths [makepatterns $paths]
1903 set gdtargs [concat -- $paths]
1905 set gdtargs [list "-S$highlight_files"]
1907 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1908 set filehighlight [open $cmd r+]
1909 fconfigure $filehighlight -blocking 0
1910 fileevent $filehighlight readable readfhighlight
1916 proc flushhighlights {} {
1917 global filehighlight fhl_list
1919 if {[info exists filehighlight]} {
1921 puts $filehighlight ""
1922 flush $filehighlight
1926 proc askfilehighlight {row id} {
1927 global filehighlight fhighlights fhl_list
1929 lappend fhl_list $id
1930 set fhighlights($row) -1
1931 puts $filehighlight $id
1934 proc readfhighlight {} {
1935 global filehighlight fhighlights commitrow curview mainfont iddrawn
1938 while {[gets $filehighlight line] >= 0} {
1939 set line [string trim $line]
1940 set i [lsearch -exact $fhl_list $line]
1941 if {$i < 0} continue
1942 for {set j 0} {$j < $i} {incr j} {
1943 set id [lindex $fhl_list $j]
1944 if {[info exists commitrow($curview,$id)]} {
1945 set fhighlights($commitrow($curview,$id)) 0
1948 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1949 if {$line eq {}} continue
1950 if {![info exists commitrow($curview,$line)]} continue
1951 set row $commitrow($curview,$line)
1952 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1953 bolden $row [concat $mainfont bold]
1955 set fhighlights($row) 1
1957 if {[eof $filehighlight]} {
1959 puts "oops, git-diff-tree died"
1960 catch {close $filehighlight}
1966 proc find_change {name ix op} {
1967 global nhighlights mainfont boldnamerows
1968 global findstring findpattern findtype
1970 # delete previous highlights, if any
1971 foreach row $boldnamerows {
1972 bolden_name $row $mainfont
1975 catch {unset nhighlights}
1977 if {$findtype ne "Regexp"} {
1978 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1980 set findpattern "*$e*"
1985 proc askfindhighlight {row id} {
1986 global nhighlights commitinfo iddrawn mainfont
1987 global findstring findtype findloc findpattern
1989 if {![info exists commitinfo($id)]} {
1992 set info $commitinfo($id)
1994 set fldtypes {Headline Author Date Committer CDate Comments}
1995 foreach f $info ty $fldtypes {
1996 if {$findloc ne "All fields" && $findloc ne $ty} {
1999 if {$findtype eq "Regexp"} {
2000 set doesmatch [regexp $findstring $f]
2001 } elseif {$findtype eq "IgnCase"} {
2002 set doesmatch [string match -nocase $findpattern $f]
2004 set doesmatch [string match $findpattern $f]
2007 if {$ty eq "Author"} {
2014 if {[info exists iddrawn($id)]} {
2015 if {$isbold && ![ishighlighted $row]} {
2016 bolden $row [concat $mainfont bold]
2019 bolden_name $row [concat $mainfont bold]
2022 set nhighlights($row) $isbold
2025 proc vrel_change {name ix op} {
2026 global highlight_related
2029 if {$highlight_related ne "None"} {
2030 after idle drawvisible
2034 # prepare for testing whether commits are descendents or ancestors of a
2035 proc rhighlight_sel {a} {
2036 global descendent desc_todo ancestor anc_todo
2037 global highlight_related rhighlights
2039 catch {unset descendent}
2040 set desc_todo [list $a]
2041 catch {unset ancestor}
2042 set anc_todo [list $a]
2043 if {$highlight_related ne "None"} {
2045 after idle drawvisible
2049 proc rhighlight_none {} {
2052 catch {unset rhighlights}
2056 proc is_descendent {a} {
2057 global curview children commitrow descendent desc_todo
2060 set la $commitrow($v,$a)
2064 for {set i 0} {$i < [llength $todo]} {incr i} {
2065 set do [lindex $todo $i]
2066 if {$commitrow($v,$do) < $la} {
2067 lappend leftover $do
2070 foreach nk $children($v,$do) {
2071 if {![info exists descendent($nk)]} {
2072 set descendent($nk) 1
2080 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2084 set descendent($a) 0
2085 set desc_todo $leftover
2088 proc is_ancestor {a} {
2089 global curview parentlist commitrow ancestor anc_todo
2092 set la $commitrow($v,$a)
2096 for {set i 0} {$i < [llength $todo]} {incr i} {
2097 set do [lindex $todo $i]
2098 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2099 lappend leftover $do
2102 foreach np [lindex $parentlist $commitrow($v,$do)] {
2103 if {![info exists ancestor($np)]} {
2112 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2117 set anc_todo $leftover
2120 proc askrelhighlight {row id} {
2121 global descendent highlight_related iddrawn mainfont rhighlights
2122 global selectedline ancestor
2124 if {![info exists selectedline]} return
2126 if {$highlight_related eq "Descendent" ||
2127 $highlight_related eq "Not descendent"} {
2128 if {![info exists descendent($id)]} {
2131 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2134 } elseif {$highlight_related eq "Ancestor" ||
2135 $highlight_related eq "Not ancestor"} {
2136 if {![info exists ancestor($id)]} {
2139 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2143 if {[info exists iddrawn($id)]} {
2144 if {$isbold && ![ishighlighted $row]} {
2145 bolden $row [concat $mainfont bold]
2148 set rhighlights($row) $isbold
2151 proc next_hlcont {} {
2152 global fhl_row fhl_dirn displayorder numcommits
2153 global vhighlights fhighlights nhighlights rhighlights
2154 global hlview filehighlight findstring highlight_related
2156 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2159 if {$row < 0 || $row >= $numcommits} {
2164 set id [lindex $displayorder $row]
2165 if {[info exists hlview]} {
2166 if {![info exists vhighlights($row)]} {
2167 askvhighlight $row $id
2169 if {$vhighlights($row) > 0} break
2171 if {$findstring ne {}} {
2172 if {![info exists nhighlights($row)]} {
2173 askfindhighlight $row $id
2175 if {$nhighlights($row) > 0} break
2177 if {$highlight_related ne "None"} {
2178 if {![info exists rhighlights($row)]} {
2179 askrelhighlight $row $id
2181 if {$rhighlights($row) > 0} break
2183 if {[info exists filehighlight]} {
2184 if {![info exists fhighlights($row)]} {
2185 # ask for a few more while we're at it...
2187 for {set n 0} {$n < 100} {incr n} {
2188 if {![info exists fhighlights($r)]} {
2189 askfilehighlight $r [lindex $displayorder $r]
2192 if {$r < 0 || $r >= $numcommits} break
2196 if {$fhighlights($row) < 0} {
2200 if {$fhighlights($row) > 0} break
2208 proc next_highlight {dirn} {
2209 global selectedline fhl_row fhl_dirn
2210 global hlview filehighlight findstring highlight_related
2212 if {![info exists selectedline]} return
2213 if {!([info exists hlview] || $findstring ne {} ||
2214 $highlight_related ne "None" || [info exists filehighlight])} return
2215 set fhl_row [expr {$selectedline + $dirn}]
2220 proc cancel_next_highlight {} {
2226 # Graph layout functions
2228 proc shortids {ids} {
2231 if {[llength $id] > 1} {
2232 lappend res [shortids $id]
2233 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2234 lappend res [string range $id 0 7]
2242 proc incrange {l x o} {
2245 set e [lindex $l $x]
2247 lset l $x [expr {$e + $o}]
2256 for {} {$n > 0} {incr n -1} {
2262 proc usedinrange {id l1 l2} {
2263 global children commitrow childlist curview
2265 if {[info exists commitrow($curview,$id)]} {
2266 set r $commitrow($curview,$id)
2267 if {$l1 <= $r && $r <= $l2} {
2268 return [expr {$r - $l1 + 1}]
2270 set kids [lindex $childlist $r]
2272 set kids $children($curview,$id)
2275 set r $commitrow($curview,$c)
2276 if {$l1 <= $r && $r <= $l2} {
2277 return [expr {$r - $l1 + 1}]
2283 proc sanity {row {full 0}} {
2284 global rowidlist rowoffsets
2287 set ids [lindex $rowidlist $row]
2290 if {$id eq {}} continue
2291 if {$col < [llength $ids] - 1 &&
2292 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2293 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2295 set o [lindex $rowoffsets $row $col]
2301 if {[lindex $rowidlist $y $x] != $id} {
2302 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2303 puts " id=[shortids $id] check started at row $row"
2304 for {set i $row} {$i >= $y} {incr i -1} {
2305 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2310 set o [lindex $rowoffsets $y $x]
2315 proc makeuparrow {oid x y z} {
2316 global rowidlist rowoffsets uparrowlen idrowranges
2318 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2321 set off0 [lindex $rowoffsets $y]
2322 for {set x0 $x} {1} {incr x0} {
2323 if {$x0 >= [llength $off0]} {
2324 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2327 set z [lindex $off0 $x0]
2333 set z [expr {$x0 - $x}]
2334 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2335 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2337 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2338 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2339 lappend idrowranges($oid) $y
2342 proc initlayout {} {
2343 global rowidlist rowoffsets displayorder commitlisted
2344 global rowlaidout rowoptim
2345 global idinlist rowchk rowrangelist idrowranges
2346 global numcommits canvxmax canv
2348 global parentlist childlist children
2349 global colormap rowtextx
2361 catch {unset idinlist}
2362 catch {unset rowchk}
2365 set canvxmax [$canv cget -width]
2366 catch {unset colormap}
2367 catch {unset rowtextx}
2368 catch {unset idrowranges}
2372 proc setcanvscroll {} {
2373 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2375 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2376 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2377 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2378 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2381 proc visiblerows {} {
2382 global canv numcommits linespc
2384 set ymax [lindex [$canv cget -scrollregion] 3]
2385 if {$ymax eq {} || $ymax == 0} return
2387 set y0 [expr {int([lindex $f 0] * $ymax)}]
2388 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2392 set y1 [expr {int([lindex $f 1] * $ymax)}]
2393 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2394 if {$r1 >= $numcommits} {
2395 set r1 [expr {$numcommits - 1}]
2397 return [list $r0 $r1]
2400 proc layoutmore {tmax} {
2401 global rowlaidout rowoptim commitidx numcommits optim_delay
2402 global uparrowlen curview
2405 if {$rowoptim - $optim_delay > $numcommits} {
2406 showstuff [expr {$rowoptim - $optim_delay}]
2407 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2408 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2412 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2414 } elseif {$commitidx($curview) > $rowlaidout} {
2415 set nr [expr {$commitidx($curview) - $rowlaidout}]
2416 # may need to increase this threshold if uparrowlen or
2417 # mingaplen are increased...
2422 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2423 if {$rowlaidout == $row} {
2429 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2435 proc showstuff {canshow} {
2436 global numcommits commitrow pending_select selectedline
2437 global linesegends idrowranges idrangedrawn curview
2439 if {$numcommits == 0} {
2441 set phase "incrdraw"
2445 set numcommits $canshow
2447 set rows [visiblerows]
2448 set r0 [lindex $rows 0]
2449 set r1 [lindex $rows 1]
2451 for {set r $row} {$r < $canshow} {incr r} {
2452 foreach id [lindex $linesegends [expr {$r+1}]] {
2454 foreach {s e} [rowranges $id] {
2456 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2457 && ![info exists idrangedrawn($id,$i)]} {
2459 set idrangedrawn($id,$i) 1
2464 if {$canshow > $r1} {
2467 while {$row < $canshow} {
2471 if {[info exists pending_select] &&
2472 [info exists commitrow($curview,$pending_select)] &&
2473 $commitrow($curview,$pending_select) < $numcommits} {
2474 selectline $commitrow($curview,$pending_select) 1
2476 if {![info exists selectedline] && ![info exists pending_select]} {
2481 proc layoutrows {row endrow last} {
2482 global rowidlist rowoffsets displayorder
2483 global uparrowlen downarrowlen maxwidth mingaplen
2484 global childlist parentlist
2485 global idrowranges linesegends
2486 global commitidx curview
2487 global idinlist rowchk rowrangelist
2489 set idlist [lindex $rowidlist $row]
2490 set offs [lindex $rowoffsets $row]
2491 while {$row < $endrow} {
2492 set id [lindex $displayorder $row]
2495 foreach p [lindex $parentlist $row] {
2496 if {![info exists idinlist($p)]} {
2498 } elseif {!$idinlist($p)} {
2503 set nev [expr {[llength $idlist] + [llength $newolds]
2504 + [llength $oldolds] - $maxwidth + 1}]
2507 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2508 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2509 set i [lindex $idlist $x]
2510 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2511 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2512 [expr {$row + $uparrowlen + $mingaplen}]]
2514 set idlist [lreplace $idlist $x $x]
2515 set offs [lreplace $offs $x $x]
2516 set offs [incrange $offs $x 1]
2518 set rm1 [expr {$row - 1}]
2520 lappend idrowranges($i) $rm1
2521 if {[incr nev -1] <= 0} break
2524 set rowchk($id) [expr {$row + $r}]
2527 lset rowidlist $row $idlist
2528 lset rowoffsets $row $offs
2530 lappend linesegends $lse
2531 set col [lsearch -exact $idlist $id]
2533 set col [llength $idlist]
2535 lset rowidlist $row $idlist
2537 if {[lindex $childlist $row] ne {}} {
2538 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2542 lset rowoffsets $row $offs
2544 makeuparrow $id $col $row $z
2550 if {[info exists idrowranges($id)]} {
2551 set ranges $idrowranges($id)
2553 unset idrowranges($id)
2555 lappend rowrangelist $ranges
2557 set offs [ntimes [llength $idlist] 0]
2558 set l [llength $newolds]
2559 set idlist [eval lreplace \$idlist $col $col $newolds]
2562 set offs [lrange $offs 0 [expr {$col - 1}]]
2563 foreach x $newolds {
2568 set tmp [expr {[llength $idlist] - [llength $offs]}]
2570 set offs [concat $offs [ntimes $tmp $o]]
2575 foreach i $newolds {
2577 set idrowranges($i) $row
2580 foreach oid $oldolds {
2581 set idinlist($oid) 1
2582 set idlist [linsert $idlist $col $oid]
2583 set offs [linsert $offs $col $o]
2584 makeuparrow $oid $col $row $o
2587 lappend rowidlist $idlist
2588 lappend rowoffsets $offs
2593 proc addextraid {id row} {
2594 global displayorder commitrow commitinfo
2595 global commitidx commitlisted
2596 global parentlist childlist children curview
2598 incr commitidx($curview)
2599 lappend displayorder $id
2600 lappend commitlisted 0
2601 lappend parentlist {}
2602 set commitrow($curview,$id) $row
2604 if {![info exists commitinfo($id)]} {
2605 set commitinfo($id) {"No commit information available"}
2607 if {![info exists children($curview,$id)]} {
2608 set children($curview,$id) {}
2610 lappend childlist $children($curview,$id)
2613 proc layouttail {} {
2614 global rowidlist rowoffsets idinlist commitidx curview
2615 global idrowranges rowrangelist
2617 set row $commitidx($curview)
2618 set idlist [lindex $rowidlist $row]
2619 while {$idlist ne {}} {
2620 set col [expr {[llength $idlist] - 1}]
2621 set id [lindex $idlist $col]
2624 lappend idrowranges($id) $row
2625 lappend rowrangelist $idrowranges($id)
2626 unset idrowranges($id)
2628 set offs [ntimes $col 0]
2629 set idlist [lreplace $idlist $col $col]
2630 lappend rowidlist $idlist
2631 lappend rowoffsets $offs
2634 foreach id [array names idinlist] {
2636 lset rowidlist $row [list $id]
2637 lset rowoffsets $row 0
2638 makeuparrow $id 0 $row 0
2639 lappend idrowranges($id) $row
2640 lappend rowrangelist $idrowranges($id)
2641 unset idrowranges($id)
2643 lappend rowidlist {}
2644 lappend rowoffsets {}
2648 proc insert_pad {row col npad} {
2649 global rowidlist rowoffsets
2651 set pad [ntimes $npad {}]
2652 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2653 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2654 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2657 proc optimize_rows {row col endrow} {
2658 global rowidlist rowoffsets idrowranges displayorder
2660 for {} {$row < $endrow} {incr row} {
2661 set idlist [lindex $rowidlist $row]
2662 set offs [lindex $rowoffsets $row]
2664 for {} {$col < [llength $offs]} {incr col} {
2665 if {[lindex $idlist $col] eq {}} {
2669 set z [lindex $offs $col]
2670 if {$z eq {}} continue
2672 set x0 [expr {$col + $z}]
2673 set y0 [expr {$row - 1}]
2674 set z0 [lindex $rowoffsets $y0 $x0]
2676 set id [lindex $idlist $col]
2677 set ranges [rowranges $id]
2678 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2682 if {$z < -1 || ($z < 0 && $isarrow)} {
2683 set npad [expr {-1 - $z + $isarrow}]
2684 set offs [incrange $offs $col $npad]
2685 insert_pad $y0 $x0 $npad
2687 optimize_rows $y0 $x0 $row
2689 set z [lindex $offs $col]
2690 set x0 [expr {$col + $z}]
2691 set z0 [lindex $rowoffsets $y0 $x0]
2692 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2693 set npad [expr {$z - 1 + $isarrow}]
2694 set y1 [expr {$row + 1}]
2695 set offs2 [lindex $rowoffsets $y1]
2699 if {$z eq {} || $x1 + $z < $col} continue
2700 if {$x1 + $z > $col} {
2703 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2706 set pad [ntimes $npad {}]
2707 set idlist [eval linsert \$idlist $col $pad]
2708 set tmp [eval linsert \$offs $col $pad]
2710 set offs [incrange $tmp $col [expr {-$npad}]]
2711 set z [lindex $offs $col]
2714 if {$z0 eq {} && !$isarrow} {
2715 # this line links to its first child on row $row-2
2716 set rm2 [expr {$row - 2}]
2717 set id [lindex $displayorder $rm2]
2718 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2720 set z0 [expr {$xc - $x0}]
2723 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2724 insert_pad $y0 $x0 1
2725 set offs [incrange $offs $col 1]
2726 optimize_rows $y0 [expr {$x0 + 1}] $row
2731 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2732 set o [lindex $offs $col]
2734 # check if this is the link to the first child
2735 set id [lindex $idlist $col]
2736 set ranges [rowranges $id]
2737 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2738 # it is, work out offset to child
2739 set y0 [expr {$row - 1}]
2740 set id [lindex $displayorder $y0]
2741 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2743 set o [expr {$x0 - $col}]
2747 if {$o eq {} || $o <= 0} break
2749 if {$o ne {} && [incr col] < [llength $idlist]} {
2750 set y1 [expr {$row + 1}]
2751 set offs2 [lindex $rowoffsets $y1]
2755 if {$z eq {} || $x1 + $z < $col} continue
2756 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2759 set idlist [linsert $idlist $col {}]
2760 set tmp [linsert $offs $col {}]
2762 set offs [incrange $tmp $col -1]
2765 lset rowidlist $row $idlist
2766 lset rowoffsets $row $offs
2772 global canvx0 linespc
2773 return [expr {$canvx0 + $col * $linespc}]
2777 global canvy0 linespc
2778 return [expr {$canvy0 + $row * $linespc}]
2781 proc linewidth {id} {
2782 global thickerline lthickness
2785 if {[info exists thickerline] && $id eq $thickerline} {
2786 set wid [expr {2 * $lthickness}]
2791 proc rowranges {id} {
2792 global phase idrowranges commitrow rowlaidout rowrangelist curview
2796 ([info exists commitrow($curview,$id)]
2797 && $commitrow($curview,$id) < $rowlaidout)} {
2798 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2799 } elseif {[info exists idrowranges($id)]} {
2800 set ranges $idrowranges($id)
2805 proc drawlineseg {id i} {
2806 global rowoffsets rowidlist
2808 global canv colormap linespc
2809 global numcommits commitrow curview
2811 set ranges [rowranges $id]
2813 if {[info exists commitrow($curview,$id)]
2814 && $commitrow($curview,$id) < $numcommits} {
2815 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2819 set startrow [lindex $ranges [expr {2 * $i}]]
2820 set row [lindex $ranges [expr {2 * $i + 1}]]
2821 if {$startrow == $row} return
2824 set col [lsearch -exact [lindex $rowidlist $row] $id]
2826 puts "oops: drawline: id $id not on row $row"
2832 set o [lindex $rowoffsets $row $col]
2835 # changing direction
2836 set x [xc $row $col]
2838 lappend coords $x $y
2844 set x [xc $row $col]
2846 lappend coords $x $y
2848 # draw the link to the first child as part of this line
2850 set child [lindex $displayorder $row]
2851 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2853 set x [xc $row $ccol]
2855 if {$ccol < $col - 1} {
2856 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2857 } elseif {$ccol > $col + 1} {
2858 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2860 lappend coords $x $y
2863 if {[llength $coords] < 4} return
2865 # This line has an arrow at the lower end: check if the arrow is
2866 # on a diagonal segment, and if so, work around the Tk 8.4
2867 # refusal to draw arrows on diagonal lines.
2868 set x0 [lindex $coords 0]
2869 set x1 [lindex $coords 2]
2871 set y0 [lindex $coords 1]
2872 set y1 [lindex $coords 3]
2873 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2874 # we have a nearby vertical segment, just trim off the diag bit
2875 set coords [lrange $coords 2 end]
2877 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2878 set xi [expr {$x0 - $slope * $linespc / 2}]
2879 set yi [expr {$y0 - $linespc / 2}]
2880 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2884 set arrow [expr {2 * ($i > 0) + $downarrow}]
2885 set arrow [lindex {none first last both} $arrow]
2886 set t [$canv create line $coords -width [linewidth $id] \
2887 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2892 proc drawparentlinks {id row col olds} {
2893 global rowidlist canv colormap
2895 set row2 [expr {$row + 1}]
2896 set x [xc $row $col]
2899 set ids [lindex $rowidlist $row2]
2900 # rmx = right-most X coord used
2903 set i [lsearch -exact $ids $p]
2905 puts "oops, parent $p of $id not in list"
2908 set x2 [xc $row2 $i]
2912 set ranges [rowranges $p]
2913 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2914 && $row2 < [lindex $ranges 1]} {
2915 # drawlineseg will do this one for us
2919 # should handle duplicated parents here...
2920 set coords [list $x $y]
2921 if {$i < $col - 1} {
2922 lappend coords [xc $row [expr {$i + 1}]] $y
2923 } elseif {$i > $col + 1} {
2924 lappend coords [xc $row [expr {$i - 1}]] $y
2926 lappend coords $x2 $y2
2927 set t [$canv create line $coords -width [linewidth $p] \
2928 -fill $colormap($p) -tags lines.$p]
2935 proc drawlines {id} {
2936 global colormap canv
2938 global children iddrawn commitrow rowidlist curview
2940 $canv delete lines.$id
2941 set nr [expr {[llength [rowranges $id]] / 2}]
2942 for {set i 0} {$i < $nr} {incr i} {
2943 if {[info exists idrangedrawn($id,$i)]} {
2947 foreach child $children($curview,$id) {
2948 if {[info exists iddrawn($child)]} {
2949 set row $commitrow($curview,$child)
2950 set col [lsearch -exact [lindex $rowidlist $row] $child]
2952 drawparentlinks $child $row $col [list $id]
2958 proc drawcmittext {id row col rmx} {
2959 global linespc canv canv2 canv3 canvy0 fgcolor
2960 global commitlisted commitinfo rowidlist
2961 global rowtextx idpos idtags idheads idotherrefs
2962 global linehtag linentag linedtag
2963 global mainfont canvxmax boldrows boldnamerows fgcolor
2965 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2966 set x [xc $row $col]
2968 set orad [expr {$linespc / 3}]
2969 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2970 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2971 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2973 $canv bind $t <1> {selcanvline {} %x %y}
2974 set xt [xc $row [llength [lindex $rowidlist $row]]]
2978 set rowtextx($row) $xt
2979 set idpos($id) [list $x $xt $y]
2980 if {[info exists idtags($id)] || [info exists idheads($id)]
2981 || [info exists idotherrefs($id)]} {
2982 set xt [drawtags $id $x $xt $y]
2984 set headline [lindex $commitinfo($id) 0]
2985 set name [lindex $commitinfo($id) 1]
2986 set date [lindex $commitinfo($id) 2]
2987 set date [formatdate $date]
2990 set isbold [ishighlighted $row]
2992 lappend boldrows $row
2995 lappend boldnamerows $row
2999 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3000 -text $headline -font $font -tags text]
3001 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3002 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3003 -text $name -font $nfont -tags text]
3004 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3005 -text $date -font $mainfont -tags text]
3006 set xr [expr {$xt + [font measure $mainfont $headline]}]
3007 if {$xr > $canvxmax} {
3013 proc drawcmitrow {row} {
3014 global displayorder rowidlist
3015 global idrangedrawn iddrawn
3016 global commitinfo parentlist numcommits
3017 global filehighlight fhighlights findstring nhighlights
3018 global hlview vhighlights
3019 global highlight_related rhighlights
3021 if {$row >= $numcommits} return
3022 foreach id [lindex $rowidlist $row] {
3023 if {$id eq {}} continue
3025 foreach {s e} [rowranges $id] {
3027 if {$row < $s} continue
3030 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3032 set idrangedrawn($id,$i) 1
3039 set id [lindex $displayorder $row]
3040 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3041 askvhighlight $row $id
3043 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3044 askfilehighlight $row $id
3046 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3047 askfindhighlight $row $id
3049 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3050 askrelhighlight $row $id
3052 if {[info exists iddrawn($id)]} return
3053 set col [lsearch -exact [lindex $rowidlist $row] $id]
3055 puts "oops, row $row id $id not in list"
3058 if {![info exists commitinfo($id)]} {
3062 set olds [lindex $parentlist $row]
3064 set rmx [drawparentlinks $id $row $col $olds]
3068 drawcmittext $id $row $col $rmx
3072 proc drawfrac {f0 f1} {
3073 global numcommits canv
3076 set ymax [lindex [$canv cget -scrollregion] 3]
3077 if {$ymax eq {} || $ymax == 0} return
3078 set y0 [expr {int($f0 * $ymax)}]
3079 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3083 set y1 [expr {int($f1 * $ymax)}]
3084 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3085 if {$endrow >= $numcommits} {
3086 set endrow [expr {$numcommits - 1}]
3088 for {} {$row <= $endrow} {incr row} {
3093 proc drawvisible {} {
3095 eval drawfrac [$canv yview]
3098 proc clear_display {} {
3099 global iddrawn idrangedrawn
3100 global vhighlights fhighlights nhighlights rhighlights
3103 catch {unset iddrawn}
3104 catch {unset idrangedrawn}
3105 catch {unset vhighlights}
3106 catch {unset fhighlights}
3107 catch {unset nhighlights}
3108 catch {unset rhighlights}
3111 proc findcrossings {id} {
3112 global rowidlist parentlist numcommits rowoffsets displayorder
3116 foreach {s e} [rowranges $id] {
3117 if {$e >= $numcommits} {
3118 set e [expr {$numcommits - 1}]
3120 if {$e <= $s} continue
3121 set x [lsearch -exact [lindex $rowidlist $e] $id]
3123 puts "findcrossings: oops, no [shortids $id] in row $e"
3126 for {set row $e} {[incr row -1] >= $s} {} {
3127 set olds [lindex $parentlist $row]
3128 set kid [lindex $displayorder $row]
3129 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3130 if {$kidx < 0} continue
3131 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3133 set px [lsearch -exact $nextrow $p]
3134 if {$px < 0} continue
3135 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3136 if {[lsearch -exact $ccross $p] >= 0} continue
3137 if {$x == $px + ($kidx < $px? -1: 1)} {
3139 } elseif {[lsearch -exact $cross $p] < 0} {
3144 set inc [lindex $rowoffsets $row $x]
3145 if {$inc eq {}} break
3149 return [concat $ccross {{}} $cross]
3152 proc assigncolor {id} {
3153 global colormap colors nextcolor
3154 global commitrow parentlist children children curview
3156 if {[info exists colormap($id)]} return
3157 set ncolors [llength $colors]
3158 if {[info exists children($curview,$id)]} {
3159 set kids $children($curview,$id)
3163 if {[llength $kids] == 1} {
3164 set child [lindex $kids 0]
3165 if {[info exists colormap($child)]
3166 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3167 set colormap($id) $colormap($child)
3173 foreach x [findcrossings $id] {
3175 # delimiter between corner crossings and other crossings
3176 if {[llength $badcolors] >= $ncolors - 1} break
3177 set origbad $badcolors
3179 if {[info exists colormap($x)]
3180 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3181 lappend badcolors $colormap($x)
3184 if {[llength $badcolors] >= $ncolors} {
3185 set badcolors $origbad
3187 set origbad $badcolors
3188 if {[llength $badcolors] < $ncolors - 1} {
3189 foreach child $kids {
3190 if {[info exists colormap($child)]
3191 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3192 lappend badcolors $colormap($child)
3194 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3195 if {[info exists colormap($p)]
3196 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3197 lappend badcolors $colormap($p)
3201 if {[llength $badcolors] >= $ncolors} {
3202 set badcolors $origbad
3205 for {set i 0} {$i <= $ncolors} {incr i} {
3206 set c [lindex $colors $nextcolor]
3207 if {[incr nextcolor] >= $ncolors} {
3210 if {[lsearch -exact $badcolors $c]} break
3212 set colormap($id) $c
3215 proc bindline {t id} {
3218 $canv bind $t <Enter> "lineenter %x %y $id"
3219 $canv bind $t <Motion> "linemotion %x %y $id"
3220 $canv bind $t <Leave> "lineleave $id"
3221 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3224 proc drawtags {id x xt y1} {
3225 global idtags idheads idotherrefs mainhead
3226 global linespc lthickness
3227 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3232 if {[info exists idtags($id)]} {
3233 set marks $idtags($id)
3234 set ntags [llength $marks]
3236 if {[info exists idheads($id)]} {
3237 set marks [concat $marks $idheads($id)]
3238 set nheads [llength $idheads($id)]
3240 if {[info exists idotherrefs($id)]} {
3241 set marks [concat $marks $idotherrefs($id)]
3247 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3248 set yt [expr {$y1 - 0.5 * $linespc}]
3249 set yb [expr {$yt + $linespc - 1}]
3253 foreach tag $marks {
3255 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3256 set wid [font measure [concat $mainfont bold] $tag]
3258 set wid [font measure $mainfont $tag]
3262 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3264 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3265 -width $lthickness -fill black -tags tag.$id]
3267 foreach tag $marks x $xvals wid $wvals {
3268 set xl [expr {$x + $delta}]
3269 set xr [expr {$x + $delta + $wid + $lthickness}]
3271 if {[incr ntags -1] >= 0} {
3273 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3274 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3275 -width 1 -outline black -fill yellow -tags tag.$id]
3276 $canv bind $t <1> [list showtag $tag 1]
3277 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3279 # draw a head or other ref
3280 if {[incr nheads -1] >= 0} {
3282 if {$tag eq $mainhead} {
3288 set xl [expr {$xl - $delta/2}]
3289 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3290 -width 1 -outline black -fill $col -tags tag.$id
3291 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3292 set rwid [font measure $mainfont $remoteprefix]
3293 set xi [expr {$x + 1}]
3294 set yti [expr {$yt + 1}]
3295 set xri [expr {$x + $rwid}]
3296 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3297 -width 0 -fill "#ffddaa" -tags tag.$id
3300 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3301 -font $font -tags [list tag.$id text]]
3303 $canv bind $t <1> [list showtag $tag 1]
3304 } elseif {$nheads >= 0} {
3305 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3311 proc xcoord {i level ln} {
3312 global canvx0 xspc1 xspc2
3314 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3315 if {$i > 0 && $i == $level} {
3316 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3317 } elseif {$i > $level} {
3318 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3323 proc show_status {msg} {
3324 global canv mainfont fgcolor
3327 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3328 -tags text -fill $fgcolor
3331 proc finishcommits {} {
3332 global commitidx phase curview
3333 global pending_select
3335 if {$commitidx($curview) > 0} {
3338 show_status "No commits selected"
3341 catch {unset pending_select}
3344 # Insert a new commit as the child of the commit on row $row.
3345 # The new commit will be displayed on row $row and the commits
3346 # on that row and below will move down one row.
3347 proc insertrow {row newcmit} {
3348 global displayorder parentlist childlist commitlisted
3349 global commitrow curview rowidlist rowoffsets numcommits
3350 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3351 global linesegends selectedline
3353 if {$row >= $numcommits} {
3354 puts "oops, inserting new row $row but only have $numcommits rows"
3357 set p [lindex $displayorder $row]
3358 set displayorder [linsert $displayorder $row $newcmit]
3359 set parentlist [linsert $parentlist $row $p]
3360 set kids [lindex $childlist $row]
3361 lappend kids $newcmit
3362 lset childlist $row $kids
3363 set childlist [linsert $childlist $row {}]
3364 set commitlisted [linsert $commitlisted $row 1]
3365 set l [llength $displayorder]
3366 for {set r $row} {$r < $l} {incr r} {
3367 set id [lindex $displayorder $r]
3368 set commitrow($curview,$id) $r
3371 set idlist [lindex $rowidlist $row]
3372 set offs [lindex $rowoffsets $row]
3375 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3381 if {[llength $kids] == 1} {
3382 set col [lsearch -exact $idlist $p]
3383 lset idlist $col $newcmit
3385 set col [llength $idlist]
3386 lappend idlist $newcmit
3388 lset rowoffsets $row $offs
3390 set rowidlist [linsert $rowidlist $row $idlist]
3391 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3393 set rowrangelist [linsert $rowrangelist $row {}]
3394 set l [llength $rowrangelist]
3395 for {set r 0} {$r < $l} {incr r} {
3396 set ranges [lindex $rowrangelist $r]
3397 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3401 lappend newranges [expr {$x + 1}]
3403 lappend newranges $x
3406 lset rowrangelist $r $newranges
3409 if {[llength $kids] > 1} {
3410 set rp1 [expr {$row + 1}]
3411 set ranges [lindex $rowrangelist $rp1]
3412 if {$ranges eq {}} {
3413 set ranges [list $row $rp1]
3414 } elseif {[lindex $ranges end-1] == $rp1} {
3415 lset ranges end-1 $row
3417 lset rowrangelist $rp1 $ranges
3419 foreach id [array names idrowranges] {
3420 set ranges $idrowranges($id)
3421 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3425 lappend newranges [expr {$x + 1}]
3427 lappend newranges $x
3430 set idrowranges($id) $newranges
3434 set linesegends [linsert $linesegends $row {}]
3440 if {[info exists selectedline] && $selectedline >= $row} {
3446 # Don't change the text pane cursor if it is currently the hand cursor,
3447 # showing that we are over a sha1 ID link.
3448 proc settextcursor {c} {
3449 global ctext curtextcursor
3451 if {[$ctext cget -cursor] == $curtextcursor} {
3452 $ctext config -cursor $c
3454 set curtextcursor $c
3457 proc nowbusy {what} {
3460 if {[array names isbusy] eq {}} {
3461 . config -cursor watch
3467 proc notbusy {what} {
3468 global isbusy maincursor textcursor
3470 catch {unset isbusy($what)}
3471 if {[array names isbusy] eq {}} {
3472 . config -cursor $maincursor
3473 settextcursor $textcursor
3479 global rowlaidout commitidx curview
3480 global pending_select
3483 layoutrows $rowlaidout $commitidx($curview) 1
3485 optimize_rows $row 0 $commitidx($curview)
3486 showstuff $commitidx($curview)
3487 if {[info exists pending_select]} {
3491 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3493 #puts "overall $drawmsecs ms for $numcommits commits"
3496 proc findmatches {f} {
3497 global findtype foundstring foundstrlen
3498 if {$findtype == "Regexp"} {
3499 set matches [regexp -indices -all -inline $foundstring $f]
3501 if {$findtype == "IgnCase"} {
3502 set str [string tolower $f]
3508 while {[set j [string first $foundstring $str $i]] >= 0} {
3509 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3510 set i [expr {$j + $foundstrlen}]
3517 global findtype findloc findstring markedmatches commitinfo
3518 global numcommits displayorder linehtag linentag linedtag
3519 global mainfont canv canv2 canv3 selectedline
3520 global matchinglines foundstring foundstrlen matchstring
3525 cancel_next_highlight
3527 set matchinglines {}
3528 if {$findtype == "IgnCase"} {
3529 set foundstring [string tolower $findstring]
3531 set foundstring $findstring
3533 set foundstrlen [string length $findstring]
3534 if {$foundstrlen == 0} return
3535 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3536 set matchstring "*$matchstring*"
3537 if {![info exists selectedline]} {
3540 set oldsel $selectedline
3543 set fldtypes {Headline Author Date Committer CDate Comments}
3545 foreach id $displayorder {
3546 set d $commitdata($id)
3548 if {$findtype == "Regexp"} {
3549 set doesmatch [regexp $foundstring $d]
3550 } elseif {$findtype == "IgnCase"} {
3551 set doesmatch [string match -nocase $matchstring $d]
3553 set doesmatch [string match $matchstring $d]
3555 if {!$doesmatch} continue
3556 if {![info exists commitinfo($id)]} {
3559 set info $commitinfo($id)
3561 foreach f $info ty $fldtypes {
3562 if {$findloc != "All fields" && $findloc != $ty} {
3565 set matches [findmatches $f]
3566 if {$matches == {}} continue
3568 if {$ty == "Headline"} {
3570 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3571 } elseif {$ty == "Author"} {
3573 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3574 } elseif {$ty == "Date"} {
3576 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3580 lappend matchinglines $l
3581 if {!$didsel && $l > $oldsel} {
3587 if {$matchinglines == {}} {
3589 } elseif {!$didsel} {
3590 findselectline [lindex $matchinglines 0]
3594 proc findselectline {l} {
3595 global findloc commentend ctext
3597 if {$findloc == "All fields" || $findloc == "Comments"} {
3598 # highlight the matches in the comments
3599 set f [$ctext get 1.0 $commentend]
3600 set matches [findmatches $f]
3601 foreach match $matches {
3602 set start [lindex $match 0]
3603 set end [expr {[lindex $match 1] + 1}]
3604 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3609 proc findnext {restart} {
3610 global matchinglines selectedline
3611 if {![info exists matchinglines]} {
3617 if {![info exists selectedline]} return
3618 foreach l $matchinglines {
3619 if {$l > $selectedline} {
3628 global matchinglines selectedline
3629 if {![info exists matchinglines]} {
3633 if {![info exists selectedline]} return
3635 foreach l $matchinglines {
3636 if {$l >= $selectedline} break
3640 findselectline $prev
3646 proc stopfindproc {{done 0}} {
3647 global findprocpid findprocfile findids
3648 global ctext findoldcursor phase maincursor textcursor
3649 global findinprogress
3651 catch {unset findids}
3652 if {[info exists findprocpid]} {
3654 catch {exec kill $findprocpid}
3656 catch {close $findprocfile}
3659 catch {unset findinprogress}
3663 # mark a commit as matching by putting a yellow background
3664 # behind the headline
3665 proc markheadline {l id} {
3666 global canv mainfont linehtag
3669 set bbox [$canv bbox $linehtag($l)]
3670 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3674 # mark the bits of a headline, author or date that match a find string
3675 proc markmatches {canv l str tag matches font} {
3676 set bbox [$canv bbox $tag]
3677 set x0 [lindex $bbox 0]
3678 set y0 [lindex $bbox 1]
3679 set y1 [lindex $bbox 3]
3680 foreach match $matches {
3681 set start [lindex $match 0]
3682 set end [lindex $match 1]
3683 if {$start > $end} continue
3684 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3685 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3686 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3687 [expr {$x0+$xlen+2}] $y1 \
3688 -outline {} -tags matches -fill yellow]
3693 proc unmarkmatches {} {
3694 global matchinglines findids
3695 allcanvs delete matches
3696 catch {unset matchinglines}
3697 catch {unset findids}
3700 proc selcanvline {w x y} {
3701 global canv canvy0 ctext linespc
3703 set ymax [lindex [$canv cget -scrollregion] 3]
3704 if {$ymax == {}} return
3705 set yfrac [lindex [$canv yview] 0]
3706 set y [expr {$y + $yfrac * $ymax}]
3707 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3712 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3718 proc commit_descriptor {p} {
3720 if {![info exists commitinfo($p)]} {
3724 if {[llength $commitinfo($p)] > 1} {
3725 set l [lindex $commitinfo($p) 0]
3730 # append some text to the ctext widget, and make any SHA1 ID
3731 # that we know about be a clickable link.
3732 proc appendwithlinks {text tags} {
3733 global ctext commitrow linknum curview
3735 set start [$ctext index "end - 1c"]
3736 $ctext insert end $text $tags
3737 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3741 set linkid [string range $text $s $e]
3742 if {![info exists commitrow($curview,$linkid)]} continue
3744 $ctext tag add link "$start + $s c" "$start + $e c"
3745 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3746 $ctext tag bind link$linknum <1> \
3747 [list selectline $commitrow($curview,$linkid) 1]
3750 $ctext tag conf link -foreground blue -underline 1
3751 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3752 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3755 proc viewnextline {dir} {
3759 set ymax [lindex [$canv cget -scrollregion] 3]
3760 set wnow [$canv yview]
3761 set wtop [expr {[lindex $wnow 0] * $ymax}]
3762 set newtop [expr {$wtop + $dir * $linespc}]
3765 } elseif {$newtop > $ymax} {
3768 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3771 # add a list of tag or branch names at position pos
3772 # returns the number of names inserted
3773 proc appendrefs {pos tags var} {
3774 global ctext commitrow linknum curview $var
3776 if {[catch {$ctext index $pos}]} {
3779 set tags [lsort $tags]
3782 set id [set $var\($tag\)]
3785 $ctext insert $pos $sep
3786 $ctext insert $pos $tag $lk
3787 $ctext tag conf $lk -foreground blue
3788 if {[info exists commitrow($curview,$id)]} {
3789 $ctext tag bind $lk <1> \
3790 [list selectline $commitrow($curview,$id) 1]
3791 $ctext tag conf $lk -underline 1
3792 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3793 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3797 return [llength $tags]
3800 proc taglist {ids} {
3805 foreach tag $idtags($id) {
3812 # called when we have finished computing the nearby tags
3813 proc dispneartags {} {
3814 global selectedline currentid ctext anc_tags desc_tags showneartags
3817 if {![info exists selectedline] || !$showneartags} return
3819 $ctext conf -state normal
3820 if {[info exists desc_heads($id)]} {
3821 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3822 $ctext insert "branch -2c" "es"
3825 if {[info exists anc_tags($id)]} {
3826 appendrefs follows [taglist $anc_tags($id)] tagids
3828 if {[info exists desc_tags($id)]} {
3829 appendrefs precedes [taglist $desc_tags($id)] tagids
3831 $ctext conf -state disabled
3834 proc selectline {l isnew} {
3835 global canv canv2 canv3 ctext commitinfo selectedline
3836 global displayorder linehtag linentag linedtag
3837 global canvy0 linespc parentlist childlist
3838 global currentid sha1entry
3839 global commentend idtags linknum
3840 global mergemax numcommits pending_select
3841 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3843 catch {unset pending_select}
3846 cancel_next_highlight
3847 if {$l < 0 || $l >= $numcommits} return
3848 set y [expr {$canvy0 + $l * $linespc}]
3849 set ymax [lindex [$canv cget -scrollregion] 3]
3850 set ytop [expr {$y - $linespc - 1}]
3851 set ybot [expr {$y + $linespc + 1}]
3852 set wnow [$canv yview]
3853 set wtop [expr {[lindex $wnow 0] * $ymax}]
3854 set wbot [expr {[lindex $wnow 1] * $ymax}]
3855 set wh [expr {$wbot - $wtop}]
3857 if {$ytop < $wtop} {
3858 if {$ybot < $wtop} {
3859 set newtop [expr {$y - $wh / 2.0}]
3862 if {$newtop > $wtop - $linespc} {
3863 set newtop [expr {$wtop - $linespc}]
3866 } elseif {$ybot > $wbot} {
3867 if {$ytop > $wbot} {
3868 set newtop [expr {$y - $wh / 2.0}]
3870 set newtop [expr {$ybot - $wh}]
3871 if {$newtop < $wtop + $linespc} {
3872 set newtop [expr {$wtop + $linespc}]
3876 if {$newtop != $wtop} {
3880 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3884 if {![info exists linehtag($l)]} return
3886 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3887 -tags secsel -fill [$canv cget -selectbackground]]
3889 $canv2 delete secsel
3890 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3891 -tags secsel -fill [$canv2 cget -selectbackground]]
3893 $canv3 delete secsel
3894 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3895 -tags secsel -fill [$canv3 cget -selectbackground]]
3899 addtohistory [list selectline $l 0]
3904 set id [lindex $displayorder $l]
3906 $sha1entry delete 0 end
3907 $sha1entry insert 0 $id
3908 $sha1entry selection from 0
3909 $sha1entry selection to end
3912 $ctext conf -state normal
3915 set info $commitinfo($id)
3916 set date [formatdate [lindex $info 2]]
3917 $ctext insert end "Author: [lindex $info 1] $date\n"
3918 set date [formatdate [lindex $info 4]]
3919 $ctext insert end "Committer: [lindex $info 3] $date\n"
3920 if {[info exists idtags($id)]} {
3921 $ctext insert end "Tags:"
3922 foreach tag $idtags($id) {
3923 $ctext insert end " $tag"
3925 $ctext insert end "\n"
3929 set olds [lindex $parentlist $l]
3930 if {[llength $olds] > 1} {
3933 if {$np >= $mergemax} {
3938 $ctext insert end "Parent: " $tag
3939 appendwithlinks [commit_descriptor $p] {}
3944 append headers "Parent: [commit_descriptor $p]"
3948 foreach c [lindex $childlist $l] {
3949 append headers "Child: [commit_descriptor $c]"
3952 # make anything that looks like a SHA1 ID be a clickable link
3953 appendwithlinks $headers {}
3954 if {$showneartags} {
3955 if {![info exists allcommits]} {
3958 $ctext insert end "Branch: "
3959 $ctext mark set branch "end -1c"
3960 $ctext mark gravity branch left
3961 if {[info exists desc_heads($id)]} {
3962 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3963 # turn "Branch" into "Branches"
3964 $ctext insert "branch -2c" "es"
3967 $ctext insert end "\nFollows: "
3968 $ctext mark set follows "end -1c"
3969 $ctext mark gravity follows left
3970 if {[info exists anc_tags($id)]} {
3971 appendrefs follows [taglist $anc_tags($id)] tagids
3973 $ctext insert end "\nPrecedes: "
3974 $ctext mark set precedes "end -1c"
3975 $ctext mark gravity precedes left
3976 if {[info exists desc_tags($id)]} {
3977 appendrefs precedes [taglist $desc_tags($id)] tagids
3979 $ctext insert end "\n"
3981 $ctext insert end "\n"
3982 appendwithlinks [lindex $info 5] {comment}
3984 $ctext tag delete Comments
3985 $ctext tag remove found 1.0 end
3986 $ctext conf -state disabled
3987 set commentend [$ctext index "end - 1c"]
3989 init_flist "Comments"
3990 if {$cmitmode eq "tree"} {
3992 } elseif {[llength $olds] <= 1} {
3999 proc selfirstline {} {
4004 proc sellastline {} {
4007 set l [expr {$numcommits - 1}]
4011 proc selnextline {dir} {
4013 if {![info exists selectedline]} return
4014 set l [expr {$selectedline + $dir}]
4019 proc selnextpage {dir} {
4020 global canv linespc selectedline numcommits
4022 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4026 allcanvs yview scroll [expr {$dir * $lpp}] units
4028 if {![info exists selectedline]} return
4029 set l [expr {$selectedline + $dir * $lpp}]
4032 } elseif {$l >= $numcommits} {
4033 set l [expr $numcommits - 1]
4039 proc unselectline {} {
4040 global selectedline currentid
4042 catch {unset selectedline}
4043 catch {unset currentid}
4044 allcanvs delete secsel
4046 cancel_next_highlight
4049 proc reselectline {} {
4052 if {[info exists selectedline]} {
4053 selectline $selectedline 0
4057 proc addtohistory {cmd} {
4058 global history historyindex curview
4060 set elt [list $curview $cmd]
4061 if {$historyindex > 0
4062 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4066 if {$historyindex < [llength $history]} {
4067 set history [lreplace $history $historyindex end $elt]
4069 lappend history $elt
4072 if {$historyindex > 1} {
4073 .tf.bar.leftbut conf -state normal
4075 .tf.bar.leftbut conf -state disabled
4077 .tf.bar.rightbut conf -state disabled
4083 set view [lindex $elt 0]
4084 set cmd [lindex $elt 1]
4085 if {$curview != $view} {
4092 global history historyindex
4094 if {$historyindex > 1} {
4095 incr historyindex -1
4096 godo [lindex $history [expr {$historyindex - 1}]]
4097 .tf.bar.rightbut conf -state normal
4099 if {$historyindex <= 1} {
4100 .tf.bar.leftbut conf -state disabled
4105 global history historyindex
4107 if {$historyindex < [llength $history]} {
4108 set cmd [lindex $history $historyindex]
4111 .tf.bar.leftbut conf -state normal
4113 if {$historyindex >= [llength $history]} {
4114 .tf.bar.rightbut conf -state disabled
4119 global treefilelist treeidlist diffids diffmergeid treepending
4122 catch {unset diffmergeid}
4123 if {![info exists treefilelist($id)]} {
4124 if {![info exists treepending]} {
4125 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4129 set treefilelist($id) {}
4130 set treeidlist($id) {}
4131 fconfigure $gtf -blocking 0
4132 fileevent $gtf readable [list gettreeline $gtf $id]
4139 proc gettreeline {gtf id} {
4140 global treefilelist treeidlist treepending cmitmode diffids
4142 while {[gets $gtf line] >= 0} {
4143 if {[lindex $line 1] ne "blob"} continue
4144 set sha1 [lindex $line 2]
4145 set fname [lindex $line 3]
4146 lappend treefilelist($id) $fname
4147 lappend treeidlist($id) $sha1
4149 if {![eof $gtf]} return
4152 if {$cmitmode ne "tree"} {
4153 if {![info exists diffmergeid]} {
4154 gettreediffs $diffids
4156 } elseif {$id ne $diffids} {
4164 global treefilelist treeidlist diffids
4165 global ctext commentend
4167 set i [lsearch -exact $treefilelist($diffids) $f]
4169 puts "oops, $f not in list for id $diffids"
4172 set blob [lindex $treeidlist($diffids) $i]
4173 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4174 puts "oops, error reading blob $blob: $err"
4177 fconfigure $bf -blocking 0
4178 fileevent $bf readable [list getblobline $bf $diffids]
4179 $ctext config -state normal
4180 clear_ctext $commentend
4181 $ctext insert end "\n"
4182 $ctext insert end "$f\n" filesep
4183 $ctext config -state disabled
4184 $ctext yview $commentend
4187 proc getblobline {bf id} {
4188 global diffids cmitmode ctext
4190 if {$id ne $diffids || $cmitmode ne "tree"} {
4194 $ctext config -state normal
4195 while {[gets $bf line] >= 0} {
4196 $ctext insert end "$line\n"
4199 # delete last newline
4200 $ctext delete "end - 2c" "end - 1c"
4203 $ctext config -state disabled
4206 proc mergediff {id l} {
4207 global diffmergeid diffopts mdifffd
4213 # this doesn't seem to actually affect anything...
4214 set env(GIT_DIFF_OPTS) $diffopts
4215 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4216 if {[catch {set mdf [open $cmd r]} err]} {
4217 error_popup "Error getting merge diffs: $err"
4220 fconfigure $mdf -blocking 0
4221 set mdifffd($id) $mdf
4222 set np [llength [lindex $parentlist $l]]
4223 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4224 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4227 proc getmergediffline {mdf id np} {
4228 global diffmergeid ctext cflist nextupdate mergemax
4229 global difffilestart mdifffd
4231 set n [gets $mdf line]
4238 if {![info exists diffmergeid] || $id != $diffmergeid
4239 || $mdf != $mdifffd($id)} {
4242 $ctext conf -state normal
4243 if {[regexp {^diff --cc (.*)} $line match fname]} {
4244 # start of a new file
4245 $ctext insert end "\n"
4246 set here [$ctext index "end - 1c"]
4247 lappend difffilestart $here
4248 add_flist [list $fname]
4249 set l [expr {(78 - [string length $fname]) / 2}]
4250 set pad [string range "----------------------------------------" 1 $l]
4251 $ctext insert end "$pad $fname $pad\n" filesep
4252 } elseif {[regexp {^@@} $line]} {
4253 $ctext insert end "$line\n" hunksep
4254 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4257 # parse the prefix - one ' ', '-' or '+' for each parent
4262 for {set j 0} {$j < $np} {incr j} {
4263 set c [string range $line $j $j]
4266 } elseif {$c == "-"} {
4268 } elseif {$c == "+"} {
4277 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4278 # line doesn't appear in result, parents in $minuses have the line
4279 set num [lindex $minuses 0]
4280 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4281 # line appears in result, parents in $pluses don't have the line
4282 lappend tags mresult
4283 set num [lindex $spaces 0]
4286 if {$num >= $mergemax} {
4291 $ctext insert end "$line\n" $tags
4293 $ctext conf -state disabled
4294 if {[clock clicks -milliseconds] >= $nextupdate} {
4296 fileevent $mdf readable {}
4298 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4302 proc startdiff {ids} {
4303 global treediffs diffids treepending diffmergeid
4306 catch {unset diffmergeid}
4307 if {![info exists treediffs($ids)]} {
4308 if {![info exists treepending]} {
4316 proc addtocflist {ids} {
4317 global treediffs cflist
4318 add_flist $treediffs($ids)
4322 proc gettreediffs {ids} {
4323 global treediff treepending
4324 set treepending $ids
4327 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4329 fconfigure $gdtf -blocking 0
4330 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4333 proc gettreediffline {gdtf ids} {
4334 global treediff treediffs treepending diffids diffmergeid
4337 set n [gets $gdtf line]
4339 if {![eof $gdtf]} return
4341 set treediffs($ids) $treediff
4343 if {$cmitmode eq "tree"} {
4345 } elseif {$ids != $diffids} {
4346 if {![info exists diffmergeid]} {
4347 gettreediffs $diffids
4354 set file [lindex $line 5]
4355 lappend treediff $file
4358 proc getblobdiffs {ids} {
4359 global diffopts blobdifffd diffids env curdifftag curtagstart
4360 global nextupdate diffinhdr treediffs
4362 set env(GIT_DIFF_OPTS) $diffopts
4363 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4364 if {[catch {set bdf [open $cmd r]} err]} {
4365 puts "error getting diffs: $err"
4369 fconfigure $bdf -blocking 0
4370 set blobdifffd($ids) $bdf
4371 set curdifftag Comments
4373 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4374 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4377 proc setinlist {var i val} {
4380 while {[llength [set $var]] < $i} {
4383 if {[llength [set $var]] == $i} {
4390 proc getblobdiffline {bdf ids} {
4391 global diffids blobdifffd ctext curdifftag curtagstart
4392 global diffnexthead diffnextnote difffilestart
4393 global nextupdate diffinhdr treediffs
4395 set n [gets $bdf line]
4399 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4400 $ctext tag add $curdifftag $curtagstart end
4405 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4408 $ctext conf -state normal
4409 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4410 # start of a new file
4411 $ctext insert end "\n"
4412 $ctext tag add $curdifftag $curtagstart end
4413 set here [$ctext index "end - 1c"]
4414 set curtagstart $here
4416 set i [lsearch -exact $treediffs($ids) $fname]
4418 setinlist difffilestart $i $here
4420 if {$newname ne $fname} {
4421 set i [lsearch -exact $treediffs($ids) $newname]
4423 setinlist difffilestart $i $here
4426 set curdifftag "f:$fname"
4427 $ctext tag delete $curdifftag
4428 set l [expr {(78 - [string length $header]) / 2}]
4429 set pad [string range "----------------------------------------" 1 $l]
4430 $ctext insert end "$pad $header $pad\n" filesep
4432 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4434 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4436 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4437 $line match f1l f1c f2l f2c rest]} {
4438 $ctext insert end "$line\n" hunksep
4441 set x [string range $line 0 0]
4442 if {$x == "-" || $x == "+"} {
4443 set tag [expr {$x == "+"}]
4444 $ctext insert end "$line\n" d$tag
4445 } elseif {$x == " "} {
4446 $ctext insert end "$line\n"
4447 } elseif {$diffinhdr || $x == "\\"} {
4448 # e.g. "\ No newline at end of file"
4449 $ctext insert end "$line\n" filesep
4451 # Something else we don't recognize
4452 if {$curdifftag != "Comments"} {
4453 $ctext insert end "\n"
4454 $ctext tag add $curdifftag $curtagstart end
4455 set curtagstart [$ctext index "end - 1c"]
4456 set curdifftag Comments
4458 $ctext insert end "$line\n" filesep
4461 $ctext conf -state disabled
4462 if {[clock clicks -milliseconds] >= $nextupdate} {
4464 fileevent $bdf readable {}
4466 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4471 global difffilestart ctext
4472 set prev [lindex $difffilestart 0]
4473 set here [$ctext index @0,0]
4474 foreach loc $difffilestart {
4475 if {[$ctext compare $loc >= $here]} {
4485 global difffilestart ctext
4486 set here [$ctext index @0,0]
4487 foreach loc $difffilestart {
4488 if {[$ctext compare $loc > $here]} {
4495 proc clear_ctext {{first 1.0}} {
4496 global ctext smarktop smarkbot
4498 set l [lindex [split $first .] 0]
4499 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4502 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4505 $ctext delete $first end
4508 proc incrsearch {name ix op} {
4509 global ctext searchstring searchdirn
4511 $ctext tag remove found 1.0 end
4512 if {[catch {$ctext index anchor}]} {
4513 # no anchor set, use start of selection, or of visible area
4514 set sel [$ctext tag ranges sel]
4516 $ctext mark set anchor [lindex $sel 0]
4517 } elseif {$searchdirn eq "-forwards"} {
4518 $ctext mark set anchor @0,0
4520 $ctext mark set anchor @0,[winfo height $ctext]
4523 if {$searchstring ne {}} {
4524 set here [$ctext search $searchdirn -- $searchstring anchor]
4533 global sstring ctext searchstring searchdirn
4536 $sstring icursor end
4537 set searchdirn -forwards
4538 if {$searchstring ne {}} {
4539 set sel [$ctext tag ranges sel]
4541 set start "[lindex $sel 0] + 1c"
4542 } elseif {[catch {set start [$ctext index anchor]}]} {
4545 set match [$ctext search -count mlen -- $searchstring $start]
4546 $ctext tag remove sel 1.0 end
4552 set mend "$match + $mlen c"
4553 $ctext tag add sel $match $mend
4554 $ctext mark unset anchor
4558 proc dosearchback {} {
4559 global sstring ctext searchstring searchdirn
4562 $sstring icursor end
4563 set searchdirn -backwards
4564 if {$searchstring ne {}} {
4565 set sel [$ctext tag ranges sel]
4567 set start [lindex $sel 0]
4568 } elseif {[catch {set start [$ctext index anchor]}]} {
4569 set start @0,[winfo height $ctext]
4571 set match [$ctext search -backwards -count ml -- $searchstring $start]
4572 $ctext tag remove sel 1.0 end
4578 set mend "$match + $ml c"
4579 $ctext tag add sel $match $mend
4580 $ctext mark unset anchor
4584 proc searchmark {first last} {
4585 global ctext searchstring
4589 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4590 if {$match eq {}} break
4591 set mend "$match + $mlen c"
4592 $ctext tag add found $match $mend
4596 proc searchmarkvisible {doall} {
4597 global ctext smarktop smarkbot
4599 set topline [lindex [split [$ctext index @0,0] .] 0]
4600 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4601 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4602 # no overlap with previous
4603 searchmark $topline $botline
4604 set smarktop $topline
4605 set smarkbot $botline
4607 if {$topline < $smarktop} {
4608 searchmark $topline [expr {$smarktop-1}]
4609 set smarktop $topline
4611 if {$botline > $smarkbot} {
4612 searchmark [expr {$smarkbot+1}] $botline
4613 set smarkbot $botline
4618 proc scrolltext {f0 f1} {
4621 .bleft.sb set $f0 $f1
4622 if {$searchstring ne {}} {
4628 global linespc charspc canvx0 canvy0 mainfont
4629 global xspc1 xspc2 lthickness
4631 set linespc [font metrics $mainfont -linespace]
4632 set charspc [font measure $mainfont "m"]
4633 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4634 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4635 set lthickness [expr {int($linespc / 9) + 1}]
4636 set xspc1(0) $linespc
4644 set ymax [lindex [$canv cget -scrollregion] 3]
4645 if {$ymax eq {} || $ymax == 0} return
4646 set span [$canv yview]
4649 allcanvs yview moveto [lindex $span 0]
4651 if {[info exists selectedline]} {
4652 selectline $selectedline 0
4653 allcanvs yview moveto [lindex $span 0]
4657 proc incrfont {inc} {
4658 global mainfont textfont ctext canv phase
4659 global stopped entries
4661 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4662 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4664 $ctext conf -font $textfont
4665 $ctext tag conf filesep -font [concat $textfont bold]
4666 foreach e $entries {
4667 $e conf -font $mainfont
4669 if {$phase eq "getcommits"} {
4670 $canv itemconf textitems -font $mainfont
4676 global sha1entry sha1string
4677 if {[string length $sha1string] == 40} {
4678 $sha1entry delete 0 end
4682 proc sha1change {n1 n2 op} {
4683 global sha1string currentid sha1but
4684 if {$sha1string == {}
4685 || ([info exists currentid] && $sha1string == $currentid)} {
4690 if {[$sha1but cget -state] == $state} return
4691 if {$state == "normal"} {
4692 $sha1but conf -state normal -relief raised -text "Goto: "
4694 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4698 proc gotocommit {} {
4699 global sha1string currentid commitrow tagids headids
4700 global displayorder numcommits curview
4702 if {$sha1string == {}
4703 || ([info exists currentid] && $sha1string == $currentid)} return
4704 if {[info exists tagids($sha1string)]} {
4705 set id $tagids($sha1string)
4706 } elseif {[info exists headids($sha1string)]} {
4707 set id $headids($sha1string)
4709 set id [string tolower $sha1string]
4710 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4712 foreach i $displayorder {
4713 if {[string match $id* $i]} {
4717 if {$matches ne {}} {
4718 if {[llength $matches] > 1} {
4719 error_popup "Short SHA1 id $id is ambiguous"
4722 set id [lindex $matches 0]
4726 if {[info exists commitrow($curview,$id)]} {
4727 selectline $commitrow($curview,$id) 1
4730 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4735 error_popup "$type $sha1string is not known"
4738 proc lineenter {x y id} {
4739 global hoverx hovery hoverid hovertimer
4740 global commitinfo canv
4742 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4746 if {[info exists hovertimer]} {
4747 after cancel $hovertimer
4749 set hovertimer [after 500 linehover]
4753 proc linemotion {x y id} {
4754 global hoverx hovery hoverid hovertimer
4756 if {[info exists hoverid] && $id == $hoverid} {
4759 if {[info exists hovertimer]} {
4760 after cancel $hovertimer
4762 set hovertimer [after 500 linehover]
4766 proc lineleave {id} {
4767 global hoverid hovertimer canv
4769 if {[info exists hoverid] && $id == $hoverid} {
4771 if {[info exists hovertimer]} {
4772 after cancel $hovertimer
4780 global hoverx hovery hoverid hovertimer
4781 global canv linespc lthickness
4782 global commitinfo mainfont
4784 set text [lindex $commitinfo($hoverid) 0]
4785 set ymax [lindex [$canv cget -scrollregion] 3]
4786 if {$ymax == {}} return
4787 set yfrac [lindex [$canv yview] 0]
4788 set x [expr {$hoverx + 2 * $linespc}]
4789 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4790 set x0 [expr {$x - 2 * $lthickness}]
4791 set y0 [expr {$y - 2 * $lthickness}]
4792 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4793 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4794 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4795 -fill \#ffff80 -outline black -width 1 -tags hover]
4797 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4802 proc clickisonarrow {id y} {
4805 set ranges [rowranges $id]
4806 set thresh [expr {2 * $lthickness + 6}]
4807 set n [expr {[llength $ranges] - 1}]
4808 for {set i 1} {$i < $n} {incr i} {
4809 set row [lindex $ranges $i]
4810 if {abs([yc $row] - $y) < $thresh} {
4817 proc arrowjump {id n y} {
4820 # 1 <-> 2, 3 <-> 4, etc...
4821 set n [expr {(($n - 1) ^ 1) + 1}]
4822 set row [lindex [rowranges $id] $n]
4824 set ymax [lindex [$canv cget -scrollregion] 3]
4825 if {$ymax eq {} || $ymax <= 0} return
4826 set view [$canv yview]
4827 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4828 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4832 allcanvs yview moveto $yfrac
4835 proc lineclick {x y id isnew} {
4836 global ctext commitinfo children canv thickerline curview
4838 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4843 # draw this line thicker than normal
4847 set ymax [lindex [$canv cget -scrollregion] 3]
4848 if {$ymax eq {}} return
4849 set yfrac [lindex [$canv yview] 0]
4850 set y [expr {$y + $yfrac * $ymax}]
4852 set dirn [clickisonarrow $id $y]
4854 arrowjump $id $dirn $y
4859 addtohistory [list lineclick $x $y $id 0]
4861 # fill the details pane with info about this line
4862 $ctext conf -state normal
4864 $ctext tag conf link -foreground blue -underline 1
4865 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4866 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4867 $ctext insert end "Parent:\t"
4868 $ctext insert end $id [list link link0]
4869 $ctext tag bind link0 <1> [list selbyid $id]
4870 set info $commitinfo($id)
4871 $ctext insert end "\n\t[lindex $info 0]\n"
4872 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4873 set date [formatdate [lindex $info 2]]
4874 $ctext insert end "\tDate:\t$date\n"
4875 set kids $children($curview,$id)
4877 $ctext insert end "\nChildren:"
4879 foreach child $kids {
4881 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4882 set info $commitinfo($child)
4883 $ctext insert end "\n\t"
4884 $ctext insert end $child [list link link$i]
4885 $ctext tag bind link$i <1> [list selbyid $child]
4886 $ctext insert end "\n\t[lindex $info 0]"
4887 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4888 set date [formatdate [lindex $info 2]]
4889 $ctext insert end "\n\tDate:\t$date\n"
4892 $ctext conf -state disabled
4896 proc normalline {} {
4898 if {[info exists thickerline]} {
4906 global commitrow curview
4907 if {[info exists commitrow($curview,$id)]} {
4908 selectline $commitrow($curview,$id) 1
4914 if {![info exists startmstime]} {
4915 set startmstime [clock clicks -milliseconds]
4917 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4920 proc rowmenu {x y id} {
4921 global rowctxmenu commitrow selectedline rowmenuid curview
4923 if {![info exists selectedline]
4924 || $commitrow($curview,$id) eq $selectedline} {
4929 $rowctxmenu entryconfigure "Diff this*" -state $state
4930 $rowctxmenu entryconfigure "Diff selected*" -state $state
4931 $rowctxmenu entryconfigure "Make patch" -state $state
4933 tk_popup $rowctxmenu $x $y
4936 proc diffvssel {dirn} {
4937 global rowmenuid selectedline displayorder
4939 if {![info exists selectedline]} return
4941 set oldid [lindex $displayorder $selectedline]
4942 set newid $rowmenuid
4944 set oldid $rowmenuid
4945 set newid [lindex $displayorder $selectedline]
4947 addtohistory [list doseldiff $oldid $newid]
4948 doseldiff $oldid $newid
4951 proc doseldiff {oldid newid} {
4955 $ctext conf -state normal
4958 $ctext insert end "From "
4959 $ctext tag conf link -foreground blue -underline 1
4960 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4961 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4962 $ctext tag bind link0 <1> [list selbyid $oldid]
4963 $ctext insert end $oldid [list link link0]
4964 $ctext insert end "\n "
4965 $ctext insert end [lindex $commitinfo($oldid) 0]
4966 $ctext insert end "\n\nTo "
4967 $ctext tag bind link1 <1> [list selbyid $newid]
4968 $ctext insert end $newid [list link link1]
4969 $ctext insert end "\n "
4970 $ctext insert end [lindex $commitinfo($newid) 0]
4971 $ctext insert end "\n"
4972 $ctext conf -state disabled
4973 $ctext tag delete Comments
4974 $ctext tag remove found 1.0 end
4975 startdiff [list $oldid $newid]
4979 global rowmenuid currentid commitinfo patchtop patchnum
4981 if {![info exists currentid]} return
4982 set oldid $currentid
4983 set oldhead [lindex $commitinfo($oldid) 0]
4984 set newid $rowmenuid
4985 set newhead [lindex $commitinfo($newid) 0]
4988 catch {destroy $top}
4990 label $top.title -text "Generate patch"
4991 grid $top.title - -pady 10
4992 label $top.from -text "From:"
4993 entry $top.fromsha1 -width 40 -relief flat
4994 $top.fromsha1 insert 0 $oldid
4995 $top.fromsha1 conf -state readonly
4996 grid $top.from $top.fromsha1 -sticky w
4997 entry $top.fromhead -width 60 -relief flat
4998 $top.fromhead insert 0 $oldhead
4999 $top.fromhead conf -state readonly
5000 grid x $top.fromhead -sticky w
5001 label $top.to -text "To:"
5002 entry $top.tosha1 -width 40 -relief flat
5003 $top.tosha1 insert 0 $newid
5004 $top.tosha1 conf -state readonly
5005 grid $top.to $top.tosha1 -sticky w
5006 entry $top.tohead -width 60 -relief flat
5007 $top.tohead insert 0 $newhead
5008 $top.tohead conf -state readonly
5009 grid x $top.tohead -sticky w
5010 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5011 grid $top.rev x -pady 10
5012 label $top.flab -text "Output file:"
5013 entry $top.fname -width 60
5014 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5016 grid $top.flab $top.fname -sticky w
5018 button $top.buts.gen -text "Generate" -command mkpatchgo
5019 button $top.buts.can -text "Cancel" -command mkpatchcan
5020 grid $top.buts.gen $top.buts.can
5021 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5022 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5023 grid $top.buts - -pady 10 -sticky ew
5027 proc mkpatchrev {} {
5030 set oldid [$patchtop.fromsha1 get]
5031 set oldhead [$patchtop.fromhead get]
5032 set newid [$patchtop.tosha1 get]
5033 set newhead [$patchtop.tohead get]
5034 foreach e [list fromsha1 fromhead tosha1 tohead] \
5035 v [list $newid $newhead $oldid $oldhead] {
5036 $patchtop.$e conf -state normal
5037 $patchtop.$e delete 0 end
5038 $patchtop.$e insert 0 $v
5039 $patchtop.$e conf -state readonly
5046 set oldid [$patchtop.fromsha1 get]
5047 set newid [$patchtop.tosha1 get]
5048 set fname [$patchtop.fname get]
5049 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5050 error_popup "Error creating patch: $err"
5052 catch {destroy $patchtop}
5056 proc mkpatchcan {} {
5059 catch {destroy $patchtop}
5064 global rowmenuid mktagtop commitinfo
5068 catch {destroy $top}
5070 label $top.title -text "Create tag"
5071 grid $top.title - -pady 10
5072 label $top.id -text "ID:"
5073 entry $top.sha1 -width 40 -relief flat
5074 $top.sha1 insert 0 $rowmenuid
5075 $top.sha1 conf -state readonly
5076 grid $top.id $top.sha1 -sticky w
5077 entry $top.head -width 60 -relief flat
5078 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5079 $top.head conf -state readonly
5080 grid x $top.head -sticky w
5081 label $top.tlab -text "Tag name:"
5082 entry $top.tag -width 60
5083 grid $top.tlab $top.tag -sticky w
5085 button $top.buts.gen -text "Create" -command mktaggo
5086 button $top.buts.can -text "Cancel" -command mktagcan
5087 grid $top.buts.gen $top.buts.can
5088 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5089 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5090 grid $top.buts - -pady 10 -sticky ew
5095 global mktagtop env tagids idtags
5097 set id [$mktagtop.sha1 get]
5098 set tag [$mktagtop.tag get]
5100 error_popup "No tag name specified"
5103 if {[info exists tagids($tag)]} {
5104 error_popup "Tag \"$tag\" already exists"
5109 set fname [file join $dir "refs/tags" $tag]
5110 set f [open $fname w]
5114 error_popup "Error creating tag: $err"
5118 set tagids($tag) $id
5119 lappend idtags($id) $tag
5124 proc redrawtags {id} {
5125 global canv linehtag commitrow idpos selectedline curview
5126 global mainfont canvxmax
5128 if {![info exists commitrow($curview,$id)]} return
5129 drawcmitrow $commitrow($curview,$id)
5130 $canv delete tag.$id
5131 set xt [eval drawtags $id $idpos($id)]
5132 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5133 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5134 set xr [expr {$xt + [font measure $mainfont $text]}]
5135 if {$xr > $canvxmax} {
5139 if {[info exists selectedline]
5140 && $selectedline == $commitrow($curview,$id)} {
5141 selectline $selectedline 0
5148 catch {destroy $mktagtop}
5157 proc writecommit {} {
5158 global rowmenuid wrcomtop commitinfo wrcomcmd
5160 set top .writecommit
5162 catch {destroy $top}
5164 label $top.title -text "Write commit to file"
5165 grid $top.title - -pady 10
5166 label $top.id -text "ID:"
5167 entry $top.sha1 -width 40 -relief flat
5168 $top.sha1 insert 0 $rowmenuid
5169 $top.sha1 conf -state readonly
5170 grid $top.id $top.sha1 -sticky w
5171 entry $top.head -width 60 -relief flat
5172 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5173 $top.head conf -state readonly
5174 grid x $top.head -sticky w
5175 label $top.clab -text "Command:"
5176 entry $top.cmd -width 60 -textvariable wrcomcmd
5177 grid $top.clab $top.cmd -sticky w -pady 10
5178 label $top.flab -text "Output file:"
5179 entry $top.fname -width 60
5180 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5181 grid $top.flab $top.fname -sticky w
5183 button $top.buts.gen -text "Write" -command wrcomgo
5184 button $top.buts.can -text "Cancel" -command wrcomcan
5185 grid $top.buts.gen $top.buts.can
5186 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5187 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5188 grid $top.buts - -pady 10 -sticky ew
5195 set id [$wrcomtop.sha1 get]
5196 set cmd "echo $id | [$wrcomtop.cmd get]"
5197 set fname [$wrcomtop.fname get]
5198 if {[catch {exec sh -c $cmd >$fname &} err]} {
5199 error_popup "Error writing commit: $err"
5201 catch {destroy $wrcomtop}
5208 catch {destroy $wrcomtop}
5213 global rowmenuid mkbrtop
5216 catch {destroy $top}
5218 label $top.title -text "Create new branch"
5219 grid $top.title - -pady 10
5220 label $top.id -text "ID:"
5221 entry $top.sha1 -width 40 -relief flat
5222 $top.sha1 insert 0 $rowmenuid
5223 $top.sha1 conf -state readonly
5224 grid $top.id $top.sha1 -sticky w
5225 label $top.nlab -text "Name:"
5226 entry $top.name -width 40
5227 grid $top.nlab $top.name -sticky w
5229 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5230 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5231 grid $top.buts.go $top.buts.can
5232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5234 grid $top.buts - -pady 10 -sticky ew
5239 global headids idheads
5241 set name [$top.name get]
5242 set id [$top.sha1 get]
5244 error_popup "Please specify a name for the new branch"
5247 catch {destroy $top}
5251 exec git branch $name $id
5257 # XXX should update list of heads displayed for selected commit
5263 proc cherrypick {} {
5264 global rowmenuid curview commitrow
5265 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5267 if {[info exists desc_heads($rowmenuid)]
5268 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5269 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5270 included in branch $mainhead -- really re-apply it?"]
5275 set oldhead [exec git rev-parse HEAD]
5276 # Unfortunately git-cherry-pick writes stuff to stderr even when
5277 # no error occurs, and exec takes that as an indication of error...
5278 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5283 set newhead [exec git rev-parse HEAD]
5284 if {$newhead eq $oldhead} {
5286 error_popup "No changes committed"
5289 set allparents($newhead) $oldhead
5290 lappend allchildren($oldhead) $newhead
5291 set desc_heads($newhead) $mainhead
5292 if {[info exists anc_tags($oldhead)]} {
5293 set anc_tags($newhead) $anc_tags($oldhead)
5295 set desc_tags($newhead) {}
5296 if {[info exists commitrow($curview,$oldhead)]} {
5297 insertrow $commitrow($curview,$oldhead) $newhead
5298 if {$mainhead ne {}} {
5299 movedhead $newhead $mainhead
5307 # context menu for a head
5308 proc headmenu {x y id head} {
5309 global headmenuid headmenuhead headctxmenu
5312 set headmenuhead $head
5313 tk_popup $headctxmenu $x $y
5317 global headmenuid headmenuhead mainhead headids
5319 # check the tree is clean first??
5320 set oldmainhead $mainhead
5324 exec git checkout $headmenuhead
5330 set mainhead $headmenuhead
5331 if {[info exists headids($oldmainhead)]} {
5332 redrawtags $headids($oldmainhead)
5334 redrawtags $headmenuid
5339 global desc_heads headmenuid headmenuhead mainhead
5340 global headids idheads
5342 set head $headmenuhead
5344 if {$head eq $mainhead} {
5345 error_popup "Cannot delete the currently checked-out branch"
5348 if {$desc_heads($id) eq $head} {
5349 # the stuff on this branch isn't on any other branch
5350 if {![confirm_popup "The commits on branch $head aren't on any other\
5351 branch.\nReally delete branch $head?"]} return
5355 if {[catch {exec git branch -D $head} err]} {
5360 removedhead $id $head
5365 # Stuff for finding nearby tags
5366 proc getallcommits {} {
5367 global allcstart allcommits allcfd allids
5370 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5372 fconfigure $fd -blocking 0
5373 set allcommits "reading"
5378 proc discardallcommits {} {
5379 global allparents allchildren allcommits allcfd
5380 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5382 if {![info exists allcommits]} return
5383 if {$allcommits eq "reading"} {
5384 catch {close $allcfd}
5386 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5387 alldtags tagisdesc desc_heads} {
5392 proc restartgetall {fd} {
5395 fileevent $fd readable [list getallclines $fd]
5396 set allcstart [clock clicks -milliseconds]
5399 proc combine_dtags {l1 l2} {
5400 global tagisdesc notfirstd
5402 set res [lsort -unique [concat $l1 $l2]]
5403 for {set i 0} {$i < [llength $res]} {incr i} {
5404 set x [lindex $res $i]
5405 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5406 set y [lindex $res $j]
5407 if {[info exists tagisdesc($x,$y)]} {
5408 if {$tagisdesc($x,$y) > 0} {
5409 # x is a descendent of y, exclude x
5410 set res [lreplace $res $i $i]
5414 # y is a descendent of x, exclude y
5415 set res [lreplace $res $j $j]
5418 # no relation, keep going
5426 proc combine_atags {l1 l2} {
5429 set res [lsort -unique [concat $l1 $l2]]
5430 for {set i 0} {$i < [llength $res]} {incr i} {
5431 set x [lindex $res $i]
5432 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5433 set y [lindex $res $j]
5434 if {[info exists tagisdesc($x,$y)]} {
5435 if {$tagisdesc($x,$y) < 0} {
5436 # x is an ancestor of y, exclude x
5437 set res [lreplace $res $i $i]
5441 # y is an ancestor of x, exclude y
5442 set res [lreplace $res $j $j]
5445 # no relation, keep going
5453 proc forward_pass {id children} {
5454 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5458 foreach child $children {
5459 if {[info exists idtags($child)]} {
5460 set ctags [list $child]
5462 set ctags $desc_tags($child)
5466 } elseif {$ctags ne $dtags} {
5467 set dtags [combine_dtags $dtags $ctags]
5469 set cheads $desc_heads($child)
5470 if {$dheads eq {}} {
5472 } elseif {$cheads ne $dheads} {
5473 set dheads [lsort -unique [concat $dheads $cheads]]
5476 set desc_tags($id) $dtags
5477 if {[info exists idtags($id)]} {
5479 foreach tag $dtags {
5480 set adt [concat $adt $alldtags($tag)]
5482 set adt [lsort -unique $adt]
5483 set alldtags($id) $adt
5485 set tagisdesc($id,$tag) -1
5486 set tagisdesc($tag,$id) 1
5489 if {[info exists idheads($id)]} {
5490 set dheads [concat $dheads $idheads($id)]
5492 set desc_heads($id) $dheads
5495 proc getallclines {fd} {
5496 global allparents allchildren allcommits allcstart
5497 global desc_tags anc_tags idtags tagisdesc allids
5498 global idheads travindex
5500 while {[gets $fd line] >= 0} {
5501 set id [lindex $line 0]
5503 set olds [lrange $line 1 end]
5504 set allparents($id) $olds
5505 if {![info exists allchildren($id)]} {
5506 set allchildren($id) {}
5509 lappend allchildren($p) $id
5511 # compute nearest tagged descendents as we go
5512 # also compute descendent heads
5513 forward_pass $id $allchildren($id)
5514 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5515 fileevent $fd readable {}
5516 after idle restartgetall $fd
5521 set travindex [llength $allids]
5522 set allcommits "traversing"
5523 after idle restartatags
5524 if {[catch {close $fd} err]} {
5525 error_popup "Error reading full commit graph: $err.\n\
5526 Results may be incomplete."
5531 # walk backward through the tree and compute nearest tagged ancestors
5532 proc restartatags {} {
5533 global allids allparents idtags anc_tags travindex
5535 set t0 [clock clicks -milliseconds]
5537 while {[incr i -1] >= 0} {
5538 set id [lindex $allids $i]
5540 foreach p $allparents($id) {
5541 if {[info exists idtags($p)]} {
5544 set ptags $anc_tags($p)
5548 } elseif {$ptags ne $atags} {
5549 set atags [combine_atags $atags $ptags]
5552 set anc_tags($id) $atags
5553 if {[clock clicks -milliseconds] - $t0 >= 50} {
5555 after idle restartatags
5559 set allcommits "done"
5565 # update the desc_tags and anc_tags arrays for a new tag just added
5566 proc addedtag {id} {
5567 global desc_tags anc_tags allparents allchildren allcommits
5568 global idtags tagisdesc alldtags
5570 if {![info exists desc_tags($id)]} return
5571 set adt $desc_tags($id)
5572 foreach t $desc_tags($id) {
5573 set adt [concat $adt $alldtags($t)]
5575 set adt [lsort -unique $adt]
5576 set alldtags($id) $adt
5578 set tagisdesc($id,$t) -1
5579 set tagisdesc($t,$id) 1
5581 if {[info exists anc_tags($id)]} {
5582 set todo $anc_tags($id)
5583 while {$todo ne {}} {
5584 set do [lindex $todo 0]
5585 set todo [lrange $todo 1 end]
5586 if {[info exists tagisdesc($id,$do)]} continue
5587 set tagisdesc($do,$id) -1
5588 set tagisdesc($id,$do) 1
5589 if {[info exists anc_tags($do)]} {
5590 set todo [concat $todo $anc_tags($do)]
5595 set lastold $desc_tags($id)
5596 set lastnew [list $id]
5599 set todo $allparents($id)
5600 while {$todo ne {}} {
5601 set do [lindex $todo 0]
5602 set todo [lrange $todo 1 end]
5603 if {![info exists desc_tags($do)]} continue
5604 if {$desc_tags($do) ne $lastold} {
5605 set lastold $desc_tags($do)
5606 set lastnew [combine_dtags $lastold [list $id]]
5609 if {$lastold eq $lastnew} continue
5610 set desc_tags($do) $lastnew
5612 if {![info exists idtags($do)]} {
5613 set todo [concat $todo $allparents($do)]
5617 if {![info exists anc_tags($id)]} return
5618 set lastold $anc_tags($id)
5619 set lastnew [list $id]
5622 set todo $allchildren($id)
5623 while {$todo ne {}} {
5624 set do [lindex $todo 0]
5625 set todo [lrange $todo 1 end]
5626 if {![info exists anc_tags($do)]} continue
5627 if {$anc_tags($do) ne $lastold} {
5628 set lastold $anc_tags($do)
5629 set lastnew [combine_atags $lastold [list $id]]
5632 if {$lastold eq $lastnew} continue
5633 set anc_tags($do) $lastnew
5635 if {![info exists idtags($do)]} {
5636 set todo [concat $todo $allchildren($do)]
5641 # update the desc_heads array for a new head just added
5642 proc addedhead {hid head} {
5643 global desc_heads allparents headids idheads
5645 set headids($head) $hid
5646 lappend idheads($hid) $head
5648 set todo [list $hid]
5649 while {$todo ne {}} {
5650 set do [lindex $todo 0]
5651 set todo [lrange $todo 1 end]
5652 if {![info exists desc_heads($do)] ||
5653 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5654 set oldheads $desc_heads($do)
5655 lappend desc_heads($do) $head
5656 set heads $desc_heads($do)
5658 set p $allparents($do)
5659 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5660 $desc_heads($p) ne $oldheads} break
5662 set desc_heads($do) $heads
5664 set todo [concat $todo $p]
5668 # update the desc_heads array for a head just removed
5669 proc removedhead {hid head} {
5670 global desc_heads allparents headids idheads
5672 unset headids($head)
5673 if {$idheads($hid) eq $head} {
5676 set i [lsearch -exact $idheads($hid) $head]
5678 set idheads($hid) [lreplace $idheads($hid) $i $i]
5682 set todo [list $hid]
5683 while {$todo ne {}} {
5684 set do [lindex $todo 0]
5685 set todo [lrange $todo 1 end]
5686 if {![info exists desc_heads($do)]} continue
5687 set i [lsearch -exact $desc_heads($do) $head]
5688 if {$i < 0} continue
5689 set oldheads $desc_heads($do)
5690 set heads [lreplace $desc_heads($do) $i $i]
5692 set desc_heads($do) $heads
5693 set p $allparents($do)
5694 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5695 $desc_heads($p) ne $oldheads} break
5698 set todo [concat $todo $p]
5702 # update things for a head moved to a child of its previous location
5703 proc movedhead {id name} {
5704 global headids idheads
5706 set oldid $headids($name)
5707 set headids($name) $id
5708 if {$idheads($oldid) eq $name} {
5709 unset idheads($oldid)
5711 set i [lsearch -exact $idheads($oldid) $name]
5713 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5716 lappend idheads($id) $name
5719 proc changedrefs {} {
5720 global desc_heads desc_tags anc_tags allcommits allids
5721 global allchildren allparents idtags travindex
5723 if {![info exists allcommits]} return
5724 catch {unset desc_heads}
5725 catch {unset desc_tags}
5726 catch {unset anc_tags}
5727 catch {unset alldtags}
5728 catch {unset tagisdesc}
5729 foreach id $allids {
5730 forward_pass $id $allchildren($id)
5732 if {$allcommits ne "reading"} {
5733 set travindex [llength $allids]
5734 if {$allcommits ne "traversing"} {
5735 set allcommits "traversing"
5736 after idle restartatags
5741 proc rereadrefs {} {
5742 global idtags idheads idotherrefs mainhead
5744 set refids [concat [array names idtags] \
5745 [array names idheads] [array names idotherrefs]]
5746 foreach id $refids {
5747 if {![info exists ref($id)]} {
5748 set ref($id) [listrefs $id]
5751 set oldmainhead $mainhead
5754 set refids [lsort -unique [concat $refids [array names idtags] \
5755 [array names idheads] [array names idotherrefs]]]
5756 foreach id $refids {
5757 set v [listrefs $id]
5758 if {![info exists ref($id)] || $ref($id) != $v ||
5759 ($id eq $oldmainhead && $id ne $mainhead) ||
5760 ($id eq $mainhead && $id ne $oldmainhead)} {
5766 proc listrefs {id} {
5767 global idtags idheads idotherrefs
5770 if {[info exists idtags($id)]} {
5774 if {[info exists idheads($id)]} {
5778 if {[info exists idotherrefs($id)]} {
5779 set z $idotherrefs($id)
5781 return [list $x $y $z]
5784 proc showtag {tag isnew} {
5785 global ctext tagcontents tagids linknum
5788 addtohistory [list showtag $tag 0]
5790 $ctext conf -state normal
5793 if {[info exists tagcontents($tag)]} {
5794 set text $tagcontents($tag)
5796 set text "Tag: $tag\nId: $tagids($tag)"
5798 appendwithlinks $text {}
5799 $ctext conf -state disabled
5811 global maxwidth maxgraphpct diffopts
5812 global oldprefs prefstop showneartags
5813 global bgcolor fgcolor ctext diffcolors
5817 if {[winfo exists $top]} {
5821 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5822 set oldprefs($v) [set $v]
5825 wm title $top "Gitk preferences"
5826 label $top.ldisp -text "Commit list display options"
5827 grid $top.ldisp - -sticky w -pady 10
5828 label $top.spacer -text " "
5829 label $top.maxwidthl -text "Maximum graph width (lines)" \
5831 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5832 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5833 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5835 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5836 grid x $top.maxpctl $top.maxpct -sticky w
5838 label $top.ddisp -text "Diff display options"
5839 grid $top.ddisp - -sticky w -pady 10
5840 label $top.diffoptl -text "Options for diff program" \
5842 entry $top.diffopt -width 20 -textvariable diffopts
5843 grid x $top.diffoptl $top.diffopt -sticky w
5845 label $top.ntag.l -text "Display nearby tags" -font optionfont
5846 checkbutton $top.ntag.b -variable showneartags
5847 pack $top.ntag.b $top.ntag.l -side left
5848 grid x $top.ntag -sticky w
5850 label $top.cdisp -text "Colors: press to choose"
5851 grid $top.cdisp - -sticky w -pady 10
5852 label $top.bg -padx 40 -relief sunk -background $bgcolor
5853 button $top.bgbut -text "Background" -font optionfont \
5854 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5855 grid x $top.bgbut $top.bg -sticky w
5856 label $top.fg -padx 40 -relief sunk -background $fgcolor
5857 button $top.fgbut -text "Foreground" -font optionfont \
5858 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5859 grid x $top.fgbut $top.fg -sticky w
5860 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5861 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5862 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5863 [list $ctext tag conf d0 -foreground]]
5864 grid x $top.diffoldbut $top.diffold -sticky w
5865 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5866 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5867 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5868 [list $ctext tag conf d1 -foreground]]
5869 grid x $top.diffnewbut $top.diffnew -sticky w
5870 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5871 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5872 -command [list choosecolor diffcolors 2 $top.hunksep \
5873 "diff hunk header" \
5874 [list $ctext tag conf hunksep -foreground]]
5875 grid x $top.hunksepbut $top.hunksep -sticky w
5878 button $top.buts.ok -text "OK" -command prefsok
5879 button $top.buts.can -text "Cancel" -command prefscan
5880 grid $top.buts.ok $top.buts.can
5881 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5882 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5883 grid $top.buts - - -pady 10 -sticky ew
5886 proc choosecolor {v vi w x cmd} {
5889 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5890 -title "Gitk: choose color for $x"]
5891 if {$c eq {}} return
5892 $w conf -background $c
5901 $w conf -background $c
5909 $w conf -foreground $c
5911 allcanvs itemconf text -fill $c
5912 $canv itemconf circle -outline $c
5916 global maxwidth maxgraphpct diffopts
5917 global oldprefs prefstop showneartags
5919 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5920 set $v $oldprefs($v)
5922 catch {destroy $prefstop}
5927 global maxwidth maxgraphpct
5928 global oldprefs prefstop showneartags
5930 catch {destroy $prefstop}
5932 if {$maxwidth != $oldprefs(maxwidth)
5933 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5935 } elseif {$showneartags != $oldprefs(showneartags)} {
5940 proc formatdate {d} {
5941 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5944 # This list of encoding names and aliases is distilled from
5945 # http://www.iana.org/assignments/character-sets.
5946 # Not all of them are supported by Tcl.
5947 set encoding_aliases {
5948 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5949 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5950 { ISO-10646-UTF-1 csISO10646UTF1 }
5951 { ISO_646.basic:1983 ref csISO646basic1983 }
5952 { INVARIANT csINVARIANT }
5953 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5954 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5955 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5956 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5957 { NATS-DANO iso-ir-9-1 csNATSDANO }
5958 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5959 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5960 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5961 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5962 { ISO-2022-KR csISO2022KR }
5964 { ISO-2022-JP csISO2022JP }
5965 { ISO-2022-JP-2 csISO2022JP2 }
5966 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5968 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5969 { IT iso-ir-15 ISO646-IT csISO15Italian }
5970 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5971 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5972 { greek7-old iso-ir-18 csISO18Greek7Old }
5973 { latin-greek iso-ir-19 csISO19LatinGreek }
5974 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5975 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5976 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5977 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5978 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5979 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5980 { INIS iso-ir-49 csISO49INIS }
5981 { INIS-8 iso-ir-50 csISO50INIS8 }
5982 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5983 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5984 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5985 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5986 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5987 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5989 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5990 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5991 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5992 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5993 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5994 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5995 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5996 { greek7 iso-ir-88 csISO88Greek7 }
5997 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5998 { iso-ir-90 csISO90 }
5999 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6000 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6001 csISO92JISC62991984b }
6002 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6003 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6004 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6005 csISO95JIS62291984handadd }
6006 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6007 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6008 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6009 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6011 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6012 { T.61-7bit iso-ir-102 csISO102T617bit }
6013 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6014 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6015 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6016 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6017 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6018 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6019 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6020 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6021 arabic csISOLatinArabic }
6022 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6023 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6024 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6025 greek greek8 csISOLatinGreek }
6026 { T.101-G2 iso-ir-128 csISO128T101G2 }
6027 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6029 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6030 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6031 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6032 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6033 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6034 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6035 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6036 csISOLatinCyrillic }
6037 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6038 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6039 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6040 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6041 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6042 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6043 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6044 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6045 { ISO_10367-box iso-ir-155 csISO10367Box }
6046 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6047 { latin-lap lap iso-ir-158 csISO158Lap }
6048 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6049 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6052 { JIS_X0201 X0201 csHalfWidthKatakana }
6053 { KSC5636 ISO646-KR csKSC5636 }
6054 { ISO-10646-UCS-2 csUnicode }
6055 { ISO-10646-UCS-4 csUCS4 }
6056 { DEC-MCS dec csDECMCS }
6057 { hp-roman8 roman8 r8 csHPRoman8 }
6058 { macintosh mac csMacintosh }
6059 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6061 { IBM038 EBCDIC-INT cp038 csIBM038 }
6062 { IBM273 CP273 csIBM273 }
6063 { IBM274 EBCDIC-BE CP274 csIBM274 }
6064 { IBM275 EBCDIC-BR cp275 csIBM275 }
6065 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6066 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6067 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6068 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6069 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6070 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6071 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6072 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6073 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6074 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6075 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6076 { IBM437 cp437 437 csPC8CodePage437 }
6077 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6078 { IBM775 cp775 csPC775Baltic }
6079 { IBM850 cp850 850 csPC850Multilingual }
6080 { IBM851 cp851 851 csIBM851 }
6081 { IBM852 cp852 852 csPCp852 }
6082 { IBM855 cp855 855 csIBM855 }
6083 { IBM857 cp857 857 csIBM857 }
6084 { IBM860 cp860 860 csIBM860 }
6085 { IBM861 cp861 861 cp-is csIBM861 }
6086 { IBM862 cp862 862 csPC862LatinHebrew }
6087 { IBM863 cp863 863 csIBM863 }
6088 { IBM864 cp864 csIBM864 }
6089 { IBM865 cp865 865 csIBM865 }
6090 { IBM866 cp866 866 csIBM866 }
6091 { IBM868 CP868 cp-ar csIBM868 }
6092 { IBM869 cp869 869 cp-gr csIBM869 }
6093 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6094 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6095 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6096 { IBM891 cp891 csIBM891 }
6097 { IBM903 cp903 csIBM903 }
6098 { IBM904 cp904 904 csIBBM904 }
6099 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6100 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6101 { IBM1026 CP1026 csIBM1026 }
6102 { EBCDIC-AT-DE csIBMEBCDICATDE }
6103 { EBCDIC-AT-DE-A csEBCDICATDEA }
6104 { EBCDIC-CA-FR csEBCDICCAFR }
6105 { EBCDIC-DK-NO csEBCDICDKNO }
6106 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6107 { EBCDIC-FI-SE csEBCDICFISE }
6108 { EBCDIC-FI-SE-A csEBCDICFISEA }
6109 { EBCDIC-FR csEBCDICFR }
6110 { EBCDIC-IT csEBCDICIT }
6111 { EBCDIC-PT csEBCDICPT }
6112 { EBCDIC-ES csEBCDICES }
6113 { EBCDIC-ES-A csEBCDICESA }
6114 { EBCDIC-ES-S csEBCDICESS }
6115 { EBCDIC-UK csEBCDICUK }
6116 { EBCDIC-US csEBCDICUS }
6117 { UNKNOWN-8BIT csUnknown8BiT }
6118 { MNEMONIC csMnemonic }
6123 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6124 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6125 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6126 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6127 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6128 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6129 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6130 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6131 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6132 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6133 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6134 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6135 { IBM1047 IBM-1047 }
6136 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6137 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6138 { UNICODE-1-1 csUnicode11 }
6141 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6142 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6144 { ISO-8859-15 ISO_8859-15 Latin-9 }
6145 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6146 { GBK CP936 MS936 windows-936 }
6147 { JIS_Encoding csJISEncoding }
6148 { Shift_JIS MS_Kanji csShiftJIS }
6149 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6151 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6152 { ISO-10646-UCS-Basic csUnicodeASCII }
6153 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6154 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6155 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6156 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6157 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6158 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6159 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6160 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6161 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6162 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6163 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6164 { Ventura-US csVenturaUS }
6165 { Ventura-International csVenturaInternational }
6166 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6167 { PC8-Turkish csPC8Turkish }
6168 { IBM-Symbols csIBMSymbols }
6169 { IBM-Thai csIBMThai }
6170 { HP-Legal csHPLegal }
6171 { HP-Pi-font csHPPiFont }
6172 { HP-Math8 csHPMath8 }
6173 { Adobe-Symbol-Encoding csHPPSMath }
6174 { HP-DeskTop csHPDesktop }
6175 { Ventura-Math csVenturaMath }
6176 { Microsoft-Publishing csMicrosoftPublishing }
6177 { Windows-31J csWindows31J }
6182 proc tcl_encoding {enc} {
6183 global encoding_aliases
6184 set names [encoding names]
6185 set lcnames [string tolower $names]
6186 set enc [string tolower $enc]
6187 set i [lsearch -exact $lcnames $enc]
6189 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6190 if {[regsub {^iso[-_]} $enc iso encx]} {
6191 set i [lsearch -exact $lcnames $encx]
6195 foreach l $encoding_aliases {
6196 set ll [string tolower $l]
6197 if {[lsearch -exact $ll $enc] < 0} continue
6198 # look through the aliases for one that tcl knows about
6200 set i [lsearch -exact $lcnames $e]
6202 if {[regsub {^iso[-_]} $e iso ex]} {
6203 set i [lsearch -exact $lcnames $ex]
6212 return [lindex $names $i]
6219 set diffopts "-U 5 -p"
6220 set wrcomcmd "git diff-tree --stdin -p --pretty"
6224 set gitencoding [exec git config --get i18n.commitencoding]
6226 if {$gitencoding == ""} {
6227 set gitencoding "utf-8"
6229 set tclencoding [tcl_encoding $gitencoding]
6230 if {$tclencoding == {}} {
6231 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6234 set mainfont {Helvetica 9}
6235 set textfont {Courier 9}
6236 set uifont {Helvetica 9 bold}
6237 set findmergefiles 0
6245 set cmitmode "patch"
6246 set wrapcomment "none"
6249 set colors {green red blue magenta darkgrey brown orange}
6252 set diffcolors {red "#00a000" blue}
6254 catch {source ~/.gitk}
6256 font create optionfont -family sans-serif -size -12
6260 switch -regexp -- $arg {
6262 "^-d" { set datemode 1 }
6264 lappend revtreeargs $arg
6269 # check that we can find a .git directory somewhere...
6271 if {![file isdirectory $gitdir]} {
6272 show_error {} . "Cannot find the git directory \"$gitdir\"."
6276 set cmdline_files {}
6277 set i [lsearch -exact $revtreeargs "--"]
6279 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6280 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6281 } elseif {$revtreeargs ne {}} {
6283 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6284 set cmdline_files [split $f "\n"]
6285 set n [llength $cmdline_files]
6286 set revtreeargs [lrange $revtreeargs 0 end-$n]
6288 # unfortunately we get both stdout and stderr in $err,
6289 # so look for "fatal:".
6290 set i [string first "fatal:" $err]
6292 set err [string range $err [expr {$i + 6}] end]
6294 show_error {} . "Bad arguments to gitk:\n$err"
6303 set highlight_paths {}
6304 set searchdirn -forwards
6313 set selectedhlview None
6324 wm title . "[file tail $argv0]: [file tail [pwd]]"
6327 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6328 # create a view for the files/dirs specified on the command line
6332 set viewname(1) "Command line"
6333 set viewfiles(1) $cmdline_files
6334 set viewargs(1) $revtreeargs
6337 .bar.view entryconf Edit* -state normal
6338 .bar.view entryconf Delete* -state normal
6341 if {[info exists permviews]} {
6342 foreach v $permviews {
6345 set viewname($n) [lindex $v 0]
6346 set viewfiles($n) [lindex $v 1]
6347 set viewargs($n) [lindex $v 2]