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 .bright.mode.
patch configure
-font $uifont
652 radiobutton .bright.mode.tree
-text "Tree" \
653 -command reselectline
-variable cmitmode
-value "tree"
654 .bright.mode.tree configure
-font $uifont
655 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
656 pack .bright.mode
-side top
-fill x
657 set cflist .bright.cfiles
658 set indent
[font measure
$mainfont "nn"]
660 -background $bgcolor -foreground $fgcolor \
662 -tabs [list
$indent [expr {2 * $indent}]] \
663 -yscrollcommand ".bright.sb set" \
664 -cursor [. cget
-cursor] \
665 -spacing1 1 -spacing3 1
666 lappend bglist
$cflist
667 lappend fglist
$cflist
668 scrollbar .bright.sb
-command "$cflist yview"
669 pack .bright.sb
-side right
-fill y
670 pack
$cflist -side left
-fill both
-expand 1
671 $cflist tag configure highlight \
672 -background [$cflist cget
-selectbackground]
673 $cflist tag configure bold
-font [concat
$mainfont bold
]
675 .pwbottom add .bright
678 # restore window position if known
679 if {[info exists geometry
(main
)]} {
680 wm geometry .
"$geometry(main)"
683 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
684 pack .ctop
-fill both
-expand 1
685 bindall
<1> {selcanvline
%W
%x
%y
}
686 #bindall <B1-Motion> {selcanvline %W %x %y}
687 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
688 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
689 bindall
<2> "canvscan mark %W %x %y"
690 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
691 bindkey
<Home
> selfirstline
692 bindkey
<End
> sellastline
693 bind .
<Key-Up
> "selnextline -1"
694 bind .
<Key-Down
> "selnextline 1"
695 bind .
<Shift-Key-Up
> "next_highlight -1"
696 bind .
<Shift-Key-Down
> "next_highlight 1"
697 bindkey
<Key-Right
> "goforw"
698 bindkey
<Key-Left
> "goback"
699 bind .
<Key-Prior
> "selnextpage -1"
700 bind .
<Key-Next
> "selnextpage 1"
701 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
702 bind .
<Control-End
> "allcanvs yview moveto 1.0"
703 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
704 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
705 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
706 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
707 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
708 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
709 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
710 bindkey p
"selnextline -1"
711 bindkey n
"selnextline 1"
714 bindkey i
"selnextline -1"
715 bindkey k
"selnextline 1"
718 bindkey b
"$ctext yview scroll -1 pages"
719 bindkey d
"$ctext yview scroll 18 units"
720 bindkey u
"$ctext yview scroll -18 units"
721 bindkey
/ {findnext
1}
722 bindkey
<Key-Return
> {findnext
0}
725 bindkey
<F5
> updatecommits
726 bind .
<Control-q
> doquit
727 bind .
<Control-f
> dofind
728 bind .
<Control-g
> {findnext
0}
729 bind .
<Control-r
> dosearchback
730 bind .
<Control-s
> dosearch
731 bind .
<Control-equal
> {incrfont
1}
732 bind .
<Control-KP_Add
> {incrfont
1}
733 bind .
<Control-minus
> {incrfont
-1}
734 bind .
<Control-KP_Subtract
> {incrfont
-1}
735 wm protocol . WM_DELETE_WINDOW doquit
736 bind .
<Button-1
> "click %W"
737 bind $fstring <Key-Return
> dofind
738 bind $sha1entry <Key-Return
> gotocommit
739 bind $sha1entry <<PasteSelection>> clearsha1
740 bind $cflist <1> {sel_flist %W %x %y; break}
741 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
742 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
744 set maincursor [. cget -cursor]
745 set textcursor [$ctext cget -cursor]
746 set curtextcursor $textcursor
748 set rowctxmenu .rowctxmenu
749 menu $rowctxmenu -tearoff 0
750 $rowctxmenu add command -label "Diff this -> selected" \
751 -command {diffvssel 0}
752 $rowctxmenu add command -label "Diff selected -> this" \
753 -command {diffvssel 1}
754 $rowctxmenu add command -label "Make patch" -command mkpatch
755 $rowctxmenu add command -label "Create tag" -command mktag
756 $rowctxmenu add command -label "Write commit to file" -command writecommit
757 $rowctxmenu add command -label "Create new branch" -command mkbranch
758 $rowctxmenu add command -label "Cherry-pick this commit" \
761 set headctxmenu .headctxmenu
762 menu $headctxmenu -tearoff 0
763 $headctxmenu add command -label "Check out this branch" \
765 $headctxmenu add command -label "Remove this branch" \
769 # mouse-2 makes all windows scan vertically, but only the one
770 # the cursor is in scans horizontally
771 proc canvscan {op w x y} {
772 global canv canv2 canv3
773 foreach c [list $canv $canv2 $canv3] {
782 proc scrollcanv {cscroll f0 f1} {
788 # when we make a key binding for the toplevel, make sure
789 # it doesn't get triggered when that key is pressed in the
790 # find string entry widget.
791 proc bindkey {ev script} {
794 set escript [bind Entry $ev]
795 if {$escript == {}} {
796 set escript [bind Entry <Key>]
799 bind $e $ev "$escript; break"
803 # set the focus back to the toplevel for any click outside
814 global canv canv2 canv3 ctext cflist mainfont textfont uifont
815 global stuffsaved findmergefiles maxgraphpct
816 global maxwidth showneartags
817 global viewname viewfiles viewargs viewperm nextviewnum
818 global cmitmode wrapcomment
819 global colors bgcolor fgcolor diffcolors
821 if {$stuffsaved} return
822 if {![winfo viewable .]} return
824 set f [open "~/.gitk-new" w]
825 puts $f [list set mainfont $mainfont]
826 puts $f [list set textfont $textfont]
827 puts $f [list set uifont $uifont]
828 puts $f [list set findmergefiles $findmergefiles]
829 puts $f [list set maxgraphpct $maxgraphpct]
830 puts $f [list set maxwidth $maxwidth]
831 puts $f [list set cmitmode $cmitmode]
832 puts $f [list set wrapcomment $wrapcomment]
833 puts $f [list set showneartags $showneartags]
834 puts $f [list set bgcolor $bgcolor]
835 puts $f [list set fgcolor $fgcolor]
836 puts $f [list set colors $colors]
837 puts $f [list set diffcolors $diffcolors]
839 puts $f "set geometry(main) [wm geometry .]"
840 puts $f "set geometry(topwidth) [winfo width .tf]"
841 puts $f "set geometry(topheight) [winfo height .tf]"
842 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
843 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
844 puts $f "set geometry(botwidth) [winfo width .bleft]"
845 puts $f "set geometry(botheight) [winfo height .bleft]"
847 puts -nonewline $f "set permviews {"
848 for {set v 0} {$v < $nextviewnum} {incr v} {
850 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
855 file rename -force "~/.gitk-new" "~/.gitk"
860 proc resizeclistpanes {win w} {
862 if {[info exists oldwidth($win)]} {
863 set s0 [$win sash coord 0]
864 set s1 [$win sash coord 1]
866 set sash0 [expr {int($w/2 - 2)}]
867 set sash1 [expr {int($w*5/6 - 2)}]
869 set factor [expr {1.0 * $w / $oldwidth($win)}]
870 set sash0 [expr {int($factor * [lindex $s0 0])}]
871 set sash1 [expr {int($factor * [lindex $s1 0])}]
875 if {$sash1 < $sash0 + 20} {
876 set sash1 [expr {$sash0 + 20}]
878 if {$sash1 > $w - 10} {
879 set sash1 [expr {$w - 10}]
880 if {$sash0 > $sash1 - 20} {
881 set sash0 [expr {$sash1 - 20}]
885 $win sash place 0 $sash0 [lindex $s0 1]
886 $win sash place 1 $sash1 [lindex $s1 1]
888 set oldwidth($win) $w
891 proc resizecdetpanes {win w} {
893 if {[info exists oldwidth($win)]} {
894 set s0 [$win sash coord 0]
896 set sash0 [expr {int($w*3/4 - 2)}]
898 set factor [expr {1.0 * $w / $oldwidth($win)}]
899 set sash0 [expr {int($factor * [lindex $s0 0])}]
903 if {$sash0 > $w - 15} {
904 set sash0 [expr {$w - 15}]
907 $win sash place 0 $sash0 [lindex $s0 1]
909 set oldwidth($win) $w
913 global canv canv2 canv3
919 proc bindall {event action} {
920 global canv canv2 canv3
921 bind $canv $event $action
922 bind $canv2 $event $action
923 bind $canv3 $event $action
929 if {[winfo exists $w]} {
934 wm title $w "About gitk"
936 Gitk - a commit viewer for git
938 Copyright © 2005-2006 Paul Mackerras
940 Use and redistribute under the terms of the GNU General Public License} \
941 -justify center -aspect 400 -border 2 -bg white -relief groove
942 pack $w.m -side top -fill x -padx 2 -pady 2
943 $w.m configure -font $uifont
944 button $w.ok -text Close -command "destroy $w" -default active
945 pack $w.ok -side bottom
946 $w.ok configure -font $uifont
947 bind $w <Visibility> "focus $w.ok"
948 bind $w <Key-Escape> "destroy $w"
949 bind $w <Key-Return> "destroy $w"
955 if {[winfo exists $w]} {
960 wm title $w "Gitk key bindings"
965 <Home> Move to first commit
966 <End> Move to last commit
967 <Up>, p, i Move up one commit
968 <Down>, n, k Move down one commit
969 <Left>, z, j Go back in history list
970 <Right>, x, l Go forward in history list
971 <PageUp> Move up one page in commit list
972 <PageDown> Move down one page in commit list
973 <Ctrl-Home> Scroll to top of commit list
974 <Ctrl-End> Scroll to bottom of commit list
975 <Ctrl-Up> Scroll commit list up one line
976 <Ctrl-Down> Scroll commit list down one line
977 <Ctrl-PageUp> Scroll commit list up one page
978 <Ctrl-PageDown> Scroll commit list down one page
979 <Shift-Up> Move to previous highlighted line
980 <Shift-Down> Move to next highlighted line
981 <Delete>, b Scroll diff view up one page
982 <Backspace> Scroll diff view up one page
983 <Space> Scroll diff view down one page
984 u Scroll diff view up 18 lines
985 d Scroll diff view down 18 lines
987 <Ctrl-G> Move to next find hit
988 <Return> Move to next find hit
989 / Move to next find hit, or redo find
990 ? Move to previous find hit
991 f Scroll diff view to next file
992 <Ctrl-S> Search for next hit in diff view
993 <Ctrl-R> Search for previous hit in diff view
994 <Ctrl-KP+> Increase font size
995 <Ctrl-plus> Increase font size
996 <Ctrl-KP-> Decrease font size
997 <Ctrl-minus> Decrease font size
1000 -justify left -bg white -border 2 -relief groove
1001 pack $w.m -side top -fill both -padx 2 -pady 2
1002 $w.m configure -font $uifont
1003 button $w.ok -text Close -command "destroy $w" -default active
1004 pack $w.ok -side bottom
1005 $w.ok configure -font $uifont
1006 bind $w <Visibility> "focus $w.ok"
1007 bind $w <Key-Escape> "destroy $w"
1008 bind $w <Key-Return> "destroy $w"
1011 # Procedures for manipulating the file list window at the
1012 # bottom right of the overall window.
1014 proc treeview {w l openlevs} {
1015 global treecontents treediropen treeheight treeparent treeindex
1025 set treecontents() {}
1026 $w conf -state normal
1028 while {[string range $f 0 $prefixend] ne $prefix} {
1029 if {$lev <= $openlevs} {
1030 $w mark set e:$treeindex($prefix) "end -1c"
1031 $w mark gravity e:$treeindex($prefix) left
1033 set treeheight($prefix) $ht
1034 incr ht [lindex $htstack end]
1035 set htstack [lreplace $htstack end end]
1036 set prefixend [lindex $prefendstack end]
1037 set prefendstack [lreplace $prefendstack end end]
1038 set prefix [string range $prefix 0 $prefixend]
1041 set tail [string range $f [expr {$prefixend+1}] end]
1042 while {[set slash [string first "/" $tail]] >= 0} {
1045 lappend prefendstack $prefixend
1046 incr prefixend [expr {$slash + 1}]
1047 set d [string range $tail 0 $slash]
1048 lappend treecontents($prefix) $d
1049 set oldprefix $prefix
1051 set treecontents($prefix) {}
1052 set treeindex($prefix) [incr ix]
1053 set treeparent($prefix) $oldprefix
1054 set tail [string range $tail [expr {$slash+1}] end]
1055 if {$lev <= $openlevs} {
1057 set treediropen($prefix) [expr {$lev < $openlevs}]
1058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1059 $w mark set d:$ix "end -1c"
1060 $w mark gravity d:$ix left
1062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1064 $w image create end -align center -image $bm -padx 1 \
1066 $w insert end $d [highlight_tag $prefix]
1067 $w mark set s:$ix "end -1c"
1068 $w mark gravity s:$ix left
1073 if {$lev <= $openlevs} {
1076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1078 $w insert end $tail [highlight_tag $f]
1080 lappend treecontents($prefix) $tail
1083 while {$htstack ne {}} {
1084 set treeheight($prefix) $ht
1085 incr ht [lindex $htstack end]
1086 set htstack [lreplace $htstack end end]
1088 $w conf -state disabled
1091 proc linetoelt {l} {
1092 global treeheight treecontents
1097 foreach e $treecontents($prefix) {
1102 if {[string index $e end] eq "/"} {
1103 set n $treeheight($prefix$e)
1115 proc highlight_tree {y prefix} {
1116 global treeheight treecontents cflist
1118 foreach e $treecontents($prefix) {
1120 if {[highlight_tag $path] ne {}} {
1121 $cflist tag add bold $y.0 "$y.0 lineend"
1124 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1125 set y [highlight_tree $y $path]
1131 proc treeclosedir {w dir} {
1132 global treediropen treeheight treeparent treeindex
1134 set ix $treeindex($dir)
1135 $w conf -state normal
1136 $w delete s:$ix e:$ix
1137 set treediropen($dir) 0
1138 $w image configure a:$ix -image tri-rt
1139 $w conf -state disabled
1140 set n [expr {1 - $treeheight($dir)}]
1141 while {$dir ne {}} {
1142 incr treeheight($dir) $n
1143 set dir $treeparent($dir)
1147 proc treeopendir {w dir} {
1148 global treediropen treeheight treeparent treecontents treeindex
1150 set ix $treeindex($dir)
1151 $w conf -state normal
1152 $w image configure a:$ix -image tri-dn
1153 $w mark set e:$ix s:$ix
1154 $w mark gravity e:$ix right
1157 set n [llength $treecontents($dir)]
1158 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1161 incr treeheight($x) $n
1163 foreach e $treecontents($dir) {
1165 if {[string index $e end] eq "/"} {
1166 set iy $treeindex($de)
1167 $w mark set d:$iy e:$ix
1168 $w mark gravity d:$iy left
1169 $w insert e:$ix $str
1170 set treediropen($de) 0
1171 $w image create e:$ix -align center -image tri-rt -padx 1 \
1173 $w insert e:$ix $e [highlight_tag $de]
1174 $w mark set s:$iy e:$ix
1175 $w mark gravity s:$iy left
1176 set treeheight($de) 1
1178 $w insert e:$ix $str
1179 $w insert e:$ix $e [highlight_tag $de]
1182 $w mark gravity e:$ix left
1183 $w conf -state disabled
1184 set treediropen($dir) 1
1185 set top [lindex [split [$w index @0,0] .] 0]
1186 set ht [$w cget -height]
1187 set l [lindex [split [$w index s:$ix] .] 0]
1190 } elseif {$l + $n + 1 > $top + $ht} {
1191 set top [expr {$l + $n + 2 - $ht}]
1199 proc treeclick {w x y} {
1200 global treediropen cmitmode ctext cflist cflist_top
1202 if {$cmitmode ne "tree"} return
1203 if {![info exists cflist_top]} return
1204 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1205 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1206 $cflist tag add highlight $l.0 "$l.0 lineend"
1212 set e [linetoelt $l]
1213 if {[string index $e end] ne "/"} {
1215 } elseif {$treediropen($e)} {
1222 proc setfilelist {id} {
1223 global treefilelist cflist
1225 treeview $cflist $treefilelist($id) 0
1228 image create bitmap tri-rt -background black -foreground blue -data {
1229 #define tri-rt_width 13
1230 #define tri-rt_height 13
1231 static unsigned char tri-rt_bits[] = {
1232 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1233 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1236 #define tri-rt-mask_width 13
1237 #define tri-rt-mask_height 13
1238 static unsigned char tri-rt-mask_bits[] = {
1239 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1240 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1243 image create bitmap tri-dn -background black -foreground blue -data {
1244 #define tri-dn_width 13
1245 #define tri-dn_height 13
1246 static unsigned char tri-dn_bits[] = {
1247 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1248 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1251 #define tri-dn-mask_width 13
1252 #define tri-dn-mask_height 13
1253 static unsigned char tri-dn-mask_bits[] = {
1254 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1255 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1259 proc init_flist {first} {
1260 global cflist cflist_top selectedline difffilestart
1262 $cflist conf -state normal
1263 $cflist delete 0.0 end
1265 $cflist insert end $first
1267 $cflist tag add highlight 1.0 "1.0 lineend"
1269 catch {unset cflist_top}
1271 $cflist conf -state disabled
1272 set difffilestart {}
1275 proc highlight_tag {f} {
1276 global highlight_paths
1278 foreach p $highlight_paths {
1279 if {[string match $p $f]} {
1286 proc highlight_filelist {} {
1287 global cmitmode cflist
1289 $cflist conf -state normal
1290 if {$cmitmode ne "tree"} {
1291 set end [lindex [split [$cflist index end] .] 0]
1292 for {set l 2} {$l < $end} {incr l} {
1293 set line [$cflist get $l.0 "$l.0 lineend"]
1294 if {[highlight_tag $line] ne {}} {
1295 $cflist tag add bold $l.0 "$l.0 lineend"
1301 $cflist conf -state disabled
1304 proc unhighlight_filelist {} {
1307 $cflist conf -state normal
1308 $cflist tag remove bold 1.0 end
1309 $cflist conf -state disabled
1312 proc add_flist {fl} {
1315 $cflist conf -state normal
1317 $cflist insert end "\n"
1318 $cflist insert end $f [highlight_tag $f]
1320 $cflist conf -state disabled
1323 proc sel_flist {w x y} {
1324 global ctext difffilestart cflist cflist_top cmitmode
1326 if {$cmitmode eq "tree"} return
1327 if {![info exists cflist_top]} return
1328 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1329 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1330 $cflist tag add highlight $l.0 "$l.0 lineend"
1335 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1339 # Functions for adding and removing shell-type quoting
1341 proc shellquote {str} {
1342 if {![string match "*\['\"\\ \t]*" $str]} {
1345 if {![string match "*\['\"\\]*" $str]} {
1348 if {![string match "*'*" $str]} {
1351 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1354 proc shellarglist {l} {
1360 append str [shellquote $a]
1365 proc shelldequote {str} {
1370 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1371 append ret [string range $str $used end]
1372 set used [string length $str]
1375 set first [lindex $first 0]
1376 set ch [string index $str $first]
1377 if {$first > $used} {
1378 append ret [string range $str $used [expr {$first - 1}]]
1381 if {$ch eq " " || $ch eq "\t"} break
1384 set first [string first "'" $str $used]
1386 error "unmatched single-quote"
1388 append ret [string range $str $used [expr {$first - 1}]]
1393 if {$used >= [string length $str]} {
1394 error "trailing backslash"
1396 append ret [string index $str $used]
1401 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1402 error "unmatched double-quote"
1404 set first [lindex $first 0]
1405 set ch [string index $str $first]
1406 if {$first > $used} {
1407 append ret [string range $str $used [expr {$first - 1}]]
1410 if {$ch eq "\""} break
1412 append ret [string index $str $used]
1416 return [list $used $ret]
1419 proc shellsplit {str} {
1422 set str [string trimleft $str]
1423 if {$str eq {}} break
1424 set dq [shelldequote $str]
1425 set n [lindex $dq 0]
1426 set word [lindex $dq 1]
1427 set str [string range $str $n end]
1433 # Code to implement multiple views
1435 proc newview {ishighlight} {
1436 global nextviewnum newviewname newviewperm uifont newishighlight
1437 global newviewargs revtreeargs
1439 set newishighlight $ishighlight
1441 if {[winfo exists $top]} {
1445 set newviewname($nextviewnum) "View $nextviewnum"
1446 set newviewperm($nextviewnum) 0
1447 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1448 vieweditor $top $nextviewnum "Gitk view definition"
1453 global viewname viewperm newviewname newviewperm
1454 global viewargs newviewargs
1456 set top .gitkvedit-$curview
1457 if {[winfo exists $top]} {
1461 set newviewname($curview) $viewname($curview)
1462 set newviewperm($curview) $viewperm($curview)
1463 set newviewargs($curview) [shellarglist $viewargs($curview)]
1464 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1467 proc vieweditor {top n title} {
1468 global newviewname newviewperm viewfiles
1472 wm title $top $title
1473 label $top.nl -text "Name" -font $uifont
1474 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1475 grid $top.nl $top.name -sticky w -pady 5
1476 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1478 grid $top.perm - -pady 5 -sticky w
1479 message $top.al -aspect 1000 -font $uifont \
1480 -text "Commits to include (arguments to git rev-list):"
1481 grid $top.al - -sticky w -pady 5
1482 entry $top.args -width 50 -textvariable newviewargs($n) \
1483 -background white -font $uifont
1484 grid $top.args - -sticky ew -padx 5
1485 message $top.l -aspect 1000 -font $uifont \
1486 -text "Enter files and directories to include, one per line:"
1487 grid $top.l - -sticky w
1488 text $top.t -width 40 -height 10 -background white -font $uifont
1489 if {[info exists viewfiles($n)]} {
1490 foreach f $viewfiles($n) {
1491 $top.t insert end $f
1492 $top.t insert end "\n"
1494 $top.t delete {end - 1c} end
1495 $top.t mark set insert 0.0
1497 grid $top.t - -sticky ew -padx 5
1499 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1501 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1503 grid $top.buts.ok $top.buts.can
1504 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1505 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1506 grid $top.buts - -pady 10 -sticky ew
1510 proc doviewmenu {m first cmd op argv} {
1511 set nmenu [$m index end]
1512 for {set i $first} {$i <= $nmenu} {incr i} {
1513 if {[$m entrycget $i -command] eq $cmd} {
1514 eval $m $op $i $argv
1520 proc allviewmenus {n op args} {
1523 doviewmenu .bar.view 5 [list showview $n] $op $args
1524 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1527 proc newviewok {top n} {
1528 global nextviewnum newviewperm newviewname newishighlight
1529 global viewname viewfiles viewperm selectedview curview
1530 global viewargs newviewargs viewhlmenu
1533 set newargs [shellsplit $newviewargs($n)]
1535 error_popup "Error in commit selection arguments: $err"
1541 foreach f [split [$top.t get 0.0 end] "\n"] {
1542 set ft [string trim $f]
1547 if {![info exists viewfiles($n)]} {
1548 # creating a new view
1550 set viewname($n) $newviewname($n)
1551 set viewperm($n) $newviewperm($n)
1552 set viewfiles($n) $files
1553 set viewargs($n) $newargs
1555 if {!$newishighlight} {
1556 after idle showview $n
1558 after idle addvhighlight $n
1561 # editing an existing view
1562 set viewperm($n) $newviewperm($n)
1563 if {$newviewname($n) ne $viewname($n)} {
1564 set viewname($n) $newviewname($n)
1565 doviewmenu .bar.view 5 [list showview $n] \
1566 entryconf [list -label $viewname($n)]
1567 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1568 entryconf [list -label $viewname($n) -value $viewname($n)]
1570 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1571 set viewfiles($n) $files
1572 set viewargs($n) $newargs
1573 if {$curview == $n} {
1574 after idle updatecommits
1578 catch {destroy $top}
1582 global curview viewdata viewperm hlview selectedhlview
1584 if {$curview == 0} return
1585 if {[info exists hlview] && $hlview == $curview} {
1586 set selectedhlview None
1589 allviewmenus $curview delete
1590 set viewdata($curview) {}
1591 set viewperm($curview) 0
1595 proc addviewmenu {n} {
1596 global viewname viewhlmenu
1598 .bar.view add radiobutton -label $viewname($n) \
1599 -command [list showview $n] -variable selectedview -value $n
1600 $viewhlmenu add radiobutton -label $viewname($n) \
1601 -command [list addvhighlight $n] -variable selectedhlview
1604 proc flatten {var} {
1608 foreach i [array names $var] {
1609 lappend ret $i [set $var\($i\)]
1614 proc unflatten {var l} {
1624 global curview viewdata viewfiles
1625 global displayorder parentlist childlist rowidlist rowoffsets
1626 global colormap rowtextx commitrow nextcolor canvxmax
1627 global numcommits rowrangelist commitlisted idrowranges
1628 global selectedline currentid canv canvy0
1629 global matchinglines treediffs
1630 global pending_select phase
1631 global commitidx rowlaidout rowoptim linesegends
1632 global commfd nextupdate
1634 global vparentlist vchildlist vdisporder vcmitlisted
1635 global hlview selectedhlview
1637 if {$n == $curview} return
1639 if {[info exists selectedline]} {
1640 set selid $currentid
1641 set y [yc $selectedline]
1642 set ymax [lindex [$canv cget -scrollregion] 3]
1643 set span [$canv yview]
1644 set ytop [expr {[lindex $span 0] * $ymax}]
1645 set ybot [expr {[lindex $span 1] * $ymax}]
1646 if {$ytop < $y && $y < $ybot} {
1647 set yscreen [expr {$y - $ytop}]
1649 set yscreen [expr {($ybot - $ytop) / 2}]
1655 if {$curview >= 0} {
1656 set vparentlist($curview) $parentlist
1657 set vchildlist($curview) $childlist
1658 set vdisporder($curview) $displayorder
1659 set vcmitlisted($curview) $commitlisted
1661 set viewdata($curview) \
1662 [list $phase $rowidlist $rowoffsets $rowrangelist \
1663 [flatten idrowranges] [flatten idinlist] \
1664 $rowlaidout $rowoptim $numcommits $linesegends]
1665 } elseif {![info exists viewdata($curview)]
1666 || [lindex $viewdata($curview) 0] ne {}} {
1667 set viewdata($curview) \
1668 [list {} $rowidlist $rowoffsets $rowrangelist]
1671 catch {unset matchinglines}
1672 catch {unset treediffs}
1674 if {[info exists hlview] && $hlview == $n} {
1676 set selectedhlview None
1681 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1682 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1684 if {![info exists viewdata($n)]} {
1685 set pending_select $selid
1691 set phase [lindex $v 0]
1692 set displayorder $vdisporder($n)
1693 set parentlist $vparentlist($n)
1694 set childlist $vchildlist($n)
1695 set commitlisted $vcmitlisted($n)
1696 set rowidlist [lindex $v 1]
1697 set rowoffsets [lindex $v 2]
1698 set rowrangelist [lindex $v 3]
1700 set numcommits [llength $displayorder]
1701 catch {unset idrowranges}
1703 unflatten idrowranges [lindex $v 4]
1704 unflatten idinlist [lindex $v 5]
1705 set rowlaidout [lindex $v 6]
1706 set rowoptim [lindex $v 7]
1707 set numcommits [lindex $v 8]
1708 set linesegends [lindex $v 9]
1711 catch {unset colormap}
1712 catch {unset rowtextx}
1714 set canvxmax [$canv cget -width]
1720 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1721 set row $commitrow($n,$selid)
1722 # try to get the selected row in the same position on the screen
1723 set ymax [lindex [$canv cget -scrollregion] 3]
1724 set ytop [expr {[yc $row] - $yscreen}]
1728 set yf [expr {$ytop * 1.0 / $ymax}]
1730 allcanvs yview moveto $yf
1734 if {$phase eq "getcommits"} {
1735 show_status "Reading commits..."
1737 if {[info exists commfd($n)]} {
1742 } elseif {$numcommits == 0} {
1743 show_status "No commits selected"
1747 # Stuff relating to the highlighting facility
1749 proc ishighlighted {row} {
1750 global vhighlights fhighlights nhighlights rhighlights
1752 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1753 return $nhighlights($row)
1755 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1756 return $vhighlights($row)
1758 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1759 return $fhighlights($row)
1761 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1762 return $rhighlights($row)
1767 proc bolden {row font} {
1768 global canv linehtag selectedline boldrows
1770 lappend boldrows $row
1771 $canv itemconf $linehtag($row) -font $font
1772 if {[info exists selectedline] && $row == $selectedline} {
1774 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1775 -outline {{}} -tags secsel \
1776 -fill [$canv cget -selectbackground]]
1781 proc bolden_name {row font} {
1782 global canv2 linentag selectedline boldnamerows
1784 lappend boldnamerows $row
1785 $canv2 itemconf $linentag($row) -font $font
1786 if {[info exists selectedline] && $row == $selectedline} {
1787 $canv2 delete secsel
1788 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1789 -outline {{}} -tags secsel \
1790 -fill [$canv2 cget -selectbackground]]
1796 global mainfont boldrows
1799 foreach row $boldrows {
1800 if {![ishighlighted $row]} {
1801 bolden $row $mainfont
1803 lappend stillbold $row
1806 set boldrows $stillbold
1809 proc addvhighlight {n} {
1810 global hlview curview viewdata vhl_done vhighlights commitidx
1812 if {[info exists hlview]} {
1816 if {$n != $curview && ![info exists viewdata($n)]} {
1817 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1818 set vparentlist($n) {}
1819 set vchildlist($n) {}
1820 set vdisporder($n) {}
1821 set vcmitlisted($n) {}
1824 set vhl_done $commitidx($hlview)
1825 if {$vhl_done > 0} {
1830 proc delvhighlight {} {
1831 global hlview vhighlights
1833 if {![info exists hlview]} return
1835 catch {unset vhighlights}
1839 proc vhighlightmore {} {
1840 global hlview vhl_done commitidx vhighlights
1841 global displayorder vdisporder curview mainfont
1843 set font [concat $mainfont bold]
1844 set max $commitidx($hlview)
1845 if {$hlview == $curview} {
1846 set disp $displayorder
1848 set disp $vdisporder($hlview)
1850 set vr [visiblerows]
1851 set r0 [lindex $vr 0]
1852 set r1 [lindex $vr 1]
1853 for {set i $vhl_done} {$i < $max} {incr i} {
1854 set id [lindex $disp $i]
1855 if {[info exists commitrow($curview,$id)]} {
1856 set row $commitrow($curview,$id)
1857 if {$r0 <= $row && $row <= $r1} {
1858 if {![highlighted $row]} {
1861 set vhighlights($row) 1
1868 proc askvhighlight {row id} {
1869 global hlview vhighlights commitrow iddrawn mainfont
1871 if {[info exists commitrow($hlview,$id)]} {
1872 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1873 bolden $row [concat $mainfont bold]
1875 set vhighlights($row) 1
1877 set vhighlights($row) 0
1881 proc hfiles_change {name ix op} {
1882 global highlight_files filehighlight fhighlights fh_serial
1883 global mainfont highlight_paths
1885 if {[info exists filehighlight]} {
1886 # delete previous highlights
1887 catch {close $filehighlight}
1889 catch {unset fhighlights}
1891 unhighlight_filelist
1893 set highlight_paths {}
1894 after cancel do_file_hl $fh_serial
1896 if {$highlight_files ne {}} {
1897 after 300 do_file_hl $fh_serial
1901 proc makepatterns {l} {
1904 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1905 if {[string index $ee end] eq "/"} {
1915 proc do_file_hl {serial} {
1916 global highlight_files filehighlight highlight_paths gdttype fhl_list
1918 if {$gdttype eq "touching paths:"} {
1919 if {[catch {set paths [shellsplit $highlight_files]}]} return
1920 set highlight_paths [makepatterns $paths]
1922 set gdtargs [concat -- $paths]
1924 set gdtargs [list "-S$highlight_files"]
1926 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1927 set filehighlight [open $cmd r+]
1928 fconfigure $filehighlight -blocking 0
1929 fileevent $filehighlight readable readfhighlight
1935 proc flushhighlights {} {
1936 global filehighlight fhl_list
1938 if {[info exists filehighlight]} {
1940 puts $filehighlight ""
1941 flush $filehighlight
1945 proc askfilehighlight {row id} {
1946 global filehighlight fhighlights fhl_list
1948 lappend fhl_list $id
1949 set fhighlights($row) -1
1950 puts $filehighlight $id
1953 proc readfhighlight {} {
1954 global filehighlight fhighlights commitrow curview mainfont iddrawn
1957 while {[gets $filehighlight line] >= 0} {
1958 set line [string trim $line]
1959 set i [lsearch -exact $fhl_list $line]
1960 if {$i < 0} continue
1961 for {set j 0} {$j < $i} {incr j} {
1962 set id [lindex $fhl_list $j]
1963 if {[info exists commitrow($curview,$id)]} {
1964 set fhighlights($commitrow($curview,$id)) 0
1967 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1968 if {$line eq {}} continue
1969 if {![info exists commitrow($curview,$line)]} continue
1970 set row $commitrow($curview,$line)
1971 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1972 bolden $row [concat $mainfont bold]
1974 set fhighlights($row) 1
1976 if {[eof $filehighlight]} {
1978 puts "oops, git diff-tree died"
1979 catch {close $filehighlight}
1985 proc find_change {name ix op} {
1986 global nhighlights mainfont boldnamerows
1987 global findstring findpattern findtype
1989 # delete previous highlights, if any
1990 foreach row $boldnamerows {
1991 bolden_name $row $mainfont
1994 catch {unset nhighlights}
1996 if {$findtype ne "Regexp"} {
1997 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1999 set findpattern "*$e*"
2004 proc askfindhighlight {row id} {
2005 global nhighlights commitinfo iddrawn mainfont
2006 global findstring findtype findloc findpattern
2008 if {![info exists commitinfo($id)]} {
2011 set info $commitinfo($id)
2013 set fldtypes {Headline Author Date Committer CDate Comments}
2014 foreach f $info ty $fldtypes {
2015 if {$findloc ne "All fields" && $findloc ne $ty} {
2018 if {$findtype eq "Regexp"} {
2019 set doesmatch [regexp $findstring $f]
2020 } elseif {$findtype eq "IgnCase"} {
2021 set doesmatch [string match -nocase $findpattern $f]
2023 set doesmatch [string match $findpattern $f]
2026 if {$ty eq "Author"} {
2033 if {[info exists iddrawn($id)]} {
2034 if {$isbold && ![ishighlighted $row]} {
2035 bolden $row [concat $mainfont bold]
2038 bolden_name $row [concat $mainfont bold]
2041 set nhighlights($row) $isbold
2044 proc vrel_change {name ix op} {
2045 global highlight_related
2048 if {$highlight_related ne "None"} {
2049 after idle drawvisible
2053 # prepare for testing whether commits are descendents or ancestors of a
2054 proc rhighlight_sel {a} {
2055 global descendent desc_todo ancestor anc_todo
2056 global highlight_related rhighlights
2058 catch {unset descendent}
2059 set desc_todo [list $a]
2060 catch {unset ancestor}
2061 set anc_todo [list $a]
2062 if {$highlight_related ne "None"} {
2064 after idle drawvisible
2068 proc rhighlight_none {} {
2071 catch {unset rhighlights}
2075 proc is_descendent {a} {
2076 global curview children commitrow descendent desc_todo
2079 set la $commitrow($v,$a)
2083 for {set i 0} {$i < [llength $todo]} {incr i} {
2084 set do [lindex $todo $i]
2085 if {$commitrow($v,$do) < $la} {
2086 lappend leftover $do
2089 foreach nk $children($v,$do) {
2090 if {![info exists descendent($nk)]} {
2091 set descendent($nk) 1
2099 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2103 set descendent($a) 0
2104 set desc_todo $leftover
2107 proc is_ancestor {a} {
2108 global curview parentlist commitrow ancestor anc_todo
2111 set la $commitrow($v,$a)
2115 for {set i 0} {$i < [llength $todo]} {incr i} {
2116 set do [lindex $todo $i]
2117 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2118 lappend leftover $do
2121 foreach np [lindex $parentlist $commitrow($v,$do)] {
2122 if {![info exists ancestor($np)]} {
2131 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2136 set anc_todo $leftover
2139 proc askrelhighlight {row id} {
2140 global descendent highlight_related iddrawn mainfont rhighlights
2141 global selectedline ancestor
2143 if {![info exists selectedline]} return
2145 if {$highlight_related eq "Descendent" ||
2146 $highlight_related eq "Not descendent"} {
2147 if {![info exists descendent($id)]} {
2150 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2153 } elseif {$highlight_related eq "Ancestor" ||
2154 $highlight_related eq "Not ancestor"} {
2155 if {![info exists ancestor($id)]} {
2158 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2162 if {[info exists iddrawn($id)]} {
2163 if {$isbold && ![ishighlighted $row]} {
2164 bolden $row [concat $mainfont bold]
2167 set rhighlights($row) $isbold
2170 proc next_hlcont {} {
2171 global fhl_row fhl_dirn displayorder numcommits
2172 global vhighlights fhighlights nhighlights rhighlights
2173 global hlview filehighlight findstring highlight_related
2175 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2178 if {$row < 0 || $row >= $numcommits} {
2183 set id [lindex $displayorder $row]
2184 if {[info exists hlview]} {
2185 if {![info exists vhighlights($row)]} {
2186 askvhighlight $row $id
2188 if {$vhighlights($row) > 0} break
2190 if {$findstring ne {}} {
2191 if {![info exists nhighlights($row)]} {
2192 askfindhighlight $row $id
2194 if {$nhighlights($row) > 0} break
2196 if {$highlight_related ne "None"} {
2197 if {![info exists rhighlights($row)]} {
2198 askrelhighlight $row $id
2200 if {$rhighlights($row) > 0} break
2202 if {[info exists filehighlight]} {
2203 if {![info exists fhighlights($row)]} {
2204 # ask for a few more while we're at it...
2206 for {set n 0} {$n < 100} {incr n} {
2207 if {![info exists fhighlights($r)]} {
2208 askfilehighlight $r [lindex $displayorder $r]
2211 if {$r < 0 || $r >= $numcommits} break
2215 if {$fhighlights($row) < 0} {
2219 if {$fhighlights($row) > 0} break
2227 proc next_highlight {dirn} {
2228 global selectedline fhl_row fhl_dirn
2229 global hlview filehighlight findstring highlight_related
2231 if {![info exists selectedline]} return
2232 if {!([info exists hlview] || $findstring ne {} ||
2233 $highlight_related ne "None" || [info exists filehighlight])} return
2234 set fhl_row [expr {$selectedline + $dirn}]
2239 proc cancel_next_highlight {} {
2245 # Graph layout functions
2247 proc shortids {ids} {
2250 if {[llength $id] > 1} {
2251 lappend res [shortids $id]
2252 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2253 lappend res [string range $id 0 7]
2261 proc incrange {l x o} {
2264 set e [lindex $l $x]
2266 lset l $x [expr {$e + $o}]
2275 for {} {$n > 0} {incr n -1} {
2281 proc usedinrange {id l1 l2} {
2282 global children commitrow childlist curview
2284 if {[info exists commitrow($curview,$id)]} {
2285 set r $commitrow($curview,$id)
2286 if {$l1 <= $r && $r <= $l2} {
2287 return [expr {$r - $l1 + 1}]
2289 set kids [lindex $childlist $r]
2291 set kids $children($curview,$id)
2294 set r $commitrow($curview,$c)
2295 if {$l1 <= $r && $r <= $l2} {
2296 return [expr {$r - $l1 + 1}]
2302 proc sanity {row {full 0}} {
2303 global rowidlist rowoffsets
2306 set ids [lindex $rowidlist $row]
2309 if {$id eq {}} continue
2310 if {$col < [llength $ids] - 1 &&
2311 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2312 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2314 set o [lindex $rowoffsets $row $col]
2320 if {[lindex $rowidlist $y $x] != $id} {
2321 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2322 puts " id=[shortids $id] check started at row $row"
2323 for {set i $row} {$i >= $y} {incr i -1} {
2324 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2329 set o [lindex $rowoffsets $y $x]
2334 proc makeuparrow {oid x y z} {
2335 global rowidlist rowoffsets uparrowlen idrowranges
2337 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2340 set off0 [lindex $rowoffsets $y]
2341 for {set x0 $x} {1} {incr x0} {
2342 if {$x0 >= [llength $off0]} {
2343 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2346 set z [lindex $off0 $x0]
2352 set z [expr {$x0 - $x}]
2353 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2354 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2356 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2357 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2358 lappend idrowranges($oid) $y
2361 proc initlayout {} {
2362 global rowidlist rowoffsets displayorder commitlisted
2363 global rowlaidout rowoptim
2364 global idinlist rowchk rowrangelist idrowranges
2365 global numcommits canvxmax canv
2367 global parentlist childlist children
2368 global colormap rowtextx
2380 catch {unset idinlist}
2381 catch {unset rowchk}
2384 set canvxmax [$canv cget -width]
2385 catch {unset colormap}
2386 catch {unset rowtextx}
2387 catch {unset idrowranges}
2391 proc setcanvscroll {} {
2392 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2394 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2395 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2396 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2397 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2400 proc visiblerows {} {
2401 global canv numcommits linespc
2403 set ymax [lindex [$canv cget -scrollregion] 3]
2404 if {$ymax eq {} || $ymax == 0} return
2406 set y0 [expr {int([lindex $f 0] * $ymax)}]
2407 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2411 set y1 [expr {int([lindex $f 1] * $ymax)}]
2412 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2413 if {$r1 >= $numcommits} {
2414 set r1 [expr {$numcommits - 1}]
2416 return [list $r0 $r1]
2419 proc layoutmore {tmax} {
2420 global rowlaidout rowoptim commitidx numcommits optim_delay
2421 global uparrowlen curview
2424 if {$rowoptim - $optim_delay > $numcommits} {
2425 showstuff [expr {$rowoptim - $optim_delay}]
2426 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2427 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2431 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2433 } elseif {$commitidx($curview) > $rowlaidout} {
2434 set nr [expr {$commitidx($curview) - $rowlaidout}]
2435 # may need to increase this threshold if uparrowlen or
2436 # mingaplen are increased...
2441 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2442 if {$rowlaidout == $row} {
2448 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2454 proc showstuff {canshow} {
2455 global numcommits commitrow pending_select selectedline
2456 global linesegends idrowranges idrangedrawn curview
2458 if {$numcommits == 0} {
2460 set phase "incrdraw"
2464 set numcommits $canshow
2466 set rows [visiblerows]
2467 set r0 [lindex $rows 0]
2468 set r1 [lindex $rows 1]
2470 for {set r $row} {$r < $canshow} {incr r} {
2471 foreach id [lindex $linesegends [expr {$r+1}]] {
2473 foreach {s e} [rowranges $id] {
2475 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2476 && ![info exists idrangedrawn($id,$i)]} {
2478 set idrangedrawn($id,$i) 1
2483 if {$canshow > $r1} {
2486 while {$row < $canshow} {
2490 if {[info exists pending_select] &&
2491 [info exists commitrow($curview,$pending_select)] &&
2492 $commitrow($curview,$pending_select) < $numcommits} {
2493 selectline $commitrow($curview,$pending_select) 1
2495 if {![info exists selectedline] && ![info exists pending_select]} {
2500 proc layoutrows {row endrow last} {
2501 global rowidlist rowoffsets displayorder
2502 global uparrowlen downarrowlen maxwidth mingaplen
2503 global childlist parentlist
2504 global idrowranges linesegends
2505 global commitidx curview
2506 global idinlist rowchk rowrangelist
2508 set idlist [lindex $rowidlist $row]
2509 set offs [lindex $rowoffsets $row]
2510 while {$row < $endrow} {
2511 set id [lindex $displayorder $row]
2514 foreach p [lindex $parentlist $row] {
2515 if {![info exists idinlist($p)]} {
2517 } elseif {!$idinlist($p)} {
2522 set nev [expr {[llength $idlist] + [llength $newolds]
2523 + [llength $oldolds] - $maxwidth + 1}]
2526 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2527 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2528 set i [lindex $idlist $x]
2529 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2530 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2531 [expr {$row + $uparrowlen + $mingaplen}]]
2533 set idlist [lreplace $idlist $x $x]
2534 set offs [lreplace $offs $x $x]
2535 set offs [incrange $offs $x 1]
2537 set rm1 [expr {$row - 1}]
2539 lappend idrowranges($i) $rm1
2540 if {[incr nev -1] <= 0} break
2543 set rowchk($id) [expr {$row + $r}]
2546 lset rowidlist $row $idlist
2547 lset rowoffsets $row $offs
2549 lappend linesegends $lse
2550 set col [lsearch -exact $idlist $id]
2552 set col [llength $idlist]
2554 lset rowidlist $row $idlist
2556 if {[lindex $childlist $row] ne {}} {
2557 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2561 lset rowoffsets $row $offs
2563 makeuparrow $id $col $row $z
2569 if {[info exists idrowranges($id)]} {
2570 set ranges $idrowranges($id)
2572 unset idrowranges($id)
2574 lappend rowrangelist $ranges
2576 set offs [ntimes [llength $idlist] 0]
2577 set l [llength $newolds]
2578 set idlist [eval lreplace \$idlist $col $col $newolds]
2581 set offs [lrange $offs 0 [expr {$col - 1}]]
2582 foreach x $newolds {
2587 set tmp [expr {[llength $idlist] - [llength $offs]}]
2589 set offs [concat $offs [ntimes $tmp $o]]
2594 foreach i $newolds {
2596 set idrowranges($i) $row
2599 foreach oid $oldolds {
2600 set idinlist($oid) 1
2601 set idlist [linsert $idlist $col $oid]
2602 set offs [linsert $offs $col $o]
2603 makeuparrow $oid $col $row $o
2606 lappend rowidlist $idlist
2607 lappend rowoffsets $offs
2612 proc addextraid {id row} {
2613 global displayorder commitrow commitinfo
2614 global commitidx commitlisted
2615 global parentlist childlist children curview
2617 incr commitidx($curview)
2618 lappend displayorder $id
2619 lappend commitlisted 0
2620 lappend parentlist {}
2621 set commitrow($curview,$id) $row
2623 if {![info exists commitinfo($id)]} {
2624 set commitinfo($id) {"No commit information available"}
2626 if {![info exists children($curview,$id)]} {
2627 set children($curview,$id) {}
2629 lappend childlist $children($curview,$id)
2632 proc layouttail {} {
2633 global rowidlist rowoffsets idinlist commitidx curview
2634 global idrowranges rowrangelist
2636 set row $commitidx($curview)
2637 set idlist [lindex $rowidlist $row]
2638 while {$idlist ne {}} {
2639 set col [expr {[llength $idlist] - 1}]
2640 set id [lindex $idlist $col]
2643 lappend idrowranges($id) $row
2644 lappend rowrangelist $idrowranges($id)
2645 unset idrowranges($id)
2647 set offs [ntimes $col 0]
2648 set idlist [lreplace $idlist $col $col]
2649 lappend rowidlist $idlist
2650 lappend rowoffsets $offs
2653 foreach id [array names idinlist] {
2655 lset rowidlist $row [list $id]
2656 lset rowoffsets $row 0
2657 makeuparrow $id 0 $row 0
2658 lappend idrowranges($id) $row
2659 lappend rowrangelist $idrowranges($id)
2660 unset idrowranges($id)
2662 lappend rowidlist {}
2663 lappend rowoffsets {}
2667 proc insert_pad {row col npad} {
2668 global rowidlist rowoffsets
2670 set pad [ntimes $npad {}]
2671 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2672 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2673 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2676 proc optimize_rows {row col endrow} {
2677 global rowidlist rowoffsets idrowranges displayorder
2679 for {} {$row < $endrow} {incr row} {
2680 set idlist [lindex $rowidlist $row]
2681 set offs [lindex $rowoffsets $row]
2683 for {} {$col < [llength $offs]} {incr col} {
2684 if {[lindex $idlist $col] eq {}} {
2688 set z [lindex $offs $col]
2689 if {$z eq {}} continue
2691 set x0 [expr {$col + $z}]
2692 set y0 [expr {$row - 1}]
2693 set z0 [lindex $rowoffsets $y0 $x0]
2695 set id [lindex $idlist $col]
2696 set ranges [rowranges $id]
2697 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2701 if {$z < -1 || ($z < 0 && $isarrow)} {
2702 set npad [expr {-1 - $z + $isarrow}]
2703 set offs [incrange $offs $col $npad]
2704 insert_pad $y0 $x0 $npad
2706 optimize_rows $y0 $x0 $row
2708 set z [lindex $offs $col]
2709 set x0 [expr {$col + $z}]
2710 set z0 [lindex $rowoffsets $y0 $x0]
2711 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2712 set npad [expr {$z - 1 + $isarrow}]
2713 set y1 [expr {$row + 1}]
2714 set offs2 [lindex $rowoffsets $y1]
2718 if {$z eq {} || $x1 + $z < $col} continue
2719 if {$x1 + $z > $col} {
2722 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2725 set pad [ntimes $npad {}]
2726 set idlist [eval linsert \$idlist $col $pad]
2727 set tmp [eval linsert \$offs $col $pad]
2729 set offs [incrange $tmp $col [expr {-$npad}]]
2730 set z [lindex $offs $col]
2733 if {$z0 eq {} && !$isarrow} {
2734 # this line links to its first child on row $row-2
2735 set rm2 [expr {$row - 2}]
2736 set id [lindex $displayorder $rm2]
2737 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2739 set z0 [expr {$xc - $x0}]
2742 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2743 insert_pad $y0 $x0 1
2744 set offs [incrange $offs $col 1]
2745 optimize_rows $y0 [expr {$x0 + 1}] $row
2750 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2751 set o [lindex $offs $col]
2753 # check if this is the link to the first child
2754 set id [lindex $idlist $col]
2755 set ranges [rowranges $id]
2756 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2757 # it is, work out offset to child
2758 set y0 [expr {$row - 1}]
2759 set id [lindex $displayorder $y0]
2760 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2762 set o [expr {$x0 - $col}]
2766 if {$o eq {} || $o <= 0} break
2768 if {$o ne {} && [incr col] < [llength $idlist]} {
2769 set y1 [expr {$row + 1}]
2770 set offs2 [lindex $rowoffsets $y1]
2774 if {$z eq {} || $x1 + $z < $col} continue
2775 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2778 set idlist [linsert $idlist $col {}]
2779 set tmp [linsert $offs $col {}]
2781 set offs [incrange $tmp $col -1]
2784 lset rowidlist $row $idlist
2785 lset rowoffsets $row $offs
2791 global canvx0 linespc
2792 return [expr {$canvx0 + $col * $linespc}]
2796 global canvy0 linespc
2797 return [expr {$canvy0 + $row * $linespc}]
2800 proc linewidth {id} {
2801 global thickerline lthickness
2804 if {[info exists thickerline] && $id eq $thickerline} {
2805 set wid [expr {2 * $lthickness}]
2810 proc rowranges {id} {
2811 global phase idrowranges commitrow rowlaidout rowrangelist curview
2815 ([info exists commitrow($curview,$id)]
2816 && $commitrow($curview,$id) < $rowlaidout)} {
2817 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2818 } elseif {[info exists idrowranges($id)]} {
2819 set ranges $idrowranges($id)
2824 proc drawlineseg {id i} {
2825 global rowoffsets rowidlist
2827 global canv colormap linespc
2828 global numcommits commitrow curview
2830 set ranges [rowranges $id]
2832 if {[info exists commitrow($curview,$id)]
2833 && $commitrow($curview,$id) < $numcommits} {
2834 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2838 set startrow [lindex $ranges [expr {2 * $i}]]
2839 set row [lindex $ranges [expr {2 * $i + 1}]]
2840 if {$startrow == $row} return
2843 set col [lsearch -exact [lindex $rowidlist $row] $id]
2845 puts "oops: drawline: id $id not on row $row"
2851 set o [lindex $rowoffsets $row $col]
2854 # changing direction
2855 set x [xc $row $col]
2857 lappend coords $x $y
2863 set x [xc $row $col]
2865 lappend coords $x $y
2867 # draw the link to the first child as part of this line
2869 set child [lindex $displayorder $row]
2870 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2872 set x [xc $row $ccol]
2874 if {$ccol < $col - 1} {
2875 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2876 } elseif {$ccol > $col + 1} {
2877 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2879 lappend coords $x $y
2882 if {[llength $coords] < 4} return
2884 # This line has an arrow at the lower end: check if the arrow is
2885 # on a diagonal segment, and if so, work around the Tk 8.4
2886 # refusal to draw arrows on diagonal lines.
2887 set x0 [lindex $coords 0]
2888 set x1 [lindex $coords 2]
2890 set y0 [lindex $coords 1]
2891 set y1 [lindex $coords 3]
2892 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2893 # we have a nearby vertical segment, just trim off the diag bit
2894 set coords [lrange $coords 2 end]
2896 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2897 set xi [expr {$x0 - $slope * $linespc / 2}]
2898 set yi [expr {$y0 - $linespc / 2}]
2899 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2903 set arrow [expr {2 * ($i > 0) + $downarrow}]
2904 set arrow [lindex {none first last both} $arrow]
2905 set t [$canv create line $coords -width [linewidth $id] \
2906 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2911 proc drawparentlinks {id row col olds} {
2912 global rowidlist canv colormap
2914 set row2 [expr {$row + 1}]
2915 set x [xc $row $col]
2918 set ids [lindex $rowidlist $row2]
2919 # rmx = right-most X coord used
2922 set i [lsearch -exact $ids $p]
2924 puts "oops, parent $p of $id not in list"
2927 set x2 [xc $row2 $i]
2931 set ranges [rowranges $p]
2932 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2933 && $row2 < [lindex $ranges 1]} {
2934 # drawlineseg will do this one for us
2938 # should handle duplicated parents here...
2939 set coords [list $x $y]
2940 if {$i < $col - 1} {
2941 lappend coords [xc $row [expr {$i + 1}]] $y
2942 } elseif {$i > $col + 1} {
2943 lappend coords [xc $row [expr {$i - 1}]] $y
2945 lappend coords $x2 $y2
2946 set t [$canv create line $coords -width [linewidth $p] \
2947 -fill $colormap($p) -tags lines.$p]
2954 proc drawlines {id} {
2955 global colormap canv
2957 global children iddrawn commitrow rowidlist curview
2959 $canv delete lines.$id
2960 set nr [expr {[llength [rowranges $id]] / 2}]
2961 for {set i 0} {$i < $nr} {incr i} {
2962 if {[info exists idrangedrawn($id,$i)]} {
2966 foreach child $children($curview,$id) {
2967 if {[info exists iddrawn($child)]} {
2968 set row $commitrow($curview,$child)
2969 set col [lsearch -exact [lindex $rowidlist $row] $child]
2971 drawparentlinks $child $row $col [list $id]
2977 proc drawcmittext {id row col rmx} {
2978 global linespc canv canv2 canv3 canvy0 fgcolor
2979 global commitlisted commitinfo rowidlist
2980 global rowtextx idpos idtags idheads idotherrefs
2981 global linehtag linentag linedtag
2982 global mainfont canvxmax boldrows boldnamerows fgcolor
2984 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2985 set x [xc $row $col]
2987 set orad [expr {$linespc / 3}]
2988 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2989 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2990 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2992 $canv bind $t <1> {selcanvline {} %x %y}
2993 set xt [xc $row [llength [lindex $rowidlist $row]]]
2997 set rowtextx($row) $xt
2998 set idpos($id) [list $x $xt $y]
2999 if {[info exists idtags($id)] || [info exists idheads($id)]
3000 || [info exists idotherrefs($id)]} {
3001 set xt [drawtags $id $x $xt $y]
3003 set headline [lindex $commitinfo($id) 0]
3004 set name [lindex $commitinfo($id) 1]
3005 set date [lindex $commitinfo($id) 2]
3006 set date [formatdate $date]
3009 set isbold [ishighlighted $row]
3011 lappend boldrows $row
3014 lappend boldnamerows $row
3018 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3019 -text $headline -font $font -tags text]
3020 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3021 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3022 -text $name -font $nfont -tags text]
3023 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3024 -text $date -font $mainfont -tags text]
3025 set xr [expr {$xt + [font measure $mainfont $headline]}]
3026 if {$xr > $canvxmax} {
3032 proc drawcmitrow {row} {
3033 global displayorder rowidlist
3034 global idrangedrawn iddrawn
3035 global commitinfo parentlist numcommits
3036 global filehighlight fhighlights findstring nhighlights
3037 global hlview vhighlights
3038 global highlight_related rhighlights
3040 if {$row >= $numcommits} return
3041 foreach id [lindex $rowidlist $row] {
3042 if {$id eq {}} continue
3044 foreach {s e} [rowranges $id] {
3046 if {$row < $s} continue
3049 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3051 set idrangedrawn($id,$i) 1
3058 set id [lindex $displayorder $row]
3059 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3060 askvhighlight $row $id
3062 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3063 askfilehighlight $row $id
3065 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3066 askfindhighlight $row $id
3068 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3069 askrelhighlight $row $id
3071 if {[info exists iddrawn($id)]} return
3072 set col [lsearch -exact [lindex $rowidlist $row] $id]
3074 puts "oops, row $row id $id not in list"
3077 if {![info exists commitinfo($id)]} {
3081 set olds [lindex $parentlist $row]
3083 set rmx [drawparentlinks $id $row $col $olds]
3087 drawcmittext $id $row $col $rmx
3091 proc drawfrac {f0 f1} {
3092 global numcommits canv
3095 set ymax [lindex [$canv cget -scrollregion] 3]
3096 if {$ymax eq {} || $ymax == 0} return
3097 set y0 [expr {int($f0 * $ymax)}]
3098 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3102 set y1 [expr {int($f1 * $ymax)}]
3103 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3104 if {$endrow >= $numcommits} {
3105 set endrow [expr {$numcommits - 1}]
3107 for {} {$row <= $endrow} {incr row} {
3112 proc drawvisible {} {
3114 eval drawfrac [$canv yview]
3117 proc clear_display {} {
3118 global iddrawn idrangedrawn
3119 global vhighlights fhighlights nhighlights rhighlights
3122 catch {unset iddrawn}
3123 catch {unset idrangedrawn}
3124 catch {unset vhighlights}
3125 catch {unset fhighlights}
3126 catch {unset nhighlights}
3127 catch {unset rhighlights}
3130 proc findcrossings {id} {
3131 global rowidlist parentlist numcommits rowoffsets displayorder
3135 foreach {s e} [rowranges $id] {
3136 if {$e >= $numcommits} {
3137 set e [expr {$numcommits - 1}]
3139 if {$e <= $s} continue
3140 set x [lsearch -exact [lindex $rowidlist $e] $id]
3142 puts "findcrossings: oops, no [shortids $id] in row $e"
3145 for {set row $e} {[incr row -1] >= $s} {} {
3146 set olds [lindex $parentlist $row]
3147 set kid [lindex $displayorder $row]
3148 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3149 if {$kidx < 0} continue
3150 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3152 set px [lsearch -exact $nextrow $p]
3153 if {$px < 0} continue
3154 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3155 if {[lsearch -exact $ccross $p] >= 0} continue
3156 if {$x == $px + ($kidx < $px? -1: 1)} {
3158 } elseif {[lsearch -exact $cross $p] < 0} {
3163 set inc [lindex $rowoffsets $row $x]
3164 if {$inc eq {}} break
3168 return [concat $ccross {{}} $cross]
3171 proc assigncolor {id} {
3172 global colormap colors nextcolor
3173 global commitrow parentlist children children curview
3175 if {[info exists colormap($id)]} return
3176 set ncolors [llength $colors]
3177 if {[info exists children($curview,$id)]} {
3178 set kids $children($curview,$id)
3182 if {[llength $kids] == 1} {
3183 set child [lindex $kids 0]
3184 if {[info exists colormap($child)]
3185 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3186 set colormap($id) $colormap($child)
3192 foreach x [findcrossings $id] {
3194 # delimiter between corner crossings and other crossings
3195 if {[llength $badcolors] >= $ncolors - 1} break
3196 set origbad $badcolors
3198 if {[info exists colormap($x)]
3199 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3200 lappend badcolors $colormap($x)
3203 if {[llength $badcolors] >= $ncolors} {
3204 set badcolors $origbad
3206 set origbad $badcolors
3207 if {[llength $badcolors] < $ncolors - 1} {
3208 foreach child $kids {
3209 if {[info exists colormap($child)]
3210 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3211 lappend badcolors $colormap($child)
3213 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3214 if {[info exists colormap($p)]
3215 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3216 lappend badcolors $colormap($p)
3220 if {[llength $badcolors] >= $ncolors} {
3221 set badcolors $origbad
3224 for {set i 0} {$i <= $ncolors} {incr i} {
3225 set c [lindex $colors $nextcolor]
3226 if {[incr nextcolor] >= $ncolors} {
3229 if {[lsearch -exact $badcolors $c]} break
3231 set colormap($id) $c
3234 proc bindline {t id} {
3237 $canv bind $t <Enter> "lineenter %x %y $id"
3238 $canv bind $t <Motion> "linemotion %x %y $id"
3239 $canv bind $t <Leave> "lineleave $id"
3240 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3243 proc drawtags {id x xt y1} {
3244 global idtags idheads idotherrefs mainhead
3245 global linespc lthickness
3246 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3251 if {[info exists idtags($id)]} {
3252 set marks $idtags($id)
3253 set ntags [llength $marks]
3255 if {[info exists idheads($id)]} {
3256 set marks [concat $marks $idheads($id)]
3257 set nheads [llength $idheads($id)]
3259 if {[info exists idotherrefs($id)]} {
3260 set marks [concat $marks $idotherrefs($id)]
3266 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3267 set yt [expr {$y1 - 0.5 * $linespc}]
3268 set yb [expr {$yt + $linespc - 1}]
3272 foreach tag $marks {
3274 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3275 set wid [font measure [concat $mainfont bold] $tag]
3277 set wid [font measure $mainfont $tag]
3281 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3283 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3284 -width $lthickness -fill black -tags tag.$id]
3286 foreach tag $marks x $xvals wid $wvals {
3287 set xl [expr {$x + $delta}]
3288 set xr [expr {$x + $delta + $wid + $lthickness}]
3290 if {[incr ntags -1] >= 0} {
3292 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3293 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3294 -width 1 -outline black -fill yellow -tags tag.$id]
3295 $canv bind $t <1> [list showtag $tag 1]
3296 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3298 # draw a head or other ref
3299 if {[incr nheads -1] >= 0} {
3301 if {$tag eq $mainhead} {
3307 set xl [expr {$xl - $delta/2}]
3308 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3309 -width 1 -outline black -fill $col -tags tag.$id
3310 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3311 set rwid [font measure $mainfont $remoteprefix]
3312 set xi [expr {$x + 1}]
3313 set yti [expr {$yt + 1}]
3314 set xri [expr {$x + $rwid}]
3315 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3316 -width 0 -fill "#ffddaa" -tags tag.$id
3319 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3320 -font $font -tags [list tag.$id text]]
3322 $canv bind $t <1> [list showtag $tag 1]
3323 } elseif {$nheads >= 0} {
3324 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3330 proc xcoord {i level ln} {
3331 global canvx0 xspc1 xspc2
3333 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3334 if {$i > 0 && $i == $level} {
3335 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3336 } elseif {$i > $level} {
3337 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3342 proc show_status {msg} {
3343 global canv mainfont fgcolor
3346 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3347 -tags text -fill $fgcolor
3350 proc finishcommits {} {
3351 global commitidx phase curview
3352 global pending_select
3354 if {$commitidx($curview) > 0} {
3357 show_status "No commits selected"
3360 catch {unset pending_select}
3363 # Insert a new commit as the child of the commit on row $row.
3364 # The new commit will be displayed on row $row and the commits
3365 # on that row and below will move down one row.
3366 proc insertrow {row newcmit} {
3367 global displayorder parentlist childlist commitlisted
3368 global commitrow curview rowidlist rowoffsets numcommits
3369 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3370 global linesegends selectedline
3372 if {$row >= $numcommits} {
3373 puts "oops, inserting new row $row but only have $numcommits rows"
3376 set p [lindex $displayorder $row]
3377 set displayorder [linsert $displayorder $row $newcmit]
3378 set parentlist [linsert $parentlist $row $p]
3379 set kids [lindex $childlist $row]
3380 lappend kids $newcmit
3381 lset childlist $row $kids
3382 set childlist [linsert $childlist $row {}]
3383 set commitlisted [linsert $commitlisted $row 1]
3384 set l [llength $displayorder]
3385 for {set r $row} {$r < $l} {incr r} {
3386 set id [lindex $displayorder $r]
3387 set commitrow($curview,$id) $r
3390 set idlist [lindex $rowidlist $row]
3391 set offs [lindex $rowoffsets $row]
3394 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3400 if {[llength $kids] == 1} {
3401 set col [lsearch -exact $idlist $p]
3402 lset idlist $col $newcmit
3404 set col [llength $idlist]
3405 lappend idlist $newcmit
3407 lset rowoffsets $row $offs
3409 set rowidlist [linsert $rowidlist $row $idlist]
3410 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3412 set rowrangelist [linsert $rowrangelist $row {}]
3413 set l [llength $rowrangelist]
3414 for {set r 0} {$r < $l} {incr r} {
3415 set ranges [lindex $rowrangelist $r]
3416 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3420 lappend newranges [expr {$x + 1}]
3422 lappend newranges $x
3425 lset rowrangelist $r $newranges
3428 if {[llength $kids] > 1} {
3429 set rp1 [expr {$row + 1}]
3430 set ranges [lindex $rowrangelist $rp1]
3431 if {$ranges eq {}} {
3432 set ranges [list $row $rp1]
3433 } elseif {[lindex $ranges end-1] == $rp1} {
3434 lset ranges end-1 $row
3436 lset rowrangelist $rp1 $ranges
3438 foreach id [array names idrowranges] {
3439 set ranges $idrowranges($id)
3440 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3444 lappend newranges [expr {$x + 1}]
3446 lappend newranges $x
3449 set idrowranges($id) $newranges
3453 set linesegends [linsert $linesegends $row {}]
3459 if {[info exists selectedline] && $selectedline >= $row} {
3465 # Don't change the text pane cursor if it is currently the hand cursor,
3466 # showing that we are over a sha1 ID link.
3467 proc settextcursor {c} {
3468 global ctext curtextcursor
3470 if {[$ctext cget -cursor] == $curtextcursor} {
3471 $ctext config -cursor $c
3473 set curtextcursor $c
3476 proc nowbusy {what} {
3479 if {[array names isbusy] eq {}} {
3480 . config -cursor watch
3486 proc notbusy {what} {
3487 global isbusy maincursor textcursor
3489 catch {unset isbusy($what)}
3490 if {[array names isbusy] eq {}} {
3491 . config -cursor $maincursor
3492 settextcursor $textcursor
3498 global rowlaidout commitidx curview
3499 global pending_select
3502 layoutrows $rowlaidout $commitidx($curview) 1
3504 optimize_rows $row 0 $commitidx($curview)
3505 showstuff $commitidx($curview)
3506 if {[info exists pending_select]} {
3510 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3512 #puts "overall $drawmsecs ms for $numcommits commits"
3515 proc findmatches {f} {
3516 global findtype foundstring foundstrlen
3517 if {$findtype == "Regexp"} {
3518 set matches [regexp -indices -all -inline $foundstring $f]
3520 if {$findtype == "IgnCase"} {
3521 set str [string tolower $f]
3527 while {[set j [string first $foundstring $str $i]] >= 0} {
3528 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3529 set i [expr {$j + $foundstrlen}]
3536 global findtype findloc findstring markedmatches commitinfo
3537 global numcommits displayorder linehtag linentag linedtag
3538 global mainfont canv canv2 canv3 selectedline
3539 global matchinglines foundstring foundstrlen matchstring
3544 cancel_next_highlight
3546 set matchinglines {}
3547 if {$findtype == "IgnCase"} {
3548 set foundstring [string tolower $findstring]
3550 set foundstring $findstring
3552 set foundstrlen [string length $findstring]
3553 if {$foundstrlen == 0} return
3554 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3555 set matchstring "*$matchstring*"
3556 if {![info exists selectedline]} {
3559 set oldsel $selectedline
3562 set fldtypes {Headline Author Date Committer CDate Comments}
3564 foreach id $displayorder {
3565 set d $commitdata($id)
3567 if {$findtype == "Regexp"} {
3568 set doesmatch [regexp $foundstring $d]
3569 } elseif {$findtype == "IgnCase"} {
3570 set doesmatch [string match -nocase $matchstring $d]
3572 set doesmatch [string match $matchstring $d]
3574 if {!$doesmatch} continue
3575 if {![info exists commitinfo($id)]} {
3578 set info $commitinfo($id)
3580 foreach f $info ty $fldtypes {
3581 if {$findloc != "All fields" && $findloc != $ty} {
3584 set matches [findmatches $f]
3585 if {$matches == {}} continue
3587 if {$ty == "Headline"} {
3589 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3590 } elseif {$ty == "Author"} {
3592 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3593 } elseif {$ty == "Date"} {
3595 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3599 lappend matchinglines $l
3600 if {!$didsel && $l > $oldsel} {
3606 if {$matchinglines == {}} {
3608 } elseif {!$didsel} {
3609 findselectline [lindex $matchinglines 0]
3613 proc findselectline {l} {
3614 global findloc commentend ctext
3616 if {$findloc == "All fields" || $findloc == "Comments"} {
3617 # highlight the matches in the comments
3618 set f [$ctext get 1.0 $commentend]
3619 set matches [findmatches $f]
3620 foreach match $matches {
3621 set start [lindex $match 0]
3622 set end [expr {[lindex $match 1] + 1}]
3623 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3628 proc findnext {restart} {
3629 global matchinglines selectedline
3630 if {![info exists matchinglines]} {
3636 if {![info exists selectedline]} return
3637 foreach l $matchinglines {
3638 if {$l > $selectedline} {
3647 global matchinglines selectedline
3648 if {![info exists matchinglines]} {
3652 if {![info exists selectedline]} return
3654 foreach l $matchinglines {
3655 if {$l >= $selectedline} break
3659 findselectline $prev
3665 proc stopfindproc {{done 0}} {
3666 global findprocpid findprocfile findids
3667 global ctext findoldcursor phase maincursor textcursor
3668 global findinprogress
3670 catch {unset findids}
3671 if {[info exists findprocpid]} {
3673 catch {exec kill $findprocpid}
3675 catch {close $findprocfile}
3678 catch {unset findinprogress}
3682 # mark a commit as matching by putting a yellow background
3683 # behind the headline
3684 proc markheadline {l id} {
3685 global canv mainfont linehtag
3688 set bbox [$canv bbox $linehtag($l)]
3689 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3693 # mark the bits of a headline, author or date that match a find string
3694 proc markmatches {canv l str tag matches font} {
3695 set bbox [$canv bbox $tag]
3696 set x0 [lindex $bbox 0]
3697 set y0 [lindex $bbox 1]
3698 set y1 [lindex $bbox 3]
3699 foreach match $matches {
3700 set start [lindex $match 0]
3701 set end [lindex $match 1]
3702 if {$start > $end} continue
3703 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3704 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3705 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3706 [expr {$x0+$xlen+2}] $y1 \
3707 -outline {} -tags matches -fill yellow]
3712 proc unmarkmatches {} {
3713 global matchinglines findids
3714 allcanvs delete matches
3715 catch {unset matchinglines}
3716 catch {unset findids}
3719 proc selcanvline {w x y} {
3720 global canv canvy0 ctext linespc
3722 set ymax [lindex [$canv cget -scrollregion] 3]
3723 if {$ymax == {}} return
3724 set yfrac [lindex [$canv yview] 0]
3725 set y [expr {$y + $yfrac * $ymax}]
3726 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3731 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3737 proc commit_descriptor {p} {
3739 if {![info exists commitinfo($p)]} {
3743 if {[llength $commitinfo($p)] > 1} {
3744 set l [lindex $commitinfo($p) 0]
3749 # append some text to the ctext widget, and make any SHA1 ID
3750 # that we know about be a clickable link.
3751 proc appendwithlinks {text tags} {
3752 global ctext commitrow linknum curview
3754 set start [$ctext index "end - 1c"]
3755 $ctext insert end $text $tags
3756 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3760 set linkid [string range $text $s $e]
3761 if {![info exists commitrow($curview,$linkid)]} continue
3763 $ctext tag add link "$start + $s c" "$start + $e c"
3764 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3765 $ctext tag bind link$linknum <1> \
3766 [list selectline $commitrow($curview,$linkid) 1]
3769 $ctext tag conf link -foreground blue -underline 1
3770 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3771 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3774 proc viewnextline {dir} {
3778 set ymax [lindex [$canv cget -scrollregion] 3]
3779 set wnow [$canv yview]
3780 set wtop [expr {[lindex $wnow 0] * $ymax}]
3781 set newtop [expr {$wtop + $dir * $linespc}]
3784 } elseif {$newtop > $ymax} {
3787 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3790 # add a list of tag or branch names at position pos
3791 # returns the number of names inserted
3792 proc appendrefs {pos tags var} {
3793 global ctext commitrow linknum curview $var
3795 if {[catch {$ctext index $pos}]} {
3798 set tags [lsort $tags]
3801 set id [set $var\($tag\)]
3804 $ctext insert $pos $sep
3805 $ctext insert $pos $tag $lk
3806 $ctext tag conf $lk -foreground blue
3807 if {[info exists commitrow($curview,$id)]} {
3808 $ctext tag bind $lk <1> \
3809 [list selectline $commitrow($curview,$id) 1]
3810 $ctext tag conf $lk -underline 1
3811 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3812 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3816 return [llength $tags]
3819 proc taglist {ids} {
3824 foreach tag $idtags($id) {
3831 # called when we have finished computing the nearby tags
3832 proc dispneartags {} {
3833 global selectedline currentid ctext anc_tags desc_tags showneartags
3836 if {![info exists selectedline] || !$showneartags} return
3838 $ctext conf -state normal
3839 if {[info exists desc_heads($id)]} {
3840 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3841 $ctext insert "branch -2c" "es"
3844 if {[info exists anc_tags($id)]} {
3845 appendrefs follows [taglist $anc_tags($id)] tagids
3847 if {[info exists desc_tags($id)]} {
3848 appendrefs precedes [taglist $desc_tags($id)] tagids
3850 $ctext conf -state disabled
3853 proc selectline {l isnew} {
3854 global canv canv2 canv3 ctext commitinfo selectedline
3855 global displayorder linehtag linentag linedtag
3856 global canvy0 linespc parentlist childlist
3857 global currentid sha1entry
3858 global commentend idtags linknum
3859 global mergemax numcommits pending_select
3860 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3862 catch {unset pending_select}
3865 cancel_next_highlight
3866 if {$l < 0 || $l >= $numcommits} return
3867 set y [expr {$canvy0 + $l * $linespc}]
3868 set ymax [lindex [$canv cget -scrollregion] 3]
3869 set ytop [expr {$y - $linespc - 1}]
3870 set ybot [expr {$y + $linespc + 1}]
3871 set wnow [$canv yview]
3872 set wtop [expr {[lindex $wnow 0] * $ymax}]
3873 set wbot [expr {[lindex $wnow 1] * $ymax}]
3874 set wh [expr {$wbot - $wtop}]
3876 if {$ytop < $wtop} {
3877 if {$ybot < $wtop} {
3878 set newtop [expr {$y - $wh / 2.0}]
3881 if {$newtop > $wtop - $linespc} {
3882 set newtop [expr {$wtop - $linespc}]
3885 } elseif {$ybot > $wbot} {
3886 if {$ytop > $wbot} {
3887 set newtop [expr {$y - $wh / 2.0}]
3889 set newtop [expr {$ybot - $wh}]
3890 if {$newtop < $wtop + $linespc} {
3891 set newtop [expr {$wtop + $linespc}]
3895 if {$newtop != $wtop} {
3899 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3903 if {![info exists linehtag($l)]} return
3905 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3906 -tags secsel -fill [$canv cget -selectbackground]]
3908 $canv2 delete secsel
3909 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3910 -tags secsel -fill [$canv2 cget -selectbackground]]
3912 $canv3 delete secsel
3913 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3914 -tags secsel -fill [$canv3 cget -selectbackground]]
3918 addtohistory [list selectline $l 0]
3923 set id [lindex $displayorder $l]
3925 $sha1entry delete 0 end
3926 $sha1entry insert 0 $id
3927 $sha1entry selection from 0
3928 $sha1entry selection to end
3931 $ctext conf -state normal
3934 set info $commitinfo($id)
3935 set date [formatdate [lindex $info 2]]
3936 $ctext insert end "Author: [lindex $info 1] $date\n"
3937 set date [formatdate [lindex $info 4]]
3938 $ctext insert end "Committer: [lindex $info 3] $date\n"
3939 if {[info exists idtags($id)]} {
3940 $ctext insert end "Tags:"
3941 foreach tag $idtags($id) {
3942 $ctext insert end " $tag"
3944 $ctext insert end "\n"
3948 set olds [lindex $parentlist $l]
3949 if {[llength $olds] > 1} {
3952 if {$np >= $mergemax} {
3957 $ctext insert end "Parent: " $tag
3958 appendwithlinks [commit_descriptor $p] {}
3963 append headers "Parent: [commit_descriptor $p]"
3967 foreach c [lindex $childlist $l] {
3968 append headers "Child: [commit_descriptor $c]"
3971 # make anything that looks like a SHA1 ID be a clickable link
3972 appendwithlinks $headers {}
3973 if {$showneartags} {
3974 if {![info exists allcommits]} {
3977 $ctext insert end "Branch: "
3978 $ctext mark set branch "end -1c"
3979 $ctext mark gravity branch left
3980 if {[info exists desc_heads($id)]} {
3981 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3982 # turn "Branch" into "Branches"
3983 $ctext insert "branch -2c" "es"
3986 $ctext insert end "\nFollows: "
3987 $ctext mark set follows "end -1c"
3988 $ctext mark gravity follows left
3989 if {[info exists anc_tags($id)]} {
3990 appendrefs follows [taglist $anc_tags($id)] tagids
3992 $ctext insert end "\nPrecedes: "
3993 $ctext mark set precedes "end -1c"
3994 $ctext mark gravity precedes left
3995 if {[info exists desc_tags($id)]} {
3996 appendrefs precedes [taglist $desc_tags($id)] tagids
3998 $ctext insert end "\n"
4000 $ctext insert end "\n"
4001 appendwithlinks [lindex $info 5] {comment}
4003 $ctext tag delete Comments
4004 $ctext tag remove found 1.0 end
4005 $ctext conf -state disabled
4006 set commentend [$ctext index "end - 1c"]
4008 init_flist "Comments"
4009 if {$cmitmode eq "tree"} {
4011 } elseif {[llength $olds] <= 1} {
4018 proc selfirstline {} {
4023 proc sellastline {} {
4026 set l [expr {$numcommits - 1}]
4030 proc selnextline {dir} {
4032 if {![info exists selectedline]} return
4033 set l [expr {$selectedline + $dir}]
4038 proc selnextpage {dir} {
4039 global canv linespc selectedline numcommits
4041 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4045 allcanvs yview scroll [expr {$dir * $lpp}] units
4047 if {![info exists selectedline]} return
4048 set l [expr {$selectedline + $dir * $lpp}]
4051 } elseif {$l >= $numcommits} {
4052 set l [expr $numcommits - 1]
4058 proc unselectline {} {
4059 global selectedline currentid
4061 catch {unset selectedline}
4062 catch {unset currentid}
4063 allcanvs delete secsel
4065 cancel_next_highlight
4068 proc reselectline {} {
4071 if {[info exists selectedline]} {
4072 selectline $selectedline 0
4076 proc addtohistory {cmd} {
4077 global history historyindex curview
4079 set elt [list $curview $cmd]
4080 if {$historyindex > 0
4081 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4085 if {$historyindex < [llength $history]} {
4086 set history [lreplace $history $historyindex end $elt]
4088 lappend history $elt
4091 if {$historyindex > 1} {
4092 .tf.bar.leftbut conf -state normal
4094 .tf.bar.leftbut conf -state disabled
4096 .tf.bar.rightbut conf -state disabled
4102 set view [lindex $elt 0]
4103 set cmd [lindex $elt 1]
4104 if {$curview != $view} {
4111 global history historyindex
4113 if {$historyindex > 1} {
4114 incr historyindex -1
4115 godo [lindex $history [expr {$historyindex - 1}]]
4116 .tf.bar.rightbut conf -state normal
4118 if {$historyindex <= 1} {
4119 .tf.bar.leftbut conf -state disabled
4124 global history historyindex
4126 if {$historyindex < [llength $history]} {
4127 set cmd [lindex $history $historyindex]
4130 .tf.bar.leftbut conf -state normal
4132 if {$historyindex >= [llength $history]} {
4133 .tf.bar.rightbut conf -state disabled
4138 global treefilelist treeidlist diffids diffmergeid treepending
4141 catch {unset diffmergeid}
4142 if {![info exists treefilelist($id)]} {
4143 if {![info exists treepending]} {
4144 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4148 set treefilelist($id) {}
4149 set treeidlist($id) {}
4150 fconfigure $gtf -blocking 0
4151 fileevent $gtf readable [list gettreeline $gtf $id]
4158 proc gettreeline {gtf id} {
4159 global treefilelist treeidlist treepending cmitmode diffids
4161 while {[gets $gtf line] >= 0} {
4162 if {[lindex $line 1] ne "blob"} continue
4163 set sha1 [lindex $line 2]
4164 set fname [lindex $line 3]
4165 lappend treefilelist($id) $fname
4166 lappend treeidlist($id) $sha1
4168 if {![eof $gtf]} return
4171 if {$cmitmode ne "tree"} {
4172 if {![info exists diffmergeid]} {
4173 gettreediffs $diffids
4175 } elseif {$id ne $diffids} {
4183 global treefilelist treeidlist diffids
4184 global ctext commentend
4186 set i [lsearch -exact $treefilelist($diffids) $f]
4188 puts "oops, $f not in list for id $diffids"
4191 set blob [lindex $treeidlist($diffids) $i]
4192 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4193 puts "oops, error reading blob $blob: $err"
4196 fconfigure $bf -blocking 0
4197 fileevent $bf readable [list getblobline $bf $diffids]
4198 $ctext config -state normal
4199 clear_ctext $commentend
4200 $ctext insert end "\n"
4201 $ctext insert end "$f\n" filesep
4202 $ctext config -state disabled
4203 $ctext yview $commentend
4206 proc getblobline {bf id} {
4207 global diffids cmitmode ctext
4209 if {$id ne $diffids || $cmitmode ne "tree"} {
4213 $ctext config -state normal
4214 while {[gets $bf line] >= 0} {
4215 $ctext insert end "$line\n"
4218 # delete last newline
4219 $ctext delete "end - 2c" "end - 1c"
4222 $ctext config -state disabled
4225 proc mergediff {id l} {
4226 global diffmergeid diffopts mdifffd
4232 # this doesn't seem to actually affect anything...
4233 set env(GIT_DIFF_OPTS) $diffopts
4234 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4235 if {[catch {set mdf [open $cmd r]} err]} {
4236 error_popup "Error getting merge diffs: $err"
4239 fconfigure $mdf -blocking 0
4240 set mdifffd($id) $mdf
4241 set np [llength [lindex $parentlist $l]]
4242 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4243 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4246 proc getmergediffline {mdf id np} {
4247 global diffmergeid ctext cflist nextupdate mergemax
4248 global difffilestart mdifffd
4250 set n [gets $mdf line]
4257 if {![info exists diffmergeid] || $id != $diffmergeid
4258 || $mdf != $mdifffd($id)} {
4261 $ctext conf -state normal
4262 if {[regexp {^diff --cc (.*)} $line match fname]} {
4263 # start of a new file
4264 $ctext insert end "\n"
4265 set here [$ctext index "end - 1c"]
4266 lappend difffilestart $here
4267 add_flist [list $fname]
4268 set l [expr {(78 - [string length $fname]) / 2}]
4269 set pad [string range "----------------------------------------" 1 $l]
4270 $ctext insert end "$pad $fname $pad\n" filesep
4271 } elseif {[regexp {^@@} $line]} {
4272 $ctext insert end "$line\n" hunksep
4273 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4276 # parse the prefix - one ' ', '-' or '+' for each parent
4281 for {set j 0} {$j < $np} {incr j} {
4282 set c [string range $line $j $j]
4285 } elseif {$c == "-"} {
4287 } elseif {$c == "+"} {
4296 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4297 # line doesn't appear in result, parents in $minuses have the line
4298 set num [lindex $minuses 0]
4299 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4300 # line appears in result, parents in $pluses don't have the line
4301 lappend tags mresult
4302 set num [lindex $spaces 0]
4305 if {$num >= $mergemax} {
4310 $ctext insert end "$line\n" $tags
4312 $ctext conf -state disabled
4313 if {[clock clicks -milliseconds] >= $nextupdate} {
4315 fileevent $mdf readable {}
4317 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4321 proc startdiff {ids} {
4322 global treediffs diffids treepending diffmergeid
4325 catch {unset diffmergeid}
4326 if {![info exists treediffs($ids)]} {
4327 if {![info exists treepending]} {
4335 proc addtocflist {ids} {
4336 global treediffs cflist
4337 add_flist $treediffs($ids)
4341 proc gettreediffs {ids} {
4342 global treediff treepending
4343 set treepending $ids
4346 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4348 fconfigure $gdtf -blocking 0
4349 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4352 proc gettreediffline {gdtf ids} {
4353 global treediff treediffs treepending diffids diffmergeid
4356 set n [gets $gdtf line]
4358 if {![eof $gdtf]} return
4360 set treediffs($ids) $treediff
4362 if {$cmitmode eq "tree"} {
4364 } elseif {$ids != $diffids} {
4365 if {![info exists diffmergeid]} {
4366 gettreediffs $diffids
4373 set file [lindex $line 5]
4374 lappend treediff $file
4377 proc getblobdiffs {ids} {
4378 global diffopts blobdifffd diffids env curdifftag curtagstart
4379 global nextupdate diffinhdr treediffs
4381 set env(GIT_DIFF_OPTS) $diffopts
4382 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4383 if {[catch {set bdf [open $cmd r]} err]} {
4384 puts "error getting diffs: $err"
4388 fconfigure $bdf -blocking 0
4389 set blobdifffd($ids) $bdf
4390 set curdifftag Comments
4392 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4393 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4396 proc setinlist {var i val} {
4399 while {[llength [set $var]] < $i} {
4402 if {[llength [set $var]] == $i} {
4409 proc getblobdiffline {bdf ids} {
4410 global diffids blobdifffd ctext curdifftag curtagstart
4411 global diffnexthead diffnextnote difffilestart
4412 global nextupdate diffinhdr treediffs
4414 set n [gets $bdf line]
4418 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4419 $ctext tag add $curdifftag $curtagstart end
4424 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4427 $ctext conf -state normal
4428 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4429 # start of a new file
4430 $ctext insert end "\n"
4431 $ctext tag add $curdifftag $curtagstart end
4432 set here [$ctext index "end - 1c"]
4433 set curtagstart $here
4435 set i [lsearch -exact $treediffs($ids) $fname]
4437 setinlist difffilestart $i $here
4439 if {$newname ne $fname} {
4440 set i [lsearch -exact $treediffs($ids) $newname]
4442 setinlist difffilestart $i $here
4445 set curdifftag "f:$fname"
4446 $ctext tag delete $curdifftag
4447 set l [expr {(78 - [string length $header]) / 2}]
4448 set pad [string range "----------------------------------------" 1 $l]
4449 $ctext insert end "$pad $header $pad\n" filesep
4451 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4453 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4455 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4456 $line match f1l f1c f2l f2c rest]} {
4457 $ctext insert end "$line\n" hunksep
4460 set x [string range $line 0 0]
4461 if {$x == "-" || $x == "+"} {
4462 set tag [expr {$x == "+"}]
4463 $ctext insert end "$line\n" d$tag
4464 } elseif {$x == " "} {
4465 $ctext insert end "$line\n"
4466 } elseif {$diffinhdr || $x == "\\"} {
4467 # e.g. "\ No newline at end of file"
4468 $ctext insert end "$line\n" filesep
4470 # Something else we don't recognize
4471 if {$curdifftag != "Comments"} {
4472 $ctext insert end "\n"
4473 $ctext tag add $curdifftag $curtagstart end
4474 set curtagstart [$ctext index "end - 1c"]
4475 set curdifftag Comments
4477 $ctext insert end "$line\n" filesep
4480 $ctext conf -state disabled
4481 if {[clock clicks -milliseconds] >= $nextupdate} {
4483 fileevent $bdf readable {}
4485 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4490 global difffilestart ctext
4491 set prev [lindex $difffilestart 0]
4492 set here [$ctext index @0,0]
4493 foreach loc $difffilestart {
4494 if {[$ctext compare $loc >= $here]} {
4504 global difffilestart ctext
4505 set here [$ctext index @0,0]
4506 foreach loc $difffilestart {
4507 if {[$ctext compare $loc > $here]} {
4514 proc clear_ctext {{first 1.0}} {
4515 global ctext smarktop smarkbot
4517 set l [lindex [split $first .] 0]
4518 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4521 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4524 $ctext delete $first end
4527 proc incrsearch {name ix op} {
4528 global ctext searchstring searchdirn
4530 $ctext tag remove found 1.0 end
4531 if {[catch {$ctext index anchor}]} {
4532 # no anchor set, use start of selection, or of visible area
4533 set sel [$ctext tag ranges sel]
4535 $ctext mark set anchor [lindex $sel 0]
4536 } elseif {$searchdirn eq "-forwards"} {
4537 $ctext mark set anchor @0,0
4539 $ctext mark set anchor @0,[winfo height $ctext]
4542 if {$searchstring ne {}} {
4543 set here [$ctext search $searchdirn -- $searchstring anchor]
4552 global sstring ctext searchstring searchdirn
4555 $sstring icursor end
4556 set searchdirn -forwards
4557 if {$searchstring ne {}} {
4558 set sel [$ctext tag ranges sel]
4560 set start "[lindex $sel 0] + 1c"
4561 } elseif {[catch {set start [$ctext index anchor]}]} {
4564 set match [$ctext search -count mlen -- $searchstring $start]
4565 $ctext tag remove sel 1.0 end
4571 set mend "$match + $mlen c"
4572 $ctext tag add sel $match $mend
4573 $ctext mark unset anchor
4577 proc dosearchback {} {
4578 global sstring ctext searchstring searchdirn
4581 $sstring icursor end
4582 set searchdirn -backwards
4583 if {$searchstring ne {}} {
4584 set sel [$ctext tag ranges sel]
4586 set start [lindex $sel 0]
4587 } elseif {[catch {set start [$ctext index anchor]}]} {
4588 set start @0,[winfo height $ctext]
4590 set match [$ctext search -backwards -count ml -- $searchstring $start]
4591 $ctext tag remove sel 1.0 end
4597 set mend "$match + $ml c"
4598 $ctext tag add sel $match $mend
4599 $ctext mark unset anchor
4603 proc searchmark {first last} {
4604 global ctext searchstring
4608 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4609 if {$match eq {}} break
4610 set mend "$match + $mlen c"
4611 $ctext tag add found $match $mend
4615 proc searchmarkvisible {doall} {
4616 global ctext smarktop smarkbot
4618 set topline [lindex [split [$ctext index @0,0] .] 0]
4619 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4620 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4621 # no overlap with previous
4622 searchmark $topline $botline
4623 set smarktop $topline
4624 set smarkbot $botline
4626 if {$topline < $smarktop} {
4627 searchmark $topline [expr {$smarktop-1}]
4628 set smarktop $topline
4630 if {$botline > $smarkbot} {
4631 searchmark [expr {$smarkbot+1}] $botline
4632 set smarkbot $botline
4637 proc scrolltext {f0 f1} {
4640 .bleft.sb set $f0 $f1
4641 if {$searchstring ne {}} {
4647 global linespc charspc canvx0 canvy0 mainfont
4648 global xspc1 xspc2 lthickness
4650 set linespc [font metrics $mainfont -linespace]
4651 set charspc [font measure $mainfont "m"]
4652 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4653 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4654 set lthickness [expr {int($linespc / 9) + 1}]
4655 set xspc1(0) $linespc
4663 set ymax [lindex [$canv cget -scrollregion] 3]
4664 if {$ymax eq {} || $ymax == 0} return
4665 set span [$canv yview]
4668 allcanvs yview moveto [lindex $span 0]
4670 if {[info exists selectedline]} {
4671 selectline $selectedline 0
4672 allcanvs yview moveto [lindex $span 0]
4676 proc incrfont {inc} {
4677 global mainfont textfont ctext canv phase
4678 global stopped entries
4680 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4681 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4683 $ctext conf -font $textfont
4684 $ctext tag conf filesep -font [concat $textfont bold]
4685 foreach e $entries {
4686 $e conf -font $mainfont
4688 if {$phase eq "getcommits"} {
4689 $canv itemconf textitems -font $mainfont
4695 global sha1entry sha1string
4696 if {[string length $sha1string] == 40} {
4697 $sha1entry delete 0 end
4701 proc sha1change {n1 n2 op} {
4702 global sha1string currentid sha1but
4703 if {$sha1string == {}
4704 || ([info exists currentid] && $sha1string == $currentid)} {
4709 if {[$sha1but cget -state] == $state} return
4710 if {$state == "normal"} {
4711 $sha1but conf -state normal -relief raised -text "Goto: "
4713 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4717 proc gotocommit {} {
4718 global sha1string currentid commitrow tagids headids
4719 global displayorder numcommits curview
4721 if {$sha1string == {}
4722 || ([info exists currentid] && $sha1string == $currentid)} return
4723 if {[info exists tagids($sha1string)]} {
4724 set id $tagids($sha1string)
4725 } elseif {[info exists headids($sha1string)]} {
4726 set id $headids($sha1string)
4728 set id [string tolower $sha1string]
4729 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4731 foreach i $displayorder {
4732 if {[string match $id* $i]} {
4736 if {$matches ne {}} {
4737 if {[llength $matches] > 1} {
4738 error_popup "Short SHA1 id $id is ambiguous"
4741 set id [lindex $matches 0]
4745 if {[info exists commitrow($curview,$id)]} {
4746 selectline $commitrow($curview,$id) 1
4749 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4754 error_popup "$type $sha1string is not known"
4757 proc lineenter {x y id} {
4758 global hoverx hovery hoverid hovertimer
4759 global commitinfo canv
4761 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4765 if {[info exists hovertimer]} {
4766 after cancel $hovertimer
4768 set hovertimer [after 500 linehover]
4772 proc linemotion {x y id} {
4773 global hoverx hovery hoverid hovertimer
4775 if {[info exists hoverid] && $id == $hoverid} {
4778 if {[info exists hovertimer]} {
4779 after cancel $hovertimer
4781 set hovertimer [after 500 linehover]
4785 proc lineleave {id} {
4786 global hoverid hovertimer canv
4788 if {[info exists hoverid] && $id == $hoverid} {
4790 if {[info exists hovertimer]} {
4791 after cancel $hovertimer
4799 global hoverx hovery hoverid hovertimer
4800 global canv linespc lthickness
4801 global commitinfo mainfont
4803 set text [lindex $commitinfo($hoverid) 0]
4804 set ymax [lindex [$canv cget -scrollregion] 3]
4805 if {$ymax == {}} return
4806 set yfrac [lindex [$canv yview] 0]
4807 set x [expr {$hoverx + 2 * $linespc}]
4808 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4809 set x0 [expr {$x - 2 * $lthickness}]
4810 set y0 [expr {$y - 2 * $lthickness}]
4811 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4812 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4813 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4814 -fill \#ffff80 -outline black -width 1 -tags hover]
4816 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4821 proc clickisonarrow {id y} {
4824 set ranges [rowranges $id]
4825 set thresh [expr {2 * $lthickness + 6}]
4826 set n [expr {[llength $ranges] - 1}]
4827 for {set i 1} {$i < $n} {incr i} {
4828 set row [lindex $ranges $i]
4829 if {abs([yc $row] - $y) < $thresh} {
4836 proc arrowjump {id n y} {
4839 # 1 <-> 2, 3 <-> 4, etc...
4840 set n [expr {(($n - 1) ^ 1) + 1}]
4841 set row [lindex [rowranges $id] $n]
4843 set ymax [lindex [$canv cget -scrollregion] 3]
4844 if {$ymax eq {} || $ymax <= 0} return
4845 set view [$canv yview]
4846 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4847 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4851 allcanvs yview moveto $yfrac
4854 proc lineclick {x y id isnew} {
4855 global ctext commitinfo children canv thickerline curview
4857 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4862 # draw this line thicker than normal
4866 set ymax [lindex [$canv cget -scrollregion] 3]
4867 if {$ymax eq {}} return
4868 set yfrac [lindex [$canv yview] 0]
4869 set y [expr {$y + $yfrac * $ymax}]
4871 set dirn [clickisonarrow $id $y]
4873 arrowjump $id $dirn $y
4878 addtohistory [list lineclick $x $y $id 0]
4880 # fill the details pane with info about this line
4881 $ctext conf -state normal
4883 $ctext tag conf link -foreground blue -underline 1
4884 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4885 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4886 $ctext insert end "Parent:\t"
4887 $ctext insert end $id [list link link0]
4888 $ctext tag bind link0 <1> [list selbyid $id]
4889 set info $commitinfo($id)
4890 $ctext insert end "\n\t[lindex $info 0]\n"
4891 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4892 set date [formatdate [lindex $info 2]]
4893 $ctext insert end "\tDate:\t$date\n"
4894 set kids $children($curview,$id)
4896 $ctext insert end "\nChildren:"
4898 foreach child $kids {
4900 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4901 set info $commitinfo($child)
4902 $ctext insert end "\n\t"
4903 $ctext insert end $child [list link link$i]
4904 $ctext tag bind link$i <1> [list selbyid $child]
4905 $ctext insert end "\n\t[lindex $info 0]"
4906 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4907 set date [formatdate [lindex $info 2]]
4908 $ctext insert end "\n\tDate:\t$date\n"
4911 $ctext conf -state disabled
4915 proc normalline {} {
4917 if {[info exists thickerline]} {
4925 global commitrow curview
4926 if {[info exists commitrow($curview,$id)]} {
4927 selectline $commitrow($curview,$id) 1
4933 if {![info exists startmstime]} {
4934 set startmstime [clock clicks -milliseconds]
4936 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4939 proc rowmenu {x y id} {
4940 global rowctxmenu commitrow selectedline rowmenuid curview
4942 if {![info exists selectedline]
4943 || $commitrow($curview,$id) eq $selectedline} {
4948 $rowctxmenu entryconfigure "Diff this*" -state $state
4949 $rowctxmenu entryconfigure "Diff selected*" -state $state
4950 $rowctxmenu entryconfigure "Make patch" -state $state
4952 tk_popup $rowctxmenu $x $y
4955 proc diffvssel {dirn} {
4956 global rowmenuid selectedline displayorder
4958 if {![info exists selectedline]} return
4960 set oldid [lindex $displayorder $selectedline]
4961 set newid $rowmenuid
4963 set oldid $rowmenuid
4964 set newid [lindex $displayorder $selectedline]
4966 addtohistory [list doseldiff $oldid $newid]
4967 doseldiff $oldid $newid
4970 proc doseldiff {oldid newid} {
4974 $ctext conf -state normal
4977 $ctext insert end "From "
4978 $ctext tag conf link -foreground blue -underline 1
4979 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4980 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4981 $ctext tag bind link0 <1> [list selbyid $oldid]
4982 $ctext insert end $oldid [list link link0]
4983 $ctext insert end "\n "
4984 $ctext insert end [lindex $commitinfo($oldid) 0]
4985 $ctext insert end "\n\nTo "
4986 $ctext tag bind link1 <1> [list selbyid $newid]
4987 $ctext insert end $newid [list link link1]
4988 $ctext insert end "\n "
4989 $ctext insert end [lindex $commitinfo($newid) 0]
4990 $ctext insert end "\n"
4991 $ctext conf -state disabled
4992 $ctext tag delete Comments
4993 $ctext tag remove found 1.0 end
4994 startdiff [list $oldid $newid]
4998 global rowmenuid currentid commitinfo patchtop patchnum
5000 if {![info exists currentid]} return
5001 set oldid $currentid
5002 set oldhead [lindex $commitinfo($oldid) 0]
5003 set newid $rowmenuid
5004 set newhead [lindex $commitinfo($newid) 0]
5007 catch {destroy $top}
5009 label $top.title -text "Generate patch"
5010 grid $top.title - -pady 10
5011 label $top.from -text "From:"
5012 entry $top.fromsha1 -width 40 -relief flat
5013 $top.fromsha1 insert 0 $oldid
5014 $top.fromsha1 conf -state readonly
5015 grid $top.from $top.fromsha1 -sticky w
5016 entry $top.fromhead -width 60 -relief flat
5017 $top.fromhead insert 0 $oldhead
5018 $top.fromhead conf -state readonly
5019 grid x $top.fromhead -sticky w
5020 label $top.to -text "To:"
5021 entry $top.tosha1 -width 40 -relief flat
5022 $top.tosha1 insert 0 $newid
5023 $top.tosha1 conf -state readonly
5024 grid $top.to $top.tosha1 -sticky w
5025 entry $top.tohead -width 60 -relief flat
5026 $top.tohead insert 0 $newhead
5027 $top.tohead conf -state readonly
5028 grid x $top.tohead -sticky w
5029 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5030 grid $top.rev x -pady 10
5031 label $top.flab -text "Output file:"
5032 entry $top.fname -width 60
5033 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5035 grid $top.flab $top.fname -sticky w
5037 button $top.buts.gen -text "Generate" -command mkpatchgo
5038 button $top.buts.can -text "Cancel" -command mkpatchcan
5039 grid $top.buts.gen $top.buts.can
5040 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5041 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5042 grid $top.buts - -pady 10 -sticky ew
5046 proc mkpatchrev {} {
5049 set oldid [$patchtop.fromsha1 get]
5050 set oldhead [$patchtop.fromhead get]
5051 set newid [$patchtop.tosha1 get]
5052 set newhead [$patchtop.tohead get]
5053 foreach e [list fromsha1 fromhead tosha1 tohead] \
5054 v [list $newid $newhead $oldid $oldhead] {
5055 $patchtop.$e conf -state normal
5056 $patchtop.$e delete 0 end
5057 $patchtop.$e insert 0 $v
5058 $patchtop.$e conf -state readonly
5065 set oldid [$patchtop.fromsha1 get]
5066 set newid [$patchtop.tosha1 get]
5067 set fname [$patchtop.fname get]
5068 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5069 error_popup "Error creating patch: $err"
5071 catch {destroy $patchtop}
5075 proc mkpatchcan {} {
5078 catch {destroy $patchtop}
5083 global rowmenuid mktagtop commitinfo
5087 catch {destroy $top}
5089 label $top.title -text "Create tag"
5090 grid $top.title - -pady 10
5091 label $top.id -text "ID:"
5092 entry $top.sha1 -width 40 -relief flat
5093 $top.sha1 insert 0 $rowmenuid
5094 $top.sha1 conf -state readonly
5095 grid $top.id $top.sha1 -sticky w
5096 entry $top.head -width 60 -relief flat
5097 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5098 $top.head conf -state readonly
5099 grid x $top.head -sticky w
5100 label $top.tlab -text "Tag name:"
5101 entry $top.tag -width 60
5102 grid $top.tlab $top.tag -sticky w
5104 button $top.buts.gen -text "Create" -command mktaggo
5105 button $top.buts.can -text "Cancel" -command mktagcan
5106 grid $top.buts.gen $top.buts.can
5107 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5108 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5109 grid $top.buts - -pady 10 -sticky ew
5114 global mktagtop env tagids idtags
5116 set id [$mktagtop.sha1 get]
5117 set tag [$mktagtop.tag get]
5119 error_popup "No tag name specified"
5122 if {[info exists tagids($tag)]} {
5123 error_popup "Tag \"$tag\" already exists"
5128 set fname [file join $dir "refs/tags" $tag]
5129 set f [open $fname w]
5133 error_popup "Error creating tag: $err"
5137 set tagids($tag) $id
5138 lappend idtags($id) $tag
5143 proc redrawtags {id} {
5144 global canv linehtag commitrow idpos selectedline curview
5145 global mainfont canvxmax
5147 if {![info exists commitrow($curview,$id)]} return
5148 drawcmitrow $commitrow($curview,$id)
5149 $canv delete tag.$id
5150 set xt [eval drawtags $id $idpos($id)]
5151 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5152 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5153 set xr [expr {$xt + [font measure $mainfont $text]}]
5154 if {$xr > $canvxmax} {
5158 if {[info exists selectedline]
5159 && $selectedline == $commitrow($curview,$id)} {
5160 selectline $selectedline 0
5167 catch {destroy $mktagtop}
5176 proc writecommit {} {
5177 global rowmenuid wrcomtop commitinfo wrcomcmd
5179 set top .writecommit
5181 catch {destroy $top}
5183 label $top.title -text "Write commit to file"
5184 grid $top.title - -pady 10
5185 label $top.id -text "ID:"
5186 entry $top.sha1 -width 40 -relief flat
5187 $top.sha1 insert 0 $rowmenuid
5188 $top.sha1 conf -state readonly
5189 grid $top.id $top.sha1 -sticky w
5190 entry $top.head -width 60 -relief flat
5191 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5192 $top.head conf -state readonly
5193 grid x $top.head -sticky w
5194 label $top.clab -text "Command:"
5195 entry $top.cmd -width 60 -textvariable wrcomcmd
5196 grid $top.clab $top.cmd -sticky w -pady 10
5197 label $top.flab -text "Output file:"
5198 entry $top.fname -width 60
5199 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5200 grid $top.flab $top.fname -sticky w
5202 button $top.buts.gen -text "Write" -command wrcomgo
5203 button $top.buts.can -text "Cancel" -command wrcomcan
5204 grid $top.buts.gen $top.buts.can
5205 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5206 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5207 grid $top.buts - -pady 10 -sticky ew
5214 set id [$wrcomtop.sha1 get]
5215 set cmd "echo $id | [$wrcomtop.cmd get]"
5216 set fname [$wrcomtop.fname get]
5217 if {[catch {exec sh -c $cmd >$fname &} err]} {
5218 error_popup "Error writing commit: $err"
5220 catch {destroy $wrcomtop}
5227 catch {destroy $wrcomtop}
5232 global rowmenuid mkbrtop
5235 catch {destroy $top}
5237 label $top.title -text "Create new branch"
5238 grid $top.title - -pady 10
5239 label $top.id -text "ID:"
5240 entry $top.sha1 -width 40 -relief flat
5241 $top.sha1 insert 0 $rowmenuid
5242 $top.sha1 conf -state readonly
5243 grid $top.id $top.sha1 -sticky w
5244 label $top.nlab -text "Name:"
5245 entry $top.name -width 40
5246 grid $top.nlab $top.name -sticky w
5248 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5249 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5250 grid $top.buts.go $top.buts.can
5251 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5252 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5253 grid $top.buts - -pady 10 -sticky ew
5258 global headids idheads
5260 set name [$top.name get]
5261 set id [$top.sha1 get]
5263 error_popup "Please specify a name for the new branch"
5266 catch {destroy $top}
5270 exec git branch $name $id
5276 # XXX should update list of heads displayed for selected commit
5282 proc cherrypick {} {
5283 global rowmenuid curview commitrow
5284 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5286 if {[info exists desc_heads($rowmenuid)]
5287 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5288 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5289 included in branch $mainhead -- really re-apply it?"]
5294 set oldhead [exec git rev-parse HEAD]
5295 # Unfortunately git-cherry-pick writes stuff to stderr even when
5296 # no error occurs, and exec takes that as an indication of error...
5297 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5302 set newhead [exec git rev-parse HEAD]
5303 if {$newhead eq $oldhead} {
5305 error_popup "No changes committed"
5308 set allparents($newhead) $oldhead
5309 lappend allchildren($oldhead) $newhead
5310 set desc_heads($newhead) $mainhead
5311 if {[info exists anc_tags($oldhead)]} {
5312 set anc_tags($newhead) $anc_tags($oldhead)
5314 set desc_tags($newhead) {}
5315 if {[info exists commitrow($curview,$oldhead)]} {
5316 insertrow $commitrow($curview,$oldhead) $newhead
5317 if {$mainhead ne {}} {
5318 movedhead $newhead $mainhead
5326 # context menu for a head
5327 proc headmenu {x y id head} {
5328 global headmenuid headmenuhead headctxmenu
5331 set headmenuhead $head
5332 tk_popup $headctxmenu $x $y
5336 global headmenuid headmenuhead mainhead headids
5338 # check the tree is clean first??
5339 set oldmainhead $mainhead
5343 exec git checkout $headmenuhead
5349 set mainhead $headmenuhead
5350 if {[info exists headids($oldmainhead)]} {
5351 redrawtags $headids($oldmainhead)
5353 redrawtags $headmenuid
5358 global desc_heads headmenuid headmenuhead mainhead
5359 global headids idheads
5361 set head $headmenuhead
5363 if {$head eq $mainhead} {
5364 error_popup "Cannot delete the currently checked-out branch"
5367 if {$desc_heads($id) eq $head} {
5368 # the stuff on this branch isn't on any other branch
5369 if {![confirm_popup "The commits on branch $head aren't on any other\
5370 branch.\nReally delete branch $head?"]} return
5374 if {[catch {exec git branch -D $head} err]} {
5379 removedhead $id $head
5384 # Stuff for finding nearby tags
5385 proc getallcommits {} {
5386 global allcstart allcommits allcfd allids
5389 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5391 fconfigure $fd -blocking 0
5392 set allcommits "reading"
5397 proc discardallcommits {} {
5398 global allparents allchildren allcommits allcfd
5399 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5401 if {![info exists allcommits]} return
5402 if {$allcommits eq "reading"} {
5403 catch {close $allcfd}
5405 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5406 alldtags tagisdesc desc_heads} {
5411 proc restartgetall {fd} {
5414 fileevent $fd readable [list getallclines $fd]
5415 set allcstart [clock clicks -milliseconds]
5418 proc combine_dtags {l1 l2} {
5419 global tagisdesc notfirstd
5421 set res [lsort -unique [concat $l1 $l2]]
5422 for {set i 0} {$i < [llength $res]} {incr i} {
5423 set x [lindex $res $i]
5424 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5425 set y [lindex $res $j]
5426 if {[info exists tagisdesc($x,$y)]} {
5427 if {$tagisdesc($x,$y) > 0} {
5428 # x is a descendent of y, exclude x
5429 set res [lreplace $res $i $i]
5433 # y is a descendent of x, exclude y
5434 set res [lreplace $res $j $j]
5437 # no relation, keep going
5445 proc combine_atags {l1 l2} {
5448 set res [lsort -unique [concat $l1 $l2]]
5449 for {set i 0} {$i < [llength $res]} {incr i} {
5450 set x [lindex $res $i]
5451 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5452 set y [lindex $res $j]
5453 if {[info exists tagisdesc($x,$y)]} {
5454 if {$tagisdesc($x,$y) < 0} {
5455 # x is an ancestor of y, exclude x
5456 set res [lreplace $res $i $i]
5460 # y is an ancestor of x, exclude y
5461 set res [lreplace $res $j $j]
5464 # no relation, keep going
5472 proc forward_pass {id children} {
5473 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5477 foreach child $children {
5478 if {[info exists idtags($child)]} {
5479 set ctags [list $child]
5481 set ctags $desc_tags($child)
5485 } elseif {$ctags ne $dtags} {
5486 set dtags [combine_dtags $dtags $ctags]
5488 set cheads $desc_heads($child)
5489 if {$dheads eq {}} {
5491 } elseif {$cheads ne $dheads} {
5492 set dheads [lsort -unique [concat $dheads $cheads]]
5495 set desc_tags($id) $dtags
5496 if {[info exists idtags($id)]} {
5498 foreach tag $dtags {
5499 set adt [concat $adt $alldtags($tag)]
5501 set adt [lsort -unique $adt]
5502 set alldtags($id) $adt
5504 set tagisdesc($id,$tag) -1
5505 set tagisdesc($tag,$id) 1
5508 if {[info exists idheads($id)]} {
5509 set dheads [concat $dheads $idheads($id)]
5511 set desc_heads($id) $dheads
5514 proc getallclines {fd} {
5515 global allparents allchildren allcommits allcstart
5516 global desc_tags anc_tags idtags tagisdesc allids
5517 global idheads travindex
5519 while {[gets $fd line] >= 0} {
5520 set id [lindex $line 0]
5522 set olds [lrange $line 1 end]
5523 set allparents($id) $olds
5524 if {![info exists allchildren($id)]} {
5525 set allchildren($id) {}
5528 lappend allchildren($p) $id
5530 # compute nearest tagged descendents as we go
5531 # also compute descendent heads
5532 forward_pass $id $allchildren($id)
5533 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5534 fileevent $fd readable {}
5535 after idle restartgetall $fd
5540 set travindex [llength $allids]
5541 set allcommits "traversing"
5542 after idle restartatags
5543 if {[catch {close $fd} err]} {
5544 error_popup "Error reading full commit graph: $err.\n\
5545 Results may be incomplete."
5550 # walk backward through the tree and compute nearest tagged ancestors
5551 proc restartatags {} {
5552 global allids allparents idtags anc_tags travindex
5554 set t0 [clock clicks -milliseconds]
5556 while {[incr i -1] >= 0} {
5557 set id [lindex $allids $i]
5559 foreach p $allparents($id) {
5560 if {[info exists idtags($p)]} {
5563 set ptags $anc_tags($p)
5567 } elseif {$ptags ne $atags} {
5568 set atags [combine_atags $atags $ptags]
5571 set anc_tags($id) $atags
5572 if {[clock clicks -milliseconds] - $t0 >= 50} {
5574 after idle restartatags
5578 set allcommits "done"
5584 # update the desc_tags and anc_tags arrays for a new tag just added
5585 proc addedtag {id} {
5586 global desc_tags anc_tags allparents allchildren allcommits
5587 global idtags tagisdesc alldtags
5589 if {![info exists desc_tags($id)]} return
5590 set adt $desc_tags($id)
5591 foreach t $desc_tags($id) {
5592 set adt [concat $adt $alldtags($t)]
5594 set adt [lsort -unique $adt]
5595 set alldtags($id) $adt
5597 set tagisdesc($id,$t) -1
5598 set tagisdesc($t,$id) 1
5600 if {[info exists anc_tags($id)]} {
5601 set todo $anc_tags($id)
5602 while {$todo ne {}} {
5603 set do [lindex $todo 0]
5604 set todo [lrange $todo 1 end]
5605 if {[info exists tagisdesc($id,$do)]} continue
5606 set tagisdesc($do,$id) -1
5607 set tagisdesc($id,$do) 1
5608 if {[info exists anc_tags($do)]} {
5609 set todo [concat $todo $anc_tags($do)]
5614 set lastold $desc_tags($id)
5615 set lastnew [list $id]
5618 set todo $allparents($id)
5619 while {$todo ne {}} {
5620 set do [lindex $todo 0]
5621 set todo [lrange $todo 1 end]
5622 if {![info exists desc_tags($do)]} continue
5623 if {$desc_tags($do) ne $lastold} {
5624 set lastold $desc_tags($do)
5625 set lastnew [combine_dtags $lastold [list $id]]
5628 if {$lastold eq $lastnew} continue
5629 set desc_tags($do) $lastnew
5631 if {![info exists idtags($do)]} {
5632 set todo [concat $todo $allparents($do)]
5636 if {![info exists anc_tags($id)]} return
5637 set lastold $anc_tags($id)
5638 set lastnew [list $id]
5641 set todo $allchildren($id)
5642 while {$todo ne {}} {
5643 set do [lindex $todo 0]
5644 set todo [lrange $todo 1 end]
5645 if {![info exists anc_tags($do)]} continue
5646 if {$anc_tags($do) ne $lastold} {
5647 set lastold $anc_tags($do)
5648 set lastnew [combine_atags $lastold [list $id]]
5651 if {$lastold eq $lastnew} continue
5652 set anc_tags($do) $lastnew
5654 if {![info exists idtags($do)]} {
5655 set todo [concat $todo $allchildren($do)]
5660 # update the desc_heads array for a new head just added
5661 proc addedhead {hid head} {
5662 global desc_heads allparents headids idheads
5664 set headids($head) $hid
5665 lappend idheads($hid) $head
5667 set todo [list $hid]
5668 while {$todo ne {}} {
5669 set do [lindex $todo 0]
5670 set todo [lrange $todo 1 end]
5671 if {![info exists desc_heads($do)] ||
5672 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5673 set oldheads $desc_heads($do)
5674 lappend desc_heads($do) $head
5675 set heads $desc_heads($do)
5677 set p $allparents($do)
5678 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5679 $desc_heads($p) ne $oldheads} break
5681 set desc_heads($do) $heads
5683 set todo [concat $todo $p]
5687 # update the desc_heads array for a head just removed
5688 proc removedhead {hid head} {
5689 global desc_heads allparents headids idheads
5691 unset headids($head)
5692 if {$idheads($hid) eq $head} {
5695 set i [lsearch -exact $idheads($hid) $head]
5697 set idheads($hid) [lreplace $idheads($hid) $i $i]
5701 set todo [list $hid]
5702 while {$todo ne {}} {
5703 set do [lindex $todo 0]
5704 set todo [lrange $todo 1 end]
5705 if {![info exists desc_heads($do)]} continue
5706 set i [lsearch -exact $desc_heads($do) $head]
5707 if {$i < 0} continue
5708 set oldheads $desc_heads($do)
5709 set heads [lreplace $desc_heads($do) $i $i]
5711 set desc_heads($do) $heads
5712 set p $allparents($do)
5713 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5714 $desc_heads($p) ne $oldheads} break
5717 set todo [concat $todo $p]
5721 # update things for a head moved to a child of its previous location
5722 proc movedhead {id name} {
5723 global headids idheads
5725 set oldid $headids($name)
5726 set headids($name) $id
5727 if {$idheads($oldid) eq $name} {
5728 unset idheads($oldid)
5730 set i [lsearch -exact $idheads($oldid) $name]
5732 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5735 lappend idheads($id) $name
5738 proc changedrefs {} {
5739 global desc_heads desc_tags anc_tags allcommits allids
5740 global allchildren allparents idtags travindex
5742 if {![info exists allcommits]} return
5743 catch {unset desc_heads}
5744 catch {unset desc_tags}
5745 catch {unset anc_tags}
5746 catch {unset alldtags}
5747 catch {unset tagisdesc}
5748 foreach id $allids {
5749 forward_pass $id $allchildren($id)
5751 if {$allcommits ne "reading"} {
5752 set travindex [llength $allids]
5753 if {$allcommits ne "traversing"} {
5754 set allcommits "traversing"
5755 after idle restartatags
5760 proc rereadrefs {} {
5761 global idtags idheads idotherrefs mainhead
5763 set refids [concat [array names idtags] \
5764 [array names idheads] [array names idotherrefs]]
5765 foreach id $refids {
5766 if {![info exists ref($id)]} {
5767 set ref($id) [listrefs $id]
5770 set oldmainhead $mainhead
5773 set refids [lsort -unique [concat $refids [array names idtags] \
5774 [array names idheads] [array names idotherrefs]]]
5775 foreach id $refids {
5776 set v [listrefs $id]
5777 if {![info exists ref($id)] || $ref($id) != $v ||
5778 ($id eq $oldmainhead && $id ne $mainhead) ||
5779 ($id eq $mainhead && $id ne $oldmainhead)} {
5785 proc listrefs {id} {
5786 global idtags idheads idotherrefs
5789 if {[info exists idtags($id)]} {
5793 if {[info exists idheads($id)]} {
5797 if {[info exists idotherrefs($id)]} {
5798 set z $idotherrefs($id)
5800 return [list $x $y $z]
5803 proc showtag {tag isnew} {
5804 global ctext tagcontents tagids linknum
5807 addtohistory [list showtag $tag 0]
5809 $ctext conf -state normal
5812 if {[info exists tagcontents($tag)]} {
5813 set text $tagcontents($tag)
5815 set text "Tag: $tag\nId: $tagids($tag)"
5817 appendwithlinks $text {}
5818 $ctext conf -state disabled
5830 global maxwidth maxgraphpct diffopts
5831 global oldprefs prefstop showneartags
5832 global bgcolor fgcolor ctext diffcolors
5837 if {[winfo exists $top]} {
5841 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5842 set oldprefs($v) [set $v]
5845 wm title $top "Gitk preferences"
5846 label $top.ldisp -text "Commit list display options"
5847 $top.ldisp configure -font $uifont
5848 grid $top.ldisp - -sticky w -pady 10
5849 label $top.spacer -text " "
5850 label $top.maxwidthl -text "Maximum graph width (lines)" \
5852 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5853 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5854 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5856 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5857 grid x $top.maxpctl $top.maxpct -sticky w
5859 label $top.ddisp -text "Diff display options"
5860 $top.ddisp configure -font $uifont
5861 grid $top.ddisp - -sticky w -pady 10
5862 label $top.diffoptl -text "Options for diff program" \
5864 entry $top.diffopt -width 20 -textvariable diffopts
5865 grid x $top.diffoptl $top.diffopt -sticky w
5867 label $top.ntag.l -text "Display nearby tags" -font optionfont
5868 checkbutton $top.ntag.b -variable showneartags
5869 pack $top.ntag.b $top.ntag.l -side left
5870 grid x $top.ntag -sticky w
5872 label $top.cdisp -text "Colors: press to choose"
5873 $top.cdisp configure -font $uifont
5874 grid $top.cdisp - -sticky w -pady 10
5875 label $top.bg -padx 40 -relief sunk -background $bgcolor
5876 button $top.bgbut -text "Background" -font optionfont \
5877 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5878 grid x $top.bgbut $top.bg -sticky w
5879 label $top.fg -padx 40 -relief sunk -background $fgcolor
5880 button $top.fgbut -text "Foreground" -font optionfont \
5881 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5882 grid x $top.fgbut $top.fg -sticky w
5883 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5884 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5885 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5886 [list $ctext tag conf d0 -foreground]]
5887 grid x $top.diffoldbut $top.diffold -sticky w
5888 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5889 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5890 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5891 [list $ctext tag conf d1 -foreground]]
5892 grid x $top.diffnewbut $top.diffnew -sticky w
5893 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5894 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5895 -command [list choosecolor diffcolors 2 $top.hunksep \
5896 "diff hunk header" \
5897 [list $ctext tag conf hunksep -foreground]]
5898 grid x $top.hunksepbut $top.hunksep -sticky w
5901 button $top.buts.ok -text "OK" -command prefsok -default active
5902 $top.buts.ok configure -font $uifont
5903 button $top.buts.can -text "Cancel" -command prefscan -default normal
5904 $top.buts.can configure -font $uifont
5905 grid $top.buts.ok $top.buts.can
5906 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5907 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5908 grid $top.buts - - -pady 10 -sticky ew
5909 bind $top <Visibility> "focus $top.buts.ok"
5912 proc choosecolor {v vi w x cmd} {
5915 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5916 -title "Gitk: choose color for $x"]
5917 if {$c eq {}} return
5918 $w conf -background $c
5927 $w conf -background $c
5935 $w conf -foreground $c
5937 allcanvs itemconf text -fill $c
5938 $canv itemconf circle -outline $c
5942 global maxwidth maxgraphpct diffopts
5943 global oldprefs prefstop showneartags
5945 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5946 set $v $oldprefs($v)
5948 catch {destroy $prefstop}
5953 global maxwidth maxgraphpct
5954 global oldprefs prefstop showneartags
5956 catch {destroy $prefstop}
5958 if {$maxwidth != $oldprefs(maxwidth)
5959 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5961 } elseif {$showneartags != $oldprefs(showneartags)} {
5966 proc formatdate {d} {
5967 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5970 # This list of encoding names and aliases is distilled from
5971 # http://www.iana.org/assignments/character-sets.
5972 # Not all of them are supported by Tcl.
5973 set encoding_aliases {
5974 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5975 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5976 { ISO-10646-UTF-1 csISO10646UTF1 }
5977 { ISO_646.basic:1983 ref csISO646basic1983 }
5978 { INVARIANT csINVARIANT }
5979 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5980 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5981 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5982 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5983 { NATS-DANO iso-ir-9-1 csNATSDANO }
5984 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5985 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5986 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5987 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5988 { ISO-2022-KR csISO2022KR }
5990 { ISO-2022-JP csISO2022JP }
5991 { ISO-2022-JP-2 csISO2022JP2 }
5992 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5994 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5995 { IT iso-ir-15 ISO646-IT csISO15Italian }
5996 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5997 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5998 { greek7-old iso-ir-18 csISO18Greek7Old }
5999 { latin-greek iso-ir-19 csISO19LatinGreek }
6000 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6001 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6002 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6003 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6004 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6005 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6006 { INIS iso-ir-49 csISO49INIS }
6007 { INIS-8 iso-ir-50 csISO50INIS8 }
6008 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6009 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6010 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6011 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6012 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6013 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6015 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6016 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6017 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6018 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6019 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6020 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6021 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6022 { greek7 iso-ir-88 csISO88Greek7 }
6023 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6024 { iso-ir-90 csISO90 }
6025 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6026 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6027 csISO92JISC62991984b }
6028 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6029 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6030 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6031 csISO95JIS62291984handadd }
6032 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6033 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6034 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6035 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6037 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6038 { T.61-7bit iso-ir-102 csISO102T617bit }
6039 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6040 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6041 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6042 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6043 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6044 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6045 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6046 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6047 arabic csISOLatinArabic }
6048 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6049 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6050 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6051 greek greek8 csISOLatinGreek }
6052 { T.101-G2 iso-ir-128 csISO128T101G2 }
6053 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6055 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6056 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6057 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6058 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6059 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6060 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6061 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6062 csISOLatinCyrillic }
6063 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6064 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6065 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6066 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6067 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6068 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6069 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6070 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6071 { ISO_10367-box iso-ir-155 csISO10367Box }
6072 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6073 { latin-lap lap iso-ir-158 csISO158Lap }
6074 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6075 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6078 { JIS_X0201 X0201 csHalfWidthKatakana }
6079 { KSC5636 ISO646-KR csKSC5636 }
6080 { ISO-10646-UCS-2 csUnicode }
6081 { ISO-10646-UCS-4 csUCS4 }
6082 { DEC-MCS dec csDECMCS }
6083 { hp-roman8 roman8 r8 csHPRoman8 }
6084 { macintosh mac csMacintosh }
6085 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6087 { IBM038 EBCDIC-INT cp038 csIBM038 }
6088 { IBM273 CP273 csIBM273 }
6089 { IBM274 EBCDIC-BE CP274 csIBM274 }
6090 { IBM275 EBCDIC-BR cp275 csIBM275 }
6091 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6092 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6093 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6094 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6095 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6096 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6097 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6098 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6099 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6100 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6101 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6102 { IBM437 cp437 437 csPC8CodePage437 }
6103 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6104 { IBM775 cp775 csPC775Baltic }
6105 { IBM850 cp850 850 csPC850Multilingual }
6106 { IBM851 cp851 851 csIBM851 }
6107 { IBM852 cp852 852 csPCp852 }
6108 { IBM855 cp855 855 csIBM855 }
6109 { IBM857 cp857 857 csIBM857 }
6110 { IBM860 cp860 860 csIBM860 }
6111 { IBM861 cp861 861 cp-is csIBM861 }
6112 { IBM862 cp862 862 csPC862LatinHebrew }
6113 { IBM863 cp863 863 csIBM863 }
6114 { IBM864 cp864 csIBM864 }
6115 { IBM865 cp865 865 csIBM865 }
6116 { IBM866 cp866 866 csIBM866 }
6117 { IBM868 CP868 cp-ar csIBM868 }
6118 { IBM869 cp869 869 cp-gr csIBM869 }
6119 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6120 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6121 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6122 { IBM891 cp891 csIBM891 }
6123 { IBM903 cp903 csIBM903 }
6124 { IBM904 cp904 904 csIBBM904 }
6125 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6126 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6127 { IBM1026 CP1026 csIBM1026 }
6128 { EBCDIC-AT-DE csIBMEBCDICATDE }
6129 { EBCDIC-AT-DE-A csEBCDICATDEA }
6130 { EBCDIC-CA-FR csEBCDICCAFR }
6131 { EBCDIC-DK-NO csEBCDICDKNO }
6132 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6133 { EBCDIC-FI-SE csEBCDICFISE }
6134 { EBCDIC-FI-SE-A csEBCDICFISEA }
6135 { EBCDIC-FR csEBCDICFR }
6136 { EBCDIC-IT csEBCDICIT }
6137 { EBCDIC-PT csEBCDICPT }
6138 { EBCDIC-ES csEBCDICES }
6139 { EBCDIC-ES-A csEBCDICESA }
6140 { EBCDIC-ES-S csEBCDICESS }
6141 { EBCDIC-UK csEBCDICUK }
6142 { EBCDIC-US csEBCDICUS }
6143 { UNKNOWN-8BIT csUnknown8BiT }
6144 { MNEMONIC csMnemonic }
6149 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6150 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6151 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6152 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6153 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6154 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6155 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6156 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6157 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6158 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6159 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6160 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6161 { IBM1047 IBM-1047 }
6162 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6163 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6164 { UNICODE-1-1 csUnicode11 }
6167 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6168 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6170 { ISO-8859-15 ISO_8859-15 Latin-9 }
6171 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6172 { GBK CP936 MS936 windows-936 }
6173 { JIS_Encoding csJISEncoding }
6174 { Shift_JIS MS_Kanji csShiftJIS }
6175 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6177 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6178 { ISO-10646-UCS-Basic csUnicodeASCII }
6179 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6180 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6181 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6182 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6183 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6184 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6185 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6186 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6187 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6188 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6189 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6190 { Ventura-US csVenturaUS }
6191 { Ventura-International csVenturaInternational }
6192 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6193 { PC8-Turkish csPC8Turkish }
6194 { IBM-Symbols csIBMSymbols }
6195 { IBM-Thai csIBMThai }
6196 { HP-Legal csHPLegal }
6197 { HP-Pi-font csHPPiFont }
6198 { HP-Math8 csHPMath8 }
6199 { Adobe-Symbol-Encoding csHPPSMath }
6200 { HP-DeskTop csHPDesktop }
6201 { Ventura-Math csVenturaMath }
6202 { Microsoft-Publishing csMicrosoftPublishing }
6203 { Windows-31J csWindows31J }
6208 proc tcl_encoding {enc} {
6209 global encoding_aliases
6210 set names [encoding names]
6211 set lcnames [string tolower $names]
6212 set enc [string tolower $enc]
6213 set i [lsearch -exact $lcnames $enc]
6215 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6216 if {[regsub {^iso[-_]} $enc iso encx]} {
6217 set i [lsearch -exact $lcnames $encx]
6221 foreach l $encoding_aliases {
6222 set ll [string tolower $l]
6223 if {[lsearch -exact $ll $enc] < 0} continue
6224 # look through the aliases for one that tcl knows about
6226 set i [lsearch -exact $lcnames $e]
6228 if {[regsub {^iso[-_]} $e iso ex]} {
6229 set i [lsearch -exact $lcnames $ex]
6238 return [lindex $names $i]
6245 set diffopts "-U 5 -p"
6246 set wrcomcmd "git diff-tree --stdin -p --pretty"
6250 set gitencoding [exec git config --get i18n.commitencoding]
6252 if {$gitencoding == ""} {
6253 set gitencoding "utf-8"
6255 set tclencoding [tcl_encoding $gitencoding]
6256 if {$tclencoding == {}} {
6257 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6260 set mainfont {Helvetica 9}
6261 set textfont {Courier 9}
6262 set uifont {Helvetica 9 bold}
6263 set findmergefiles 0
6271 set cmitmode "patch"
6272 set wrapcomment "none"
6275 set colors {green red blue magenta darkgrey brown orange}
6278 set diffcolors {red "#00a000" blue}
6280 catch {source ~/.gitk}
6282 font create optionfont -family sans-serif -size -12
6286 switch -regexp -- $arg {
6288 "^-d" { set datemode 1 }
6290 lappend revtreeargs $arg
6295 # check that we can find a .git directory somewhere...
6297 if {![file isdirectory $gitdir]} {
6298 show_error {} . "Cannot find the git directory \"$gitdir\"."
6302 set cmdline_files {}
6303 set i [lsearch -exact $revtreeargs "--"]
6305 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6306 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6307 } elseif {$revtreeargs ne {}} {
6309 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6310 set cmdline_files [split $f "\n"]
6311 set n [llength $cmdline_files]
6312 set revtreeargs [lrange $revtreeargs 0 end-$n]
6314 # unfortunately we get both stdout and stderr in $err,
6315 # so look for "fatal:".
6316 set i [string first "fatal:" $err]
6318 set err [string range $err [expr {$i + 6}] end]
6320 show_error {} . "Bad arguments to gitk:\n$err"
6329 set highlight_paths {}
6330 set searchdirn -forwards
6339 set selectedhlview None
6350 wm title . "[file tail $argv0]: [file tail [pwd]]"
6353 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6354 # create a view for the files/dirs specified on the command line
6358 set viewname(1) "Command line"
6359 set viewfiles(1) $cmdline_files
6360 set viewargs(1) $revtreeargs
6363 .bar.view entryconf Edit* -state normal
6364 .bar.view entryconf Delete* -state normal
6367 if {[info exists permviews]} {
6368 foreach v $permviews {
6371 set viewname($n) [lindex $v 0]
6372 set viewfiles($n) [lindex $v 1]
6373 set viewargs($n) [lindex $v 2]