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 selectbgcolor
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 -selectbackground $selectbgcolor \
461 -background $bgcolor -bd 0 \
462 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
463 .tf.histframe.pwclist add
$canv
464 set canv2 .tf.histframe.pwclist.canv2
466 -selectbackground $selectbgcolor \
467 -background $bgcolor -bd 0 -yscrollincr $linespc
468 .tf.histframe.pwclist add
$canv2
469 set canv3 .tf.histframe.pwclist.canv3
471 -selectbackground $selectbgcolor \
472 -background $bgcolor -bd 0 -yscrollincr $linespc
473 .tf.histframe.pwclist add
$canv3
474 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
475 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
477 # a scroll bar to rule them
478 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
479 pack
$cscroll -side right
-fill y
480 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
481 lappend bglist
$canv $canv2 $canv3
482 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
484 # we have two button bars at bottom of top frame. Bar 1
486 frame .tf.lbar
-height 15
488 set sha1entry .tf.bar.sha1
489 set entries
$sha1entry
490 set sha1but .tf.bar.sha1label
491 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
492 -command gotocommit
-width 8 -font $uifont
493 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
494 pack .tf.bar.sha1label
-side left
495 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
496 trace add variable sha1string
write sha1change
497 pack
$sha1entry -side left
-pady 2
499 image create bitmap bm-left
-data {
500 #define left_width 16
501 #define left_height 16
502 static unsigned char left_bits
[] = {
503 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
504 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
505 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
507 image create bitmap bm-right
-data {
508 #define right_width 16
509 #define right_height 16
510 static unsigned char right_bits
[] = {
511 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
512 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
513 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
515 button .tf.bar.leftbut
-image bm-left
-command goback \
516 -state disabled
-width 26
517 pack .tf.bar.leftbut
-side left
-fill y
518 button .tf.bar.rightbut
-image bm-right
-command goforw \
519 -state disabled
-width 26
520 pack .tf.bar.rightbut
-side left
-fill y
522 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
523 pack .tf.bar.findbut
-side left
525 set fstring .tf.bar.findstring
526 lappend entries
$fstring
527 entry
$fstring -width 30 -font $textfont -textvariable findstring
528 trace add variable findstring
write find_change
529 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
531 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
532 findtype Exact IgnCase Regexp
]
533 trace add variable findtype
write find_change
534 .tf.bar.findtype configure
-font $uifont
535 .tf.bar.findtype.menu configure
-font $uifont
536 set findloc
"All fields"
537 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
538 Comments Author Committer
539 trace add variable findloc
write find_change
540 .tf.bar.findloc configure
-font $uifont
541 .tf.bar.findloc.menu configure
-font $uifont
542 pack .tf.bar.findloc
-side right
543 pack .tf.bar.findtype
-side right
545 # build up the bottom bar of upper window
546 label .tf.lbar.flabel
-text "Highlight: Commits " \
548 pack .tf.lbar.flabel
-side left
-fill y
549 set gdttype
"touching paths:"
550 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
551 "adding/removing string:"]
552 trace add variable gdttype
write hfiles_change
553 $gm conf
-font $uifont
554 .tf.lbar.gdttype conf
-font $uifont
555 pack .tf.lbar.gdttype
-side left
-fill y
556 entry .tf.lbar.fent
-width 25 -font $textfont \
557 -textvariable highlight_files
558 trace add variable highlight_files
write hfiles_change
559 lappend entries .tf.lbar.fent
560 pack .tf.lbar.fent
-side left
-fill x
-expand 1
561 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
562 pack .tf.lbar.vlabel
-side left
-fill y
563 global viewhlmenu selectedhlview
564 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
565 $viewhlmenu entryconf None
-command delvhighlight
566 $viewhlmenu conf
-font $uifont
567 .tf.lbar.vhl conf
-font $uifont
568 pack .tf.lbar.vhl
-side left
-fill y
569 label .tf.lbar.rlabel
-text " OR " -font $uifont
570 pack .tf.lbar.rlabel
-side left
-fill y
571 global highlight_related
572 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
573 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
574 $m conf
-font $uifont
575 .tf.lbar.relm conf
-font $uifont
576 trace add variable highlight_related
write vrel_change
577 pack .tf.lbar.relm
-side left
-fill y
579 # Finish putting the upper half of the viewer together
580 pack .tf.lbar
-in .tf
-side bottom
-fill x
581 pack .tf.bar
-in .tf
-side bottom
-fill x
582 pack .tf.histframe
-fill both
-side top
-expand 1
584 .ctop paneconfigure .tf
-height $geometry(topheight
)
585 .ctop paneconfigure .tf
-width $geometry(topwidth
)
587 # now build up the bottom
588 panedwindow .pwbottom
-orient horizontal
590 # lower left, a text box over search bar, scroll bar to the right
591 # if we know window height, then that will set the lower text height, otherwise
592 # we set lower text height which will drive window height
593 if {[info exists geometry
(main
)]} {
594 frame .bleft
-width $geometry(botwidth
)
596 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
601 button .bleft.top.search
-text "Search" -command dosearch \
603 pack .bleft.top.search
-side left
-padx 5
604 set sstring .bleft.top.sstring
605 entry
$sstring -width 20 -font $textfont -textvariable searchstring
606 lappend entries
$sstring
607 trace add variable searchstring
write incrsearch
608 pack
$sstring -side left
-expand 1 -fill x
609 radiobutton .bleft.mid.
diff -text "Diff" \
610 -command changediffdisp
-variable diffelide
-value {0 0}
611 radiobutton .bleft.mid.old
-text "Old version" \
612 -command changediffdisp
-variable diffelide
-value {0 1}
613 radiobutton .bleft.mid.new
-text "New version" \
614 -command changediffdisp
-variable diffelide
-value {1 0}
615 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
616 set ctext .bleft.ctext
617 text
$ctext -background $bgcolor -foreground $fgcolor \
618 -state disabled
-font $textfont \
619 -yscrollcommand scrolltext
-wrap none
620 scrollbar .bleft.sb
-command "$ctext yview"
621 pack .bleft.top
-side top
-fill x
622 pack .bleft.mid
-side top
-fill x
623 pack .bleft.sb
-side right
-fill y
624 pack
$ctext -side left
-fill both
-expand 1
625 lappend bglist
$ctext
626 lappend fglist
$ctext
628 $ctext tag conf comment
-wrap $wrapcomment
629 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
630 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
631 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
632 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
633 $ctext tag conf m0
-fore red
634 $ctext tag conf m1
-fore blue
635 $ctext tag conf m2
-fore green
636 $ctext tag conf m3
-fore purple
637 $ctext tag conf
m4 -fore brown
638 $ctext tag conf m5
-fore "#009090"
639 $ctext tag conf m6
-fore magenta
640 $ctext tag conf m7
-fore "#808000"
641 $ctext tag conf m8
-fore "#009000"
642 $ctext tag conf m9
-fore "#ff0080"
643 $ctext tag conf m10
-fore cyan
644 $ctext tag conf m11
-fore "#b07070"
645 $ctext tag conf m12
-fore "#70b0f0"
646 $ctext tag conf m13
-fore "#70f0b0"
647 $ctext tag conf m14
-fore "#f0b070"
648 $ctext tag conf m15
-fore "#ff70b0"
649 $ctext tag conf mmax
-fore darkgrey
651 $ctext tag conf mresult
-font [concat
$textfont bold
]
652 $ctext tag conf msep
-font [concat
$textfont bold
]
653 $ctext tag conf found
-back yellow
656 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
661 radiobutton .bright.mode.
patch -text "Patch" \
662 -command reselectline
-variable cmitmode
-value "patch"
663 .bright.mode.
patch configure
-font $uifont
664 radiobutton .bright.mode.tree
-text "Tree" \
665 -command reselectline
-variable cmitmode
-value "tree"
666 .bright.mode.tree configure
-font $uifont
667 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
668 pack .bright.mode
-side top
-fill x
669 set cflist .bright.cfiles
670 set indent
[font measure
$mainfont "nn"]
672 -selectbackground $selectbgcolor \
673 -background $bgcolor -foreground $fgcolor \
675 -tabs [list
$indent [expr {2 * $indent}]] \
676 -yscrollcommand ".bright.sb set" \
677 -cursor [. cget
-cursor] \
678 -spacing1 1 -spacing3 1
679 lappend bglist
$cflist
680 lappend fglist
$cflist
681 scrollbar .bright.sb
-command "$cflist yview"
682 pack .bright.sb
-side right
-fill y
683 pack
$cflist -side left
-fill both
-expand 1
684 $cflist tag configure highlight \
685 -background [$cflist cget
-selectbackground]
686 $cflist tag configure bold
-font [concat
$mainfont bold
]
688 .pwbottom add .bright
691 # restore window position if known
692 if {[info exists geometry
(main
)]} {
693 wm geometry .
"$geometry(main)"
696 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
697 pack .ctop
-fill both
-expand 1
698 bindall
<1> {selcanvline
%W
%x
%y
}
699 #bindall <B1-Motion> {selcanvline %W %x %y}
700 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
701 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
702 bindall
<2> "canvscan mark %W %x %y"
703 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
704 bindkey
<Home
> selfirstline
705 bindkey
<End
> sellastline
706 bind .
<Key-Up
> "selnextline -1"
707 bind .
<Key-Down
> "selnextline 1"
708 bind .
<Shift-Key-Up
> "next_highlight -1"
709 bind .
<Shift-Key-Down
> "next_highlight 1"
710 bindkey
<Key-Right
> "goforw"
711 bindkey
<Key-Left
> "goback"
712 bind .
<Key-Prior
> "selnextpage -1"
713 bind .
<Key-Next
> "selnextpage 1"
714 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
715 bind .
<Control-End
> "allcanvs yview moveto 1.0"
716 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
717 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
718 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
719 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
720 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
721 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
722 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
723 bindkey p
"selnextline -1"
724 bindkey n
"selnextline 1"
727 bindkey i
"selnextline -1"
728 bindkey k
"selnextline 1"
731 bindkey b
"$ctext yview scroll -1 pages"
732 bindkey d
"$ctext yview scroll 18 units"
733 bindkey u
"$ctext yview scroll -18 units"
734 bindkey
/ {findnext
1}
735 bindkey
<Key-Return
> {findnext
0}
738 bindkey
<F5
> updatecommits
739 bind .
<Control-q
> doquit
740 bind .
<Control-f
> dofind
741 bind .
<Control-g
> {findnext
0}
742 bind .
<Control-r
> dosearchback
743 bind .
<Control-s
> dosearch
744 bind .
<Control-equal
> {incrfont
1}
745 bind .
<Control-KP_Add
> {incrfont
1}
746 bind .
<Control-minus
> {incrfont
-1}
747 bind .
<Control-KP_Subtract
> {incrfont
-1}
748 wm protocol . WM_DELETE_WINDOW doquit
749 bind .
<Button-1
> "click %W"
750 bind $fstring <Key-Return
> dofind
751 bind $sha1entry <Key-Return
> gotocommit
752 bind $sha1entry <<PasteSelection>> clearsha1
753 bind $cflist <1> {sel_flist %W %x %y; break}
754 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
755 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
757 set maincursor [. cget -cursor]
758 set textcursor [$ctext cget -cursor]
759 set curtextcursor $textcursor
761 set rowctxmenu .rowctxmenu
762 menu $rowctxmenu -tearoff 0
763 $rowctxmenu add command -label "Diff this -> selected" \
764 -command {diffvssel 0}
765 $rowctxmenu add command -label "Diff selected -> this" \
766 -command {diffvssel 1}
767 $rowctxmenu add command -label "Make patch" -command mkpatch
768 $rowctxmenu add command -label "Create tag" -command mktag
769 $rowctxmenu add command -label "Write commit to file" -command writecommit
770 $rowctxmenu add command -label "Create new branch" -command mkbranch
771 $rowctxmenu add command -label "Cherry-pick this commit" \
774 set headctxmenu .headctxmenu
775 menu $headctxmenu -tearoff 0
776 $headctxmenu add command -label "Check out this branch" \
778 $headctxmenu add command -label "Remove this branch" \
782 # mouse-2 makes all windows scan vertically, but only the one
783 # the cursor is in scans horizontally
784 proc canvscan {op w x y} {
785 global canv canv2 canv3
786 foreach c [list $canv $canv2 $canv3] {
795 proc scrollcanv {cscroll f0 f1} {
801 # when we make a key binding for the toplevel, make sure
802 # it doesn't get triggered when that key is pressed in the
803 # find string entry widget.
804 proc bindkey {ev script} {
807 set escript [bind Entry $ev]
808 if {$escript == {}} {
809 set escript [bind Entry <Key>]
812 bind $e $ev "$escript; break"
816 # set the focus back to the toplevel for any click outside
827 global canv canv2 canv3 ctext cflist mainfont textfont uifont
828 global stuffsaved findmergefiles maxgraphpct
829 global maxwidth showneartags
830 global viewname viewfiles viewargs viewperm nextviewnum
831 global cmitmode wrapcomment
832 global colors bgcolor fgcolor diffcolors selectbgcolor
834 if {$stuffsaved} return
835 if {![winfo viewable .]} return
837 set f [open "~/.gitk-new" w]
838 puts $f [list set mainfont $mainfont]
839 puts $f [list set textfont $textfont]
840 puts $f [list set uifont $uifont]
841 puts $f [list set findmergefiles $findmergefiles]
842 puts $f [list set maxgraphpct $maxgraphpct]
843 puts $f [list set maxwidth $maxwidth]
844 puts $f [list set cmitmode $cmitmode]
845 puts $f [list set wrapcomment $wrapcomment]
846 puts $f [list set showneartags $showneartags]
847 puts $f [list set bgcolor $bgcolor]
848 puts $f [list set fgcolor $fgcolor]
849 puts $f [list set colors $colors]
850 puts $f [list set diffcolors $diffcolors]
851 puts $f [list set selectbgcolor $selectbgcolor]
853 puts $f "set geometry(main) [wm geometry .]"
854 puts $f "set geometry(topwidth) [winfo width .tf]"
855 puts $f "set geometry(topheight) [winfo height .tf]"
856 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
857 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
858 puts $f "set geometry(botwidth) [winfo width .bleft]"
859 puts $f "set geometry(botheight) [winfo height .bleft]"
861 puts -nonewline $f "set permviews {"
862 for {set v 0} {$v < $nextviewnum} {incr v} {
864 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
869 file rename -force "~/.gitk-new" "~/.gitk"
874 proc resizeclistpanes {win w} {
876 if {[info exists oldwidth($win)]} {
877 set s0 [$win sash coord 0]
878 set s1 [$win sash coord 1]
880 set sash0 [expr {int($w/2 - 2)}]
881 set sash1 [expr {int($w*5/6 - 2)}]
883 set factor [expr {1.0 * $w / $oldwidth($win)}]
884 set sash0 [expr {int($factor * [lindex $s0 0])}]
885 set sash1 [expr {int($factor * [lindex $s1 0])}]
889 if {$sash1 < $sash0 + 20} {
890 set sash1 [expr {$sash0 + 20}]
892 if {$sash1 > $w - 10} {
893 set sash1 [expr {$w - 10}]
894 if {$sash0 > $sash1 - 20} {
895 set sash0 [expr {$sash1 - 20}]
899 $win sash place 0 $sash0 [lindex $s0 1]
900 $win sash place 1 $sash1 [lindex $s1 1]
902 set oldwidth($win) $w
905 proc resizecdetpanes {win w} {
907 if {[info exists oldwidth($win)]} {
908 set s0 [$win sash coord 0]
910 set sash0 [expr {int($w*3/4 - 2)}]
912 set factor [expr {1.0 * $w / $oldwidth($win)}]
913 set sash0 [expr {int($factor * [lindex $s0 0])}]
917 if {$sash0 > $w - 15} {
918 set sash0 [expr {$w - 15}]
921 $win sash place 0 $sash0 [lindex $s0 1]
923 set oldwidth($win) $w
927 global canv canv2 canv3
933 proc bindall {event action} {
934 global canv canv2 canv3
935 bind $canv $event $action
936 bind $canv2 $event $action
937 bind $canv3 $event $action
943 if {[winfo exists $w]} {
948 wm title $w "About gitk"
950 Gitk - a commit viewer for git
952 Copyright © 2005-2006 Paul Mackerras
954 Use and redistribute under the terms of the GNU General Public License} \
955 -justify center -aspect 400 -border 2 -bg white -relief groove
956 pack $w.m -side top -fill x -padx 2 -pady 2
957 $w.m configure -font $uifont
958 button $w.ok -text Close -command "destroy $w" -default active
959 pack $w.ok -side bottom
960 $w.ok configure -font $uifont
961 bind $w <Visibility> "focus $w.ok"
962 bind $w <Key-Escape> "destroy $w"
963 bind $w <Key-Return> "destroy $w"
969 if {[winfo exists $w]} {
974 wm title $w "Gitk key bindings"
979 <Home> Move to first commit
980 <End> Move to last commit
981 <Up>, p, i Move up one commit
982 <Down>, n, k Move down one commit
983 <Left>, z, j Go back in history list
984 <Right>, x, l Go forward in history list
985 <PageUp> Move up one page in commit list
986 <PageDown> Move down one page in commit list
987 <Ctrl-Home> Scroll to top of commit list
988 <Ctrl-End> Scroll to bottom of commit list
989 <Ctrl-Up> Scroll commit list up one line
990 <Ctrl-Down> Scroll commit list down one line
991 <Ctrl-PageUp> Scroll commit list up one page
992 <Ctrl-PageDown> Scroll commit list down one page
993 <Shift-Up> Move to previous highlighted line
994 <Shift-Down> Move to next highlighted line
995 <Delete>, b Scroll diff view up one page
996 <Backspace> Scroll diff view up one page
997 <Space> Scroll diff view down one page
998 u Scroll diff view up 18 lines
999 d Scroll diff view down 18 lines
1001 <Ctrl-G> Move to next find hit
1002 <Return> Move to next find hit
1003 / Move to next find hit, or redo find
1004 ? Move to previous find hit
1005 f Scroll diff view to next file
1006 <Ctrl-S> Search for next hit in diff view
1007 <Ctrl-R> Search for previous hit in diff view
1008 <Ctrl-KP+> Increase font size
1009 <Ctrl-plus> Increase font size
1010 <Ctrl-KP-> Decrease font size
1011 <Ctrl-minus> Decrease font size
1014 -justify left -bg white -border 2 -relief groove
1015 pack $w.m -side top -fill both -padx 2 -pady 2
1016 $w.m configure -font $uifont
1017 button $w.ok -text Close -command "destroy $w" -default active
1018 pack $w.ok -side bottom
1019 $w.ok configure -font $uifont
1020 bind $w <Visibility> "focus $w.ok"
1021 bind $w <Key-Escape> "destroy $w"
1022 bind $w <Key-Return> "destroy $w"
1025 # Procedures for manipulating the file list window at the
1026 # bottom right of the overall window.
1028 proc treeview {w l openlevs} {
1029 global treecontents treediropen treeheight treeparent treeindex
1039 set treecontents() {}
1040 $w conf -state normal
1042 while {[string range $f 0 $prefixend] ne $prefix} {
1043 if {$lev <= $openlevs} {
1044 $w mark set e:$treeindex($prefix) "end -1c"
1045 $w mark gravity e:$treeindex($prefix) left
1047 set treeheight($prefix) $ht
1048 incr ht [lindex $htstack end]
1049 set htstack [lreplace $htstack end end]
1050 set prefixend [lindex $prefendstack end]
1051 set prefendstack [lreplace $prefendstack end end]
1052 set prefix [string range $prefix 0 $prefixend]
1055 set tail [string range $f [expr {$prefixend+1}] end]
1056 while {[set slash [string first "/" $tail]] >= 0} {
1059 lappend prefendstack $prefixend
1060 incr prefixend [expr {$slash + 1}]
1061 set d [string range $tail 0 $slash]
1062 lappend treecontents($prefix) $d
1063 set oldprefix $prefix
1065 set treecontents($prefix) {}
1066 set treeindex($prefix) [incr ix]
1067 set treeparent($prefix) $oldprefix
1068 set tail [string range $tail [expr {$slash+1}] end]
1069 if {$lev <= $openlevs} {
1071 set treediropen($prefix) [expr {$lev < $openlevs}]
1072 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1073 $w mark set d:$ix "end -1c"
1074 $w mark gravity d:$ix left
1076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1078 $w image create end -align center -image $bm -padx 1 \
1080 $w insert end $d [highlight_tag $prefix]
1081 $w mark set s:$ix "end -1c"
1082 $w mark gravity s:$ix left
1087 if {$lev <= $openlevs} {
1090 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1092 $w insert end $tail [highlight_tag $f]
1094 lappend treecontents($prefix) $tail
1097 while {$htstack ne {}} {
1098 set treeheight($prefix) $ht
1099 incr ht [lindex $htstack end]
1100 set htstack [lreplace $htstack end end]
1102 $w conf -state disabled
1105 proc linetoelt {l} {
1106 global treeheight treecontents
1111 foreach e $treecontents($prefix) {
1116 if {[string index $e end] eq "/"} {
1117 set n $treeheight($prefix$e)
1129 proc highlight_tree {y prefix} {
1130 global treeheight treecontents cflist
1132 foreach e $treecontents($prefix) {
1134 if {[highlight_tag $path] ne {}} {
1135 $cflist tag add bold $y.0 "$y.0 lineend"
1138 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1139 set y [highlight_tree $y $path]
1145 proc treeclosedir {w dir} {
1146 global treediropen treeheight treeparent treeindex
1148 set ix $treeindex($dir)
1149 $w conf -state normal
1150 $w delete s:$ix e:$ix
1151 set treediropen($dir) 0
1152 $w image configure a:$ix -image tri-rt
1153 $w conf -state disabled
1154 set n [expr {1 - $treeheight($dir)}]
1155 while {$dir ne {}} {
1156 incr treeheight($dir) $n
1157 set dir $treeparent($dir)
1161 proc treeopendir {w dir} {
1162 global treediropen treeheight treeparent treecontents treeindex
1164 set ix $treeindex($dir)
1165 $w conf -state normal
1166 $w image configure a:$ix -image tri-dn
1167 $w mark set e:$ix s:$ix
1168 $w mark gravity e:$ix right
1171 set n [llength $treecontents($dir)]
1172 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1175 incr treeheight($x) $n
1177 foreach e $treecontents($dir) {
1179 if {[string index $e end] eq "/"} {
1180 set iy $treeindex($de)
1181 $w mark set d:$iy e:$ix
1182 $w mark gravity d:$iy left
1183 $w insert e:$ix $str
1184 set treediropen($de) 0
1185 $w image create e:$ix -align center -image tri-rt -padx 1 \
1187 $w insert e:$ix $e [highlight_tag $de]
1188 $w mark set s:$iy e:$ix
1189 $w mark gravity s:$iy left
1190 set treeheight($de) 1
1192 $w insert e:$ix $str
1193 $w insert e:$ix $e [highlight_tag $de]
1196 $w mark gravity e:$ix left
1197 $w conf -state disabled
1198 set treediropen($dir) 1
1199 set top [lindex [split [$w index @0,0] .] 0]
1200 set ht [$w cget -height]
1201 set l [lindex [split [$w index s:$ix] .] 0]
1204 } elseif {$l + $n + 1 > $top + $ht} {
1205 set top [expr {$l + $n + 2 - $ht}]
1213 proc treeclick {w x y} {
1214 global treediropen cmitmode ctext cflist cflist_top
1216 if {$cmitmode ne "tree"} return
1217 if {![info exists cflist_top]} return
1218 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1219 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1220 $cflist tag add highlight $l.0 "$l.0 lineend"
1226 set e [linetoelt $l]
1227 if {[string index $e end] ne "/"} {
1229 } elseif {$treediropen($e)} {
1236 proc setfilelist {id} {
1237 global treefilelist cflist
1239 treeview $cflist $treefilelist($id) 0
1242 image create bitmap tri-rt -background black -foreground blue -data {
1243 #define tri-rt_width 13
1244 #define tri-rt_height 13
1245 static unsigned char tri-rt_bits[] = {
1246 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1247 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1250 #define tri-rt-mask_width 13
1251 #define tri-rt-mask_height 13
1252 static unsigned char tri-rt-mask_bits[] = {
1253 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1254 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1257 image create bitmap tri-dn -background black -foreground blue -data {
1258 #define tri-dn_width 13
1259 #define tri-dn_height 13
1260 static unsigned char tri-dn_bits[] = {
1261 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1262 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1265 #define tri-dn-mask_width 13
1266 #define tri-dn-mask_height 13
1267 static unsigned char tri-dn-mask_bits[] = {
1268 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1269 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1273 proc init_flist {first} {
1274 global cflist cflist_top selectedline difffilestart
1276 $cflist conf -state normal
1277 $cflist delete 0.0 end
1279 $cflist insert end $first
1281 $cflist tag add highlight 1.0 "1.0 lineend"
1283 catch {unset cflist_top}
1285 $cflist conf -state disabled
1286 set difffilestart {}
1289 proc highlight_tag {f} {
1290 global highlight_paths
1292 foreach p $highlight_paths {
1293 if {[string match $p $f]} {
1300 proc highlight_filelist {} {
1301 global cmitmode cflist
1303 $cflist conf -state normal
1304 if {$cmitmode ne "tree"} {
1305 set end [lindex [split [$cflist index end] .] 0]
1306 for {set l 2} {$l < $end} {incr l} {
1307 set line [$cflist get $l.0 "$l.0 lineend"]
1308 if {[highlight_tag $line] ne {}} {
1309 $cflist tag add bold $l.0 "$l.0 lineend"
1315 $cflist conf -state disabled
1318 proc unhighlight_filelist {} {
1321 $cflist conf -state normal
1322 $cflist tag remove bold 1.0 end
1323 $cflist conf -state disabled
1326 proc add_flist {fl} {
1329 $cflist conf -state normal
1331 $cflist insert end "\n"
1332 $cflist insert end $f [highlight_tag $f]
1334 $cflist conf -state disabled
1337 proc sel_flist {w x y} {
1338 global ctext difffilestart cflist cflist_top cmitmode
1340 if {$cmitmode eq "tree"} return
1341 if {![info exists cflist_top]} return
1342 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1343 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1344 $cflist tag add highlight $l.0 "$l.0 lineend"
1349 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1353 # Functions for adding and removing shell-type quoting
1355 proc shellquote {str} {
1356 if {![string match "*\['\"\\ \t]*" $str]} {
1359 if {![string match "*\['\"\\]*" $str]} {
1362 if {![string match "*'*" $str]} {
1365 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1368 proc shellarglist {l} {
1374 append str [shellquote $a]
1379 proc shelldequote {str} {
1384 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1385 append ret [string range $str $used end]
1386 set used [string length $str]
1389 set first [lindex $first 0]
1390 set ch [string index $str $first]
1391 if {$first > $used} {
1392 append ret [string range $str $used [expr {$first - 1}]]
1395 if {$ch eq " " || $ch eq "\t"} break
1398 set first [string first "'" $str $used]
1400 error "unmatched single-quote"
1402 append ret [string range $str $used [expr {$first - 1}]]
1407 if {$used >= [string length $str]} {
1408 error "trailing backslash"
1410 append ret [string index $str $used]
1415 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1416 error "unmatched double-quote"
1418 set first [lindex $first 0]
1419 set ch [string index $str $first]
1420 if {$first > $used} {
1421 append ret [string range $str $used [expr {$first - 1}]]
1424 if {$ch eq "\""} break
1426 append ret [string index $str $used]
1430 return [list $used $ret]
1433 proc shellsplit {str} {
1436 set str [string trimleft $str]
1437 if {$str eq {}} break
1438 set dq [shelldequote $str]
1439 set n [lindex $dq 0]
1440 set word [lindex $dq 1]
1441 set str [string range $str $n end]
1447 # Code to implement multiple views
1449 proc newview {ishighlight} {
1450 global nextviewnum newviewname newviewperm uifont newishighlight
1451 global newviewargs revtreeargs
1453 set newishighlight $ishighlight
1455 if {[winfo exists $top]} {
1459 set newviewname($nextviewnum) "View $nextviewnum"
1460 set newviewperm($nextviewnum) 0
1461 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1462 vieweditor $top $nextviewnum "Gitk view definition"
1467 global viewname viewperm newviewname newviewperm
1468 global viewargs newviewargs
1470 set top .gitkvedit-$curview
1471 if {[winfo exists $top]} {
1475 set newviewname($curview) $viewname($curview)
1476 set newviewperm($curview) $viewperm($curview)
1477 set newviewargs($curview) [shellarglist $viewargs($curview)]
1478 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1481 proc vieweditor {top n title} {
1482 global newviewname newviewperm viewfiles
1486 wm title $top $title
1487 label $top.nl -text "Name" -font $uifont
1488 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1489 grid $top.nl $top.name -sticky w -pady 5
1490 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1492 grid $top.perm - -pady 5 -sticky w
1493 message $top.al -aspect 1000 -font $uifont \
1494 -text "Commits to include (arguments to git rev-list):"
1495 grid $top.al - -sticky w -pady 5
1496 entry $top.args -width 50 -textvariable newviewargs($n) \
1497 -background white -font $uifont
1498 grid $top.args - -sticky ew -padx 5
1499 message $top.l -aspect 1000 -font $uifont \
1500 -text "Enter files and directories to include, one per line:"
1501 grid $top.l - -sticky w
1502 text $top.t -width 40 -height 10 -background white -font $uifont
1503 if {[info exists viewfiles($n)]} {
1504 foreach f $viewfiles($n) {
1505 $top.t insert end $f
1506 $top.t insert end "\n"
1508 $top.t delete {end - 1c} end
1509 $top.t mark set insert 0.0
1511 grid $top.t - -sticky ew -padx 5
1513 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1515 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1517 grid $top.buts.ok $top.buts.can
1518 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1519 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1520 grid $top.buts - -pady 10 -sticky ew
1524 proc doviewmenu {m first cmd op argv} {
1525 set nmenu [$m index end]
1526 for {set i $first} {$i <= $nmenu} {incr i} {
1527 if {[$m entrycget $i -command] eq $cmd} {
1528 eval $m $op $i $argv
1534 proc allviewmenus {n op args} {
1537 doviewmenu .bar.view 5 [list showview $n] $op $args
1538 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1541 proc newviewok {top n} {
1542 global nextviewnum newviewperm newviewname newishighlight
1543 global viewname viewfiles viewperm selectedview curview
1544 global viewargs newviewargs viewhlmenu
1547 set newargs [shellsplit $newviewargs($n)]
1549 error_popup "Error in commit selection arguments: $err"
1555 foreach f [split [$top.t get 0.0 end] "\n"] {
1556 set ft [string trim $f]
1561 if {![info exists viewfiles($n)]} {
1562 # creating a new view
1564 set viewname($n) $newviewname($n)
1565 set viewperm($n) $newviewperm($n)
1566 set viewfiles($n) $files
1567 set viewargs($n) $newargs
1569 if {!$newishighlight} {
1570 after idle showview $n
1572 after idle addvhighlight $n
1575 # editing an existing view
1576 set viewperm($n) $newviewperm($n)
1577 if {$newviewname($n) ne $viewname($n)} {
1578 set viewname($n) $newviewname($n)
1579 doviewmenu .bar.view 5 [list showview $n] \
1580 entryconf [list -label $viewname($n)]
1581 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1582 entryconf [list -label $viewname($n) -value $viewname($n)]
1584 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1585 set viewfiles($n) $files
1586 set viewargs($n) $newargs
1587 if {$curview == $n} {
1588 after idle updatecommits
1592 catch {destroy $top}
1596 global curview viewdata viewperm hlview selectedhlview
1598 if {$curview == 0} return
1599 if {[info exists hlview] && $hlview == $curview} {
1600 set selectedhlview None
1603 allviewmenus $curview delete
1604 set viewdata($curview) {}
1605 set viewperm($curview) 0
1609 proc addviewmenu {n} {
1610 global viewname viewhlmenu
1612 .bar.view add radiobutton -label $viewname($n) \
1613 -command [list showview $n] -variable selectedview -value $n
1614 $viewhlmenu add radiobutton -label $viewname($n) \
1615 -command [list addvhighlight $n] -variable selectedhlview
1618 proc flatten {var} {
1622 foreach i [array names $var] {
1623 lappend ret $i [set $var\($i\)]
1628 proc unflatten {var l} {
1638 global curview viewdata viewfiles
1639 global displayorder parentlist childlist rowidlist rowoffsets
1640 global colormap rowtextx commitrow nextcolor canvxmax
1641 global numcommits rowrangelist commitlisted idrowranges
1642 global selectedline currentid canv canvy0
1643 global matchinglines treediffs
1644 global pending_select phase
1645 global commitidx rowlaidout rowoptim linesegends
1646 global commfd nextupdate
1648 global vparentlist vchildlist vdisporder vcmitlisted
1649 global hlview selectedhlview
1651 if {$n == $curview} return
1653 if {[info exists selectedline]} {
1654 set selid $currentid
1655 set y [yc $selectedline]
1656 set ymax [lindex [$canv cget -scrollregion] 3]
1657 set span [$canv yview]
1658 set ytop [expr {[lindex $span 0] * $ymax}]
1659 set ybot [expr {[lindex $span 1] * $ymax}]
1660 if {$ytop < $y && $y < $ybot} {
1661 set yscreen [expr {$y - $ytop}]
1663 set yscreen [expr {($ybot - $ytop) / 2}]
1669 if {$curview >= 0} {
1670 set vparentlist($curview) $parentlist
1671 set vchildlist($curview) $childlist
1672 set vdisporder($curview) $displayorder
1673 set vcmitlisted($curview) $commitlisted
1675 set viewdata($curview) \
1676 [list $phase $rowidlist $rowoffsets $rowrangelist \
1677 [flatten idrowranges] [flatten idinlist] \
1678 $rowlaidout $rowoptim $numcommits $linesegends]
1679 } elseif {![info exists viewdata($curview)]
1680 || [lindex $viewdata($curview) 0] ne {}} {
1681 set viewdata($curview) \
1682 [list {} $rowidlist $rowoffsets $rowrangelist]
1685 catch {unset matchinglines}
1686 catch {unset treediffs}
1688 if {[info exists hlview] && $hlview == $n} {
1690 set selectedhlview None
1695 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1696 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1698 if {![info exists viewdata($n)]} {
1699 set pending_select $selid
1705 set phase [lindex $v 0]
1706 set displayorder $vdisporder($n)
1707 set parentlist $vparentlist($n)
1708 set childlist $vchildlist($n)
1709 set commitlisted $vcmitlisted($n)
1710 set rowidlist [lindex $v 1]
1711 set rowoffsets [lindex $v 2]
1712 set rowrangelist [lindex $v 3]
1714 set numcommits [llength $displayorder]
1715 catch {unset idrowranges}
1717 unflatten idrowranges [lindex $v 4]
1718 unflatten idinlist [lindex $v 5]
1719 set rowlaidout [lindex $v 6]
1720 set rowoptim [lindex $v 7]
1721 set numcommits [lindex $v 8]
1722 set linesegends [lindex $v 9]
1725 catch {unset colormap}
1726 catch {unset rowtextx}
1728 set canvxmax [$canv cget -width]
1734 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1735 set row $commitrow($n,$selid)
1736 # try to get the selected row in the same position on the screen
1737 set ymax [lindex [$canv cget -scrollregion] 3]
1738 set ytop [expr {[yc $row] - $yscreen}]
1742 set yf [expr {$ytop * 1.0 / $ymax}]
1744 allcanvs yview moveto $yf
1748 if {$phase eq "getcommits"} {
1749 show_status "Reading commits..."
1751 if {[info exists commfd($n)]} {
1756 } elseif {$numcommits == 0} {
1757 show_status "No commits selected"
1761 # Stuff relating to the highlighting facility
1763 proc ishighlighted {row} {
1764 global vhighlights fhighlights nhighlights rhighlights
1766 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1767 return $nhighlights($row)
1769 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1770 return $vhighlights($row)
1772 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1773 return $fhighlights($row)
1775 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1776 return $rhighlights($row)
1781 proc bolden {row font} {
1782 global canv linehtag selectedline boldrows
1784 lappend boldrows $row
1785 $canv itemconf $linehtag($row) -font $font
1786 if {[info exists selectedline] && $row == $selectedline} {
1788 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1789 -outline {{}} -tags secsel \
1790 -fill [$canv cget -selectbackground]]
1795 proc bolden_name {row font} {
1796 global canv2 linentag selectedline boldnamerows
1798 lappend boldnamerows $row
1799 $canv2 itemconf $linentag($row) -font $font
1800 if {[info exists selectedline] && $row == $selectedline} {
1801 $canv2 delete secsel
1802 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1803 -outline {{}} -tags secsel \
1804 -fill [$canv2 cget -selectbackground]]
1810 global mainfont boldrows
1813 foreach row $boldrows {
1814 if {![ishighlighted $row]} {
1815 bolden $row $mainfont
1817 lappend stillbold $row
1820 set boldrows $stillbold
1823 proc addvhighlight {n} {
1824 global hlview curview viewdata vhl_done vhighlights commitidx
1826 if {[info exists hlview]} {
1830 if {$n != $curview && ![info exists viewdata($n)]} {
1831 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1832 set vparentlist($n) {}
1833 set vchildlist($n) {}
1834 set vdisporder($n) {}
1835 set vcmitlisted($n) {}
1838 set vhl_done $commitidx($hlview)
1839 if {$vhl_done > 0} {
1844 proc delvhighlight {} {
1845 global hlview vhighlights
1847 if {![info exists hlview]} return
1849 catch {unset vhighlights}
1853 proc vhighlightmore {} {
1854 global hlview vhl_done commitidx vhighlights
1855 global displayorder vdisporder curview mainfont
1857 set font [concat $mainfont bold]
1858 set max $commitidx($hlview)
1859 if {$hlview == $curview} {
1860 set disp $displayorder
1862 set disp $vdisporder($hlview)
1864 set vr [visiblerows]
1865 set r0 [lindex $vr 0]
1866 set r1 [lindex $vr 1]
1867 for {set i $vhl_done} {$i < $max} {incr i} {
1868 set id [lindex $disp $i]
1869 if {[info exists commitrow($curview,$id)]} {
1870 set row $commitrow($curview,$id)
1871 if {$r0 <= $row && $row <= $r1} {
1872 if {![highlighted $row]} {
1875 set vhighlights($row) 1
1882 proc askvhighlight {row id} {
1883 global hlview vhighlights commitrow iddrawn mainfont
1885 if {[info exists commitrow($hlview,$id)]} {
1886 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1887 bolden $row [concat $mainfont bold]
1889 set vhighlights($row) 1
1891 set vhighlights($row) 0
1895 proc hfiles_change {name ix op} {
1896 global highlight_files filehighlight fhighlights fh_serial
1897 global mainfont highlight_paths
1899 if {[info exists filehighlight]} {
1900 # delete previous highlights
1901 catch {close $filehighlight}
1903 catch {unset fhighlights}
1905 unhighlight_filelist
1907 set highlight_paths {}
1908 after cancel do_file_hl $fh_serial
1910 if {$highlight_files ne {}} {
1911 after 300 do_file_hl $fh_serial
1915 proc makepatterns {l} {
1918 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1919 if {[string index $ee end] eq "/"} {
1929 proc do_file_hl {serial} {
1930 global highlight_files filehighlight highlight_paths gdttype fhl_list
1932 if {$gdttype eq "touching paths:"} {
1933 if {[catch {set paths [shellsplit $highlight_files]}]} return
1934 set highlight_paths [makepatterns $paths]
1936 set gdtargs [concat -- $paths]
1938 set gdtargs [list "-S$highlight_files"]
1940 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1941 set filehighlight [open $cmd r+]
1942 fconfigure $filehighlight -blocking 0
1943 fileevent $filehighlight readable readfhighlight
1949 proc flushhighlights {} {
1950 global filehighlight fhl_list
1952 if {[info exists filehighlight]} {
1954 puts $filehighlight ""
1955 flush $filehighlight
1959 proc askfilehighlight {row id} {
1960 global filehighlight fhighlights fhl_list
1962 lappend fhl_list $id
1963 set fhighlights($row) -1
1964 puts $filehighlight $id
1967 proc readfhighlight {} {
1968 global filehighlight fhighlights commitrow curview mainfont iddrawn
1971 while {[gets $filehighlight line] >= 0} {
1972 set line [string trim $line]
1973 set i [lsearch -exact $fhl_list $line]
1974 if {$i < 0} continue
1975 for {set j 0} {$j < $i} {incr j} {
1976 set id [lindex $fhl_list $j]
1977 if {[info exists commitrow($curview,$id)]} {
1978 set fhighlights($commitrow($curview,$id)) 0
1981 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1982 if {$line eq {}} continue
1983 if {![info exists commitrow($curview,$line)]} continue
1984 set row $commitrow($curview,$line)
1985 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1986 bolden $row [concat $mainfont bold]
1988 set fhighlights($row) 1
1990 if {[eof $filehighlight]} {
1992 puts "oops, git diff-tree died"
1993 catch {close $filehighlight}
1999 proc find_change {name ix op} {
2000 global nhighlights mainfont boldnamerows
2001 global findstring findpattern findtype
2003 # delete previous highlights, if any
2004 foreach row $boldnamerows {
2005 bolden_name $row $mainfont
2008 catch {unset nhighlights}
2010 if {$findtype ne "Regexp"} {
2011 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2013 set findpattern "*$e*"
2018 proc askfindhighlight {row id} {
2019 global nhighlights commitinfo iddrawn mainfont
2020 global findstring findtype findloc findpattern
2022 if {![info exists commitinfo($id)]} {
2025 set info $commitinfo($id)
2027 set fldtypes {Headline Author Date Committer CDate Comments}
2028 foreach f $info ty $fldtypes {
2029 if {$findloc ne "All fields" && $findloc ne $ty} {
2032 if {$findtype eq "Regexp"} {
2033 set doesmatch [regexp $findstring $f]
2034 } elseif {$findtype eq "IgnCase"} {
2035 set doesmatch [string match -nocase $findpattern $f]
2037 set doesmatch [string match $findpattern $f]
2040 if {$ty eq "Author"} {
2047 if {[info exists iddrawn($id)]} {
2048 if {$isbold && ![ishighlighted $row]} {
2049 bolden $row [concat $mainfont bold]
2052 bolden_name $row [concat $mainfont bold]
2055 set nhighlights($row) $isbold
2058 proc vrel_change {name ix op} {
2059 global highlight_related
2062 if {$highlight_related ne "None"} {
2063 after idle drawvisible
2067 # prepare for testing whether commits are descendents or ancestors of a
2068 proc rhighlight_sel {a} {
2069 global descendent desc_todo ancestor anc_todo
2070 global highlight_related rhighlights
2072 catch {unset descendent}
2073 set desc_todo [list $a]
2074 catch {unset ancestor}
2075 set anc_todo [list $a]
2076 if {$highlight_related ne "None"} {
2078 after idle drawvisible
2082 proc rhighlight_none {} {
2085 catch {unset rhighlights}
2089 proc is_descendent {a} {
2090 global curview children commitrow descendent desc_todo
2093 set la $commitrow($v,$a)
2097 for {set i 0} {$i < [llength $todo]} {incr i} {
2098 set do [lindex $todo $i]
2099 if {$commitrow($v,$do) < $la} {
2100 lappend leftover $do
2103 foreach nk $children($v,$do) {
2104 if {![info exists descendent($nk)]} {
2105 set descendent($nk) 1
2113 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2117 set descendent($a) 0
2118 set desc_todo $leftover
2121 proc is_ancestor {a} {
2122 global curview parentlist commitrow ancestor anc_todo
2125 set la $commitrow($v,$a)
2129 for {set i 0} {$i < [llength $todo]} {incr i} {
2130 set do [lindex $todo $i]
2131 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2132 lappend leftover $do
2135 foreach np [lindex $parentlist $commitrow($v,$do)] {
2136 if {![info exists ancestor($np)]} {
2145 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2150 set anc_todo $leftover
2153 proc askrelhighlight {row id} {
2154 global descendent highlight_related iddrawn mainfont rhighlights
2155 global selectedline ancestor
2157 if {![info exists selectedline]} return
2159 if {$highlight_related eq "Descendent" ||
2160 $highlight_related eq "Not descendent"} {
2161 if {![info exists descendent($id)]} {
2164 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2167 } elseif {$highlight_related eq "Ancestor" ||
2168 $highlight_related eq "Not ancestor"} {
2169 if {![info exists ancestor($id)]} {
2172 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2176 if {[info exists iddrawn($id)]} {
2177 if {$isbold && ![ishighlighted $row]} {
2178 bolden $row [concat $mainfont bold]
2181 set rhighlights($row) $isbold
2184 proc next_hlcont {} {
2185 global fhl_row fhl_dirn displayorder numcommits
2186 global vhighlights fhighlights nhighlights rhighlights
2187 global hlview filehighlight findstring highlight_related
2189 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2192 if {$row < 0 || $row >= $numcommits} {
2197 set id [lindex $displayorder $row]
2198 if {[info exists hlview]} {
2199 if {![info exists vhighlights($row)]} {
2200 askvhighlight $row $id
2202 if {$vhighlights($row) > 0} break
2204 if {$findstring ne {}} {
2205 if {![info exists nhighlights($row)]} {
2206 askfindhighlight $row $id
2208 if {$nhighlights($row) > 0} break
2210 if {$highlight_related ne "None"} {
2211 if {![info exists rhighlights($row)]} {
2212 askrelhighlight $row $id
2214 if {$rhighlights($row) > 0} break
2216 if {[info exists filehighlight]} {
2217 if {![info exists fhighlights($row)]} {
2218 # ask for a few more while we're at it...
2220 for {set n 0} {$n < 100} {incr n} {
2221 if {![info exists fhighlights($r)]} {
2222 askfilehighlight $r [lindex $displayorder $r]
2225 if {$r < 0 || $r >= $numcommits} break
2229 if {$fhighlights($row) < 0} {
2233 if {$fhighlights($row) > 0} break
2241 proc next_highlight {dirn} {
2242 global selectedline fhl_row fhl_dirn
2243 global hlview filehighlight findstring highlight_related
2245 if {![info exists selectedline]} return
2246 if {!([info exists hlview] || $findstring ne {} ||
2247 $highlight_related ne "None" || [info exists filehighlight])} return
2248 set fhl_row [expr {$selectedline + $dirn}]
2253 proc cancel_next_highlight {} {
2259 # Graph layout functions
2261 proc shortids {ids} {
2264 if {[llength $id] > 1} {
2265 lappend res [shortids $id]
2266 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2267 lappend res [string range $id 0 7]
2275 proc incrange {l x o} {
2278 set e [lindex $l $x]
2280 lset l $x [expr {$e + $o}]
2289 for {} {$n > 0} {incr n -1} {
2295 proc usedinrange {id l1 l2} {
2296 global children commitrow childlist curview
2298 if {[info exists commitrow($curview,$id)]} {
2299 set r $commitrow($curview,$id)
2300 if {$l1 <= $r && $r <= $l2} {
2301 return [expr {$r - $l1 + 1}]
2303 set kids [lindex $childlist $r]
2305 set kids $children($curview,$id)
2308 set r $commitrow($curview,$c)
2309 if {$l1 <= $r && $r <= $l2} {
2310 return [expr {$r - $l1 + 1}]
2316 proc sanity {row {full 0}} {
2317 global rowidlist rowoffsets
2320 set ids [lindex $rowidlist $row]
2323 if {$id eq {}} continue
2324 if {$col < [llength $ids] - 1 &&
2325 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2326 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2328 set o [lindex $rowoffsets $row $col]
2334 if {[lindex $rowidlist $y $x] != $id} {
2335 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2336 puts " id=[shortids $id] check started at row $row"
2337 for {set i $row} {$i >= $y} {incr i -1} {
2338 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2343 set o [lindex $rowoffsets $y $x]
2348 proc makeuparrow {oid x y z} {
2349 global rowidlist rowoffsets uparrowlen idrowranges
2351 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2354 set off0 [lindex $rowoffsets $y]
2355 for {set x0 $x} {1} {incr x0} {
2356 if {$x0 >= [llength $off0]} {
2357 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2360 set z [lindex $off0 $x0]
2366 set z [expr {$x0 - $x}]
2367 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2368 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2370 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2371 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2372 lappend idrowranges($oid) $y
2375 proc initlayout {} {
2376 global rowidlist rowoffsets displayorder commitlisted
2377 global rowlaidout rowoptim
2378 global idinlist rowchk rowrangelist idrowranges
2379 global numcommits canvxmax canv
2381 global parentlist childlist children
2382 global colormap rowtextx
2394 catch {unset idinlist}
2395 catch {unset rowchk}
2398 set canvxmax [$canv cget -width]
2399 catch {unset colormap}
2400 catch {unset rowtextx}
2401 catch {unset idrowranges}
2405 proc setcanvscroll {} {
2406 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2408 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2409 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2410 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2411 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2414 proc visiblerows {} {
2415 global canv numcommits linespc
2417 set ymax [lindex [$canv cget -scrollregion] 3]
2418 if {$ymax eq {} || $ymax == 0} return
2420 set y0 [expr {int([lindex $f 0] * $ymax)}]
2421 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2425 set y1 [expr {int([lindex $f 1] * $ymax)}]
2426 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2427 if {$r1 >= $numcommits} {
2428 set r1 [expr {$numcommits - 1}]
2430 return [list $r0 $r1]
2433 proc layoutmore {tmax} {
2434 global rowlaidout rowoptim commitidx numcommits optim_delay
2435 global uparrowlen curview
2438 if {$rowoptim - $optim_delay > $numcommits} {
2439 showstuff [expr {$rowoptim - $optim_delay}]
2440 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2441 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2445 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2447 } elseif {$commitidx($curview) > $rowlaidout} {
2448 set nr [expr {$commitidx($curview) - $rowlaidout}]
2449 # may need to increase this threshold if uparrowlen or
2450 # mingaplen are increased...
2455 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2456 if {$rowlaidout == $row} {
2462 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2468 proc showstuff {canshow} {
2469 global numcommits commitrow pending_select selectedline
2470 global linesegends idrowranges idrangedrawn curview
2472 if {$numcommits == 0} {
2474 set phase "incrdraw"
2478 set numcommits $canshow
2480 set rows [visiblerows]
2481 set r0 [lindex $rows 0]
2482 set r1 [lindex $rows 1]
2484 for {set r $row} {$r < $canshow} {incr r} {
2485 foreach id [lindex $linesegends [expr {$r+1}]] {
2487 foreach {s e} [rowranges $id] {
2489 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2490 && ![info exists idrangedrawn($id,$i)]} {
2492 set idrangedrawn($id,$i) 1
2497 if {$canshow > $r1} {
2500 while {$row < $canshow} {
2504 if {[info exists pending_select] &&
2505 [info exists commitrow($curview,$pending_select)] &&
2506 $commitrow($curview,$pending_select) < $numcommits} {
2507 selectline $commitrow($curview,$pending_select) 1
2509 if {![info exists selectedline] && ![info exists pending_select]} {
2514 proc layoutrows {row endrow last} {
2515 global rowidlist rowoffsets displayorder
2516 global uparrowlen downarrowlen maxwidth mingaplen
2517 global childlist parentlist
2518 global idrowranges linesegends
2519 global commitidx curview
2520 global idinlist rowchk rowrangelist
2522 set idlist [lindex $rowidlist $row]
2523 set offs [lindex $rowoffsets $row]
2524 while {$row < $endrow} {
2525 set id [lindex $displayorder $row]
2528 foreach p [lindex $parentlist $row] {
2529 if {![info exists idinlist($p)]} {
2531 } elseif {!$idinlist($p)} {
2536 set nev [expr {[llength $idlist] + [llength $newolds]
2537 + [llength $oldolds] - $maxwidth + 1}]
2540 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2541 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2542 set i [lindex $idlist $x]
2543 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2544 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2545 [expr {$row + $uparrowlen + $mingaplen}]]
2547 set idlist [lreplace $idlist $x $x]
2548 set offs [lreplace $offs $x $x]
2549 set offs [incrange $offs $x 1]
2551 set rm1 [expr {$row - 1}]
2553 lappend idrowranges($i) $rm1
2554 if {[incr nev -1] <= 0} break
2557 set rowchk($id) [expr {$row + $r}]
2560 lset rowidlist $row $idlist
2561 lset rowoffsets $row $offs
2563 lappend linesegends $lse
2564 set col [lsearch -exact $idlist $id]
2566 set col [llength $idlist]
2568 lset rowidlist $row $idlist
2570 if {[lindex $childlist $row] ne {}} {
2571 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2575 lset rowoffsets $row $offs
2577 makeuparrow $id $col $row $z
2583 if {[info exists idrowranges($id)]} {
2584 set ranges $idrowranges($id)
2586 unset idrowranges($id)
2588 lappend rowrangelist $ranges
2590 set offs [ntimes [llength $idlist] 0]
2591 set l [llength $newolds]
2592 set idlist [eval lreplace \$idlist $col $col $newolds]
2595 set offs [lrange $offs 0 [expr {$col - 1}]]
2596 foreach x $newolds {
2601 set tmp [expr {[llength $idlist] - [llength $offs]}]
2603 set offs [concat $offs [ntimes $tmp $o]]
2608 foreach i $newolds {
2610 set idrowranges($i) $row
2613 foreach oid $oldolds {
2614 set idinlist($oid) 1
2615 set idlist [linsert $idlist $col $oid]
2616 set offs [linsert $offs $col $o]
2617 makeuparrow $oid $col $row $o
2620 lappend rowidlist $idlist
2621 lappend rowoffsets $offs
2626 proc addextraid {id row} {
2627 global displayorder commitrow commitinfo
2628 global commitidx commitlisted
2629 global parentlist childlist children curview
2631 incr commitidx($curview)
2632 lappend displayorder $id
2633 lappend commitlisted 0
2634 lappend parentlist {}
2635 set commitrow($curview,$id) $row
2637 if {![info exists commitinfo($id)]} {
2638 set commitinfo($id) {"No commit information available"}
2640 if {![info exists children($curview,$id)]} {
2641 set children($curview,$id) {}
2643 lappend childlist $children($curview,$id)
2646 proc layouttail {} {
2647 global rowidlist rowoffsets idinlist commitidx curview
2648 global idrowranges rowrangelist
2650 set row $commitidx($curview)
2651 set idlist [lindex $rowidlist $row]
2652 while {$idlist ne {}} {
2653 set col [expr {[llength $idlist] - 1}]
2654 set id [lindex $idlist $col]
2657 lappend idrowranges($id) $row
2658 lappend rowrangelist $idrowranges($id)
2659 unset idrowranges($id)
2661 set offs [ntimes $col 0]
2662 set idlist [lreplace $idlist $col $col]
2663 lappend rowidlist $idlist
2664 lappend rowoffsets $offs
2667 foreach id [array names idinlist] {
2669 lset rowidlist $row [list $id]
2670 lset rowoffsets $row 0
2671 makeuparrow $id 0 $row 0
2672 lappend idrowranges($id) $row
2673 lappend rowrangelist $idrowranges($id)
2674 unset idrowranges($id)
2676 lappend rowidlist {}
2677 lappend rowoffsets {}
2681 proc insert_pad {row col npad} {
2682 global rowidlist rowoffsets
2684 set pad [ntimes $npad {}]
2685 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2686 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2687 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2690 proc optimize_rows {row col endrow} {
2691 global rowidlist rowoffsets idrowranges displayorder
2693 for {} {$row < $endrow} {incr row} {
2694 set idlist [lindex $rowidlist $row]
2695 set offs [lindex $rowoffsets $row]
2697 for {} {$col < [llength $offs]} {incr col} {
2698 if {[lindex $idlist $col] eq {}} {
2702 set z [lindex $offs $col]
2703 if {$z eq {}} continue
2705 set x0 [expr {$col + $z}]
2706 set y0 [expr {$row - 1}]
2707 set z0 [lindex $rowoffsets $y0 $x0]
2709 set id [lindex $idlist $col]
2710 set ranges [rowranges $id]
2711 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2715 if {$z < -1 || ($z < 0 && $isarrow)} {
2716 set npad [expr {-1 - $z + $isarrow}]
2717 set offs [incrange $offs $col $npad]
2718 insert_pad $y0 $x0 $npad
2720 optimize_rows $y0 $x0 $row
2722 set z [lindex $offs $col]
2723 set x0 [expr {$col + $z}]
2724 set z0 [lindex $rowoffsets $y0 $x0]
2725 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2726 set npad [expr {$z - 1 + $isarrow}]
2727 set y1 [expr {$row + 1}]
2728 set offs2 [lindex $rowoffsets $y1]
2732 if {$z eq {} || $x1 + $z < $col} continue
2733 if {$x1 + $z > $col} {
2736 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2739 set pad [ntimes $npad {}]
2740 set idlist [eval linsert \$idlist $col $pad]
2741 set tmp [eval linsert \$offs $col $pad]
2743 set offs [incrange $tmp $col [expr {-$npad}]]
2744 set z [lindex $offs $col]
2747 if {$z0 eq {} && !$isarrow} {
2748 # this line links to its first child on row $row-2
2749 set rm2 [expr {$row - 2}]
2750 set id [lindex $displayorder $rm2]
2751 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2753 set z0 [expr {$xc - $x0}]
2756 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2757 insert_pad $y0 $x0 1
2758 set offs [incrange $offs $col 1]
2759 optimize_rows $y0 [expr {$x0 + 1}] $row
2764 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2765 set o [lindex $offs $col]
2767 # check if this is the link to the first child
2768 set id [lindex $idlist $col]
2769 set ranges [rowranges $id]
2770 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2771 # it is, work out offset to child
2772 set y0 [expr {$row - 1}]
2773 set id [lindex $displayorder $y0]
2774 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2776 set o [expr {$x0 - $col}]
2780 if {$o eq {} || $o <= 0} break
2782 if {$o ne {} && [incr col] < [llength $idlist]} {
2783 set y1 [expr {$row + 1}]
2784 set offs2 [lindex $rowoffsets $y1]
2788 if {$z eq {} || $x1 + $z < $col} continue
2789 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2792 set idlist [linsert $idlist $col {}]
2793 set tmp [linsert $offs $col {}]
2795 set offs [incrange $tmp $col -1]
2798 lset rowidlist $row $idlist
2799 lset rowoffsets $row $offs
2805 global canvx0 linespc
2806 return [expr {$canvx0 + $col * $linespc}]
2810 global canvy0 linespc
2811 return [expr {$canvy0 + $row * $linespc}]
2814 proc linewidth {id} {
2815 global thickerline lthickness
2818 if {[info exists thickerline] && $id eq $thickerline} {
2819 set wid [expr {2 * $lthickness}]
2824 proc rowranges {id} {
2825 global phase idrowranges commitrow rowlaidout rowrangelist curview
2829 ([info exists commitrow($curview,$id)]
2830 && $commitrow($curview,$id) < $rowlaidout)} {
2831 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2832 } elseif {[info exists idrowranges($id)]} {
2833 set ranges $idrowranges($id)
2838 proc drawlineseg {id i} {
2839 global rowoffsets rowidlist
2841 global canv colormap linespc
2842 global numcommits commitrow curview
2844 set ranges [rowranges $id]
2846 if {[info exists commitrow($curview,$id)]
2847 && $commitrow($curview,$id) < $numcommits} {
2848 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2852 set startrow [lindex $ranges [expr {2 * $i}]]
2853 set row [lindex $ranges [expr {2 * $i + 1}]]
2854 if {$startrow == $row} return
2857 set col [lsearch -exact [lindex $rowidlist $row] $id]
2859 puts "oops: drawline: id $id not on row $row"
2865 set o [lindex $rowoffsets $row $col]
2868 # changing direction
2869 set x [xc $row $col]
2871 lappend coords $x $y
2877 set x [xc $row $col]
2879 lappend coords $x $y
2881 # draw the link to the first child as part of this line
2883 set child [lindex $displayorder $row]
2884 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2886 set x [xc $row $ccol]
2888 if {$ccol < $col - 1} {
2889 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2890 } elseif {$ccol > $col + 1} {
2891 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2893 lappend coords $x $y
2896 if {[llength $coords] < 4} return
2898 # This line has an arrow at the lower end: check if the arrow is
2899 # on a diagonal segment, and if so, work around the Tk 8.4
2900 # refusal to draw arrows on diagonal lines.
2901 set x0 [lindex $coords 0]
2902 set x1 [lindex $coords 2]
2904 set y0 [lindex $coords 1]
2905 set y1 [lindex $coords 3]
2906 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2907 # we have a nearby vertical segment, just trim off the diag bit
2908 set coords [lrange $coords 2 end]
2910 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2911 set xi [expr {$x0 - $slope * $linespc / 2}]
2912 set yi [expr {$y0 - $linespc / 2}]
2913 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2917 set arrow [expr {2 * ($i > 0) + $downarrow}]
2918 set arrow [lindex {none first last both} $arrow]
2919 set t [$canv create line $coords -width [linewidth $id] \
2920 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2925 proc drawparentlinks {id row col olds} {
2926 global rowidlist canv colormap
2928 set row2 [expr {$row + 1}]
2929 set x [xc $row $col]
2932 set ids [lindex $rowidlist $row2]
2933 # rmx = right-most X coord used
2936 set i [lsearch -exact $ids $p]
2938 puts "oops, parent $p of $id not in list"
2941 set x2 [xc $row2 $i]
2945 set ranges [rowranges $p]
2946 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2947 && $row2 < [lindex $ranges 1]} {
2948 # drawlineseg will do this one for us
2952 # should handle duplicated parents here...
2953 set coords [list $x $y]
2954 if {$i < $col - 1} {
2955 lappend coords [xc $row [expr {$i + 1}]] $y
2956 } elseif {$i > $col + 1} {
2957 lappend coords [xc $row [expr {$i - 1}]] $y
2959 lappend coords $x2 $y2
2960 set t [$canv create line $coords -width [linewidth $p] \
2961 -fill $colormap($p) -tags lines.$p]
2968 proc drawlines {id} {
2969 global colormap canv
2971 global children iddrawn commitrow rowidlist curview
2973 $canv delete lines.$id
2974 set nr [expr {[llength [rowranges $id]] / 2}]
2975 for {set i 0} {$i < $nr} {incr i} {
2976 if {[info exists idrangedrawn($id,$i)]} {
2980 foreach child $children($curview,$id) {
2981 if {[info exists iddrawn($child)]} {
2982 set row $commitrow($curview,$child)
2983 set col [lsearch -exact [lindex $rowidlist $row] $child]
2985 drawparentlinks $child $row $col [list $id]
2991 proc drawcmittext {id row col rmx} {
2992 global linespc canv canv2 canv3 canvy0 fgcolor
2993 global commitlisted commitinfo rowidlist
2994 global rowtextx idpos idtags idheads idotherrefs
2995 global linehtag linentag linedtag
2996 global mainfont canvxmax boldrows boldnamerows fgcolor
2998 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2999 set x [xc $row $col]
3001 set orad [expr {$linespc / 3}]
3002 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3003 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3004 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3006 $canv bind $t <1> {selcanvline {} %x %y}
3007 set xt [xc $row [llength [lindex $rowidlist $row]]]
3011 set rowtextx($row) $xt
3012 set idpos($id) [list $x $xt $y]
3013 if {[info exists idtags($id)] || [info exists idheads($id)]
3014 || [info exists idotherrefs($id)]} {
3015 set xt [drawtags $id $x $xt $y]
3017 set headline [lindex $commitinfo($id) 0]
3018 set name [lindex $commitinfo($id) 1]
3019 set date [lindex $commitinfo($id) 2]
3020 set date [formatdate $date]
3023 set isbold [ishighlighted $row]
3025 lappend boldrows $row
3028 lappend boldnamerows $row
3032 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3033 -text $headline -font $font -tags text]
3034 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3035 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3036 -text $name -font $nfont -tags text]
3037 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3038 -text $date -font $mainfont -tags text]
3039 set xr [expr {$xt + [font measure $mainfont $headline]}]
3040 if {$xr > $canvxmax} {
3046 proc drawcmitrow {row} {
3047 global displayorder rowidlist
3048 global idrangedrawn iddrawn
3049 global commitinfo parentlist numcommits
3050 global filehighlight fhighlights findstring nhighlights
3051 global hlview vhighlights
3052 global highlight_related rhighlights
3054 if {$row >= $numcommits} return
3055 foreach id [lindex $rowidlist $row] {
3056 if {$id eq {}} continue
3058 foreach {s e} [rowranges $id] {
3060 if {$row < $s} continue
3063 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3065 set idrangedrawn($id,$i) 1
3072 set id [lindex $displayorder $row]
3073 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3074 askvhighlight $row $id
3076 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3077 askfilehighlight $row $id
3079 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3080 askfindhighlight $row $id
3082 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3083 askrelhighlight $row $id
3085 if {[info exists iddrawn($id)]} return
3086 set col [lsearch -exact [lindex $rowidlist $row] $id]
3088 puts "oops, row $row id $id not in list"
3091 if {![info exists commitinfo($id)]} {
3095 set olds [lindex $parentlist $row]
3097 set rmx [drawparentlinks $id $row $col $olds]
3101 drawcmittext $id $row $col $rmx
3105 proc drawfrac {f0 f1} {
3106 global numcommits canv
3109 set ymax [lindex [$canv cget -scrollregion] 3]
3110 if {$ymax eq {} || $ymax == 0} return
3111 set y0 [expr {int($f0 * $ymax)}]
3112 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3116 set y1 [expr {int($f1 * $ymax)}]
3117 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3118 if {$endrow >= $numcommits} {
3119 set endrow [expr {$numcommits - 1}]
3121 for {} {$row <= $endrow} {incr row} {
3126 proc drawvisible {} {
3128 eval drawfrac [$canv yview]
3131 proc clear_display {} {
3132 global iddrawn idrangedrawn
3133 global vhighlights fhighlights nhighlights rhighlights
3136 catch {unset iddrawn}
3137 catch {unset idrangedrawn}
3138 catch {unset vhighlights}
3139 catch {unset fhighlights}
3140 catch {unset nhighlights}
3141 catch {unset rhighlights}
3144 proc findcrossings {id} {
3145 global rowidlist parentlist numcommits rowoffsets displayorder
3149 foreach {s e} [rowranges $id] {
3150 if {$e >= $numcommits} {
3151 set e [expr {$numcommits - 1}]
3153 if {$e <= $s} continue
3154 set x [lsearch -exact [lindex $rowidlist $e] $id]
3156 puts "findcrossings: oops, no [shortids $id] in row $e"
3159 for {set row $e} {[incr row -1] >= $s} {} {
3160 set olds [lindex $parentlist $row]
3161 set kid [lindex $displayorder $row]
3162 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3163 if {$kidx < 0} continue
3164 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3166 set px [lsearch -exact $nextrow $p]
3167 if {$px < 0} continue
3168 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3169 if {[lsearch -exact $ccross $p] >= 0} continue
3170 if {$x == $px + ($kidx < $px? -1: 1)} {
3172 } elseif {[lsearch -exact $cross $p] < 0} {
3177 set inc [lindex $rowoffsets $row $x]
3178 if {$inc eq {}} break
3182 return [concat $ccross {{}} $cross]
3185 proc assigncolor {id} {
3186 global colormap colors nextcolor
3187 global commitrow parentlist children children curview
3189 if {[info exists colormap($id)]} return
3190 set ncolors [llength $colors]
3191 if {[info exists children($curview,$id)]} {
3192 set kids $children($curview,$id)
3196 if {[llength $kids] == 1} {
3197 set child [lindex $kids 0]
3198 if {[info exists colormap($child)]
3199 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3200 set colormap($id) $colormap($child)
3206 foreach x [findcrossings $id] {
3208 # delimiter between corner crossings and other crossings
3209 if {[llength $badcolors] >= $ncolors - 1} break
3210 set origbad $badcolors
3212 if {[info exists colormap($x)]
3213 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3214 lappend badcolors $colormap($x)
3217 if {[llength $badcolors] >= $ncolors} {
3218 set badcolors $origbad
3220 set origbad $badcolors
3221 if {[llength $badcolors] < $ncolors - 1} {
3222 foreach child $kids {
3223 if {[info exists colormap($child)]
3224 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3225 lappend badcolors $colormap($child)
3227 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3228 if {[info exists colormap($p)]
3229 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3230 lappend badcolors $colormap($p)
3234 if {[llength $badcolors] >= $ncolors} {
3235 set badcolors $origbad
3238 for {set i 0} {$i <= $ncolors} {incr i} {
3239 set c [lindex $colors $nextcolor]
3240 if {[incr nextcolor] >= $ncolors} {
3243 if {[lsearch -exact $badcolors $c]} break
3245 set colormap($id) $c
3248 proc bindline {t id} {
3251 $canv bind $t <Enter> "lineenter %x %y $id"
3252 $canv bind $t <Motion> "linemotion %x %y $id"
3253 $canv bind $t <Leave> "lineleave $id"
3254 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3257 proc drawtags {id x xt y1} {
3258 global idtags idheads idotherrefs mainhead
3259 global linespc lthickness
3260 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3265 if {[info exists idtags($id)]} {
3266 set marks $idtags($id)
3267 set ntags [llength $marks]
3269 if {[info exists idheads($id)]} {
3270 set marks [concat $marks $idheads($id)]
3271 set nheads [llength $idheads($id)]
3273 if {[info exists idotherrefs($id)]} {
3274 set marks [concat $marks $idotherrefs($id)]
3280 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3281 set yt [expr {$y1 - 0.5 * $linespc}]
3282 set yb [expr {$yt + $linespc - 1}]
3286 foreach tag $marks {
3288 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3289 set wid [font measure [concat $mainfont bold] $tag]
3291 set wid [font measure $mainfont $tag]
3295 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3297 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3298 -width $lthickness -fill black -tags tag.$id]
3300 foreach tag $marks x $xvals wid $wvals {
3301 set xl [expr {$x + $delta}]
3302 set xr [expr {$x + $delta + $wid + $lthickness}]
3304 if {[incr ntags -1] >= 0} {
3306 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3307 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3308 -width 1 -outline black -fill yellow -tags tag.$id]
3309 $canv bind $t <1> [list showtag $tag 1]
3310 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3312 # draw a head or other ref
3313 if {[incr nheads -1] >= 0} {
3315 if {$tag eq $mainhead} {
3321 set xl [expr {$xl - $delta/2}]
3322 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3323 -width 1 -outline black -fill $col -tags tag.$id
3324 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3325 set rwid [font measure $mainfont $remoteprefix]
3326 set xi [expr {$x + 1}]
3327 set yti [expr {$yt + 1}]
3328 set xri [expr {$x + $rwid}]
3329 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3330 -width 0 -fill "#ffddaa" -tags tag.$id
3333 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3334 -font $font -tags [list tag.$id text]]
3336 $canv bind $t <1> [list showtag $tag 1]
3337 } elseif {$nheads >= 0} {
3338 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3344 proc xcoord {i level ln} {
3345 global canvx0 xspc1 xspc2
3347 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3348 if {$i > 0 && $i == $level} {
3349 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3350 } elseif {$i > $level} {
3351 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3356 proc show_status {msg} {
3357 global canv mainfont fgcolor
3360 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3361 -tags text -fill $fgcolor
3364 proc finishcommits {} {
3365 global commitidx phase curview
3366 global pending_select
3368 if {$commitidx($curview) > 0} {
3371 show_status "No commits selected"
3374 catch {unset pending_select}
3377 # Insert a new commit as the child of the commit on row $row.
3378 # The new commit will be displayed on row $row and the commits
3379 # on that row and below will move down one row.
3380 proc insertrow {row newcmit} {
3381 global displayorder parentlist childlist commitlisted
3382 global commitrow curview rowidlist rowoffsets numcommits
3383 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3384 global linesegends selectedline
3386 if {$row >= $numcommits} {
3387 puts "oops, inserting new row $row but only have $numcommits rows"
3390 set p [lindex $displayorder $row]
3391 set displayorder [linsert $displayorder $row $newcmit]
3392 set parentlist [linsert $parentlist $row $p]
3393 set kids [lindex $childlist $row]
3394 lappend kids $newcmit
3395 lset childlist $row $kids
3396 set childlist [linsert $childlist $row {}]
3397 set commitlisted [linsert $commitlisted $row 1]
3398 set l [llength $displayorder]
3399 for {set r $row} {$r < $l} {incr r} {
3400 set id [lindex $displayorder $r]
3401 set commitrow($curview,$id) $r
3404 set idlist [lindex $rowidlist $row]
3405 set offs [lindex $rowoffsets $row]
3408 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3414 if {[llength $kids] == 1} {
3415 set col [lsearch -exact $idlist $p]
3416 lset idlist $col $newcmit
3418 set col [llength $idlist]
3419 lappend idlist $newcmit
3421 lset rowoffsets $row $offs
3423 set rowidlist [linsert $rowidlist $row $idlist]
3424 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3426 set rowrangelist [linsert $rowrangelist $row {}]
3427 set l [llength $rowrangelist]
3428 for {set r 0} {$r < $l} {incr r} {
3429 set ranges [lindex $rowrangelist $r]
3430 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3434 lappend newranges [expr {$x + 1}]
3436 lappend newranges $x
3439 lset rowrangelist $r $newranges
3442 if {[llength $kids] > 1} {
3443 set rp1 [expr {$row + 1}]
3444 set ranges [lindex $rowrangelist $rp1]
3445 if {$ranges eq {}} {
3446 set ranges [list $row $rp1]
3447 } elseif {[lindex $ranges end-1] == $rp1} {
3448 lset ranges end-1 $row
3450 lset rowrangelist $rp1 $ranges
3452 foreach id [array names idrowranges] {
3453 set ranges $idrowranges($id)
3454 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3458 lappend newranges [expr {$x + 1}]
3460 lappend newranges $x
3463 set idrowranges($id) $newranges
3467 set linesegends [linsert $linesegends $row {}]
3473 if {[info exists selectedline] && $selectedline >= $row} {
3479 # Don't change the text pane cursor if it is currently the hand cursor,
3480 # showing that we are over a sha1 ID link.
3481 proc settextcursor {c} {
3482 global ctext curtextcursor
3484 if {[$ctext cget -cursor] == $curtextcursor} {
3485 $ctext config -cursor $c
3487 set curtextcursor $c
3490 proc nowbusy {what} {
3493 if {[array names isbusy] eq {}} {
3494 . config -cursor watch
3500 proc notbusy {what} {
3501 global isbusy maincursor textcursor
3503 catch {unset isbusy($what)}
3504 if {[array names isbusy] eq {}} {
3505 . config -cursor $maincursor
3506 settextcursor $textcursor
3512 global rowlaidout commitidx curview
3513 global pending_select
3516 layoutrows $rowlaidout $commitidx($curview) 1
3518 optimize_rows $row 0 $commitidx($curview)
3519 showstuff $commitidx($curview)
3520 if {[info exists pending_select]} {
3524 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3526 #puts "overall $drawmsecs ms for $numcommits commits"
3529 proc findmatches {f} {
3530 global findtype foundstring foundstrlen
3531 if {$findtype == "Regexp"} {
3532 set matches [regexp -indices -all -inline $foundstring $f]
3534 if {$findtype == "IgnCase"} {
3535 set str [string tolower $f]
3541 while {[set j [string first $foundstring $str $i]] >= 0} {
3542 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3543 set i [expr {$j + $foundstrlen}]
3550 global findtype findloc findstring markedmatches commitinfo
3551 global numcommits displayorder linehtag linentag linedtag
3552 global mainfont canv canv2 canv3 selectedline
3553 global matchinglines foundstring foundstrlen matchstring
3558 cancel_next_highlight
3560 set matchinglines {}
3561 if {$findtype == "IgnCase"} {
3562 set foundstring [string tolower $findstring]
3564 set foundstring $findstring
3566 set foundstrlen [string length $findstring]
3567 if {$foundstrlen == 0} return
3568 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3569 set matchstring "*$matchstring*"
3570 if {![info exists selectedline]} {
3573 set oldsel $selectedline
3576 set fldtypes {Headline Author Date Committer CDate Comments}
3578 foreach id $displayorder {
3579 set d $commitdata($id)
3581 if {$findtype == "Regexp"} {
3582 set doesmatch [regexp $foundstring $d]
3583 } elseif {$findtype == "IgnCase"} {
3584 set doesmatch [string match -nocase $matchstring $d]
3586 set doesmatch [string match $matchstring $d]
3588 if {!$doesmatch} continue
3589 if {![info exists commitinfo($id)]} {
3592 set info $commitinfo($id)
3594 foreach f $info ty $fldtypes {
3595 if {$findloc != "All fields" && $findloc != $ty} {
3598 set matches [findmatches $f]
3599 if {$matches == {}} continue
3601 if {$ty == "Headline"} {
3603 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3604 } elseif {$ty == "Author"} {
3606 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3607 } elseif {$ty == "Date"} {
3609 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3613 lappend matchinglines $l
3614 if {!$didsel && $l > $oldsel} {
3620 if {$matchinglines == {}} {
3622 } elseif {!$didsel} {
3623 findselectline [lindex $matchinglines 0]
3627 proc findselectline {l} {
3628 global findloc commentend ctext
3630 if {$findloc == "All fields" || $findloc == "Comments"} {
3631 # highlight the matches in the comments
3632 set f [$ctext get 1.0 $commentend]
3633 set matches [findmatches $f]
3634 foreach match $matches {
3635 set start [lindex $match 0]
3636 set end [expr {[lindex $match 1] + 1}]
3637 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3642 proc findnext {restart} {
3643 global matchinglines selectedline
3644 if {![info exists matchinglines]} {
3650 if {![info exists selectedline]} return
3651 foreach l $matchinglines {
3652 if {$l > $selectedline} {
3661 global matchinglines selectedline
3662 if {![info exists matchinglines]} {
3666 if {![info exists selectedline]} return
3668 foreach l $matchinglines {
3669 if {$l >= $selectedline} break
3673 findselectline $prev
3679 proc stopfindproc {{done 0}} {
3680 global findprocpid findprocfile findids
3681 global ctext findoldcursor phase maincursor textcursor
3682 global findinprogress
3684 catch {unset findids}
3685 if {[info exists findprocpid]} {
3687 catch {exec kill $findprocpid}
3689 catch {close $findprocfile}
3692 catch {unset findinprogress}
3696 # mark a commit as matching by putting a yellow background
3697 # behind the headline
3698 proc markheadline {l id} {
3699 global canv mainfont linehtag
3702 set bbox [$canv bbox $linehtag($l)]
3703 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3707 # mark the bits of a headline, author or date that match a find string
3708 proc markmatches {canv l str tag matches font} {
3709 set bbox [$canv bbox $tag]
3710 set x0 [lindex $bbox 0]
3711 set y0 [lindex $bbox 1]
3712 set y1 [lindex $bbox 3]
3713 foreach match $matches {
3714 set start [lindex $match 0]
3715 set end [lindex $match 1]
3716 if {$start > $end} continue
3717 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3718 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3719 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3720 [expr {$x0+$xlen+2}] $y1 \
3721 -outline {} -tags matches -fill yellow]
3726 proc unmarkmatches {} {
3727 global matchinglines findids
3728 allcanvs delete matches
3729 catch {unset matchinglines}
3730 catch {unset findids}
3733 proc selcanvline {w x y} {
3734 global canv canvy0 ctext linespc
3736 set ymax [lindex [$canv cget -scrollregion] 3]
3737 if {$ymax == {}} return
3738 set yfrac [lindex [$canv yview] 0]
3739 set y [expr {$y + $yfrac * $ymax}]
3740 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3745 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3751 proc commit_descriptor {p} {
3753 if {![info exists commitinfo($p)]} {
3757 if {[llength $commitinfo($p)] > 1} {
3758 set l [lindex $commitinfo($p) 0]
3763 # append some text to the ctext widget, and make any SHA1 ID
3764 # that we know about be a clickable link.
3765 proc appendwithlinks {text tags} {
3766 global ctext commitrow linknum curview
3768 set start [$ctext index "end - 1c"]
3769 $ctext insert end $text $tags
3770 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3774 set linkid [string range $text $s $e]
3775 if {![info exists commitrow($curview,$linkid)]} continue
3777 $ctext tag add link "$start + $s c" "$start + $e c"
3778 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3779 $ctext tag bind link$linknum <1> \
3780 [list selectline $commitrow($curview,$linkid) 1]
3783 $ctext tag conf link -foreground blue -underline 1
3784 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3785 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3788 proc viewnextline {dir} {
3792 set ymax [lindex [$canv cget -scrollregion] 3]
3793 set wnow [$canv yview]
3794 set wtop [expr {[lindex $wnow 0] * $ymax}]
3795 set newtop [expr {$wtop + $dir * $linespc}]
3798 } elseif {$newtop > $ymax} {
3801 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3804 # add a list of tag or branch names at position pos
3805 # returns the number of names inserted
3806 proc appendrefs {pos tags var} {
3807 global ctext commitrow linknum curview $var
3809 if {[catch {$ctext index $pos}]} {
3812 set tags [lsort $tags]
3815 set id [set $var\($tag\)]
3818 $ctext insert $pos $sep
3819 $ctext insert $pos $tag $lk
3820 $ctext tag conf $lk -foreground blue
3821 if {[info exists commitrow($curview,$id)]} {
3822 $ctext tag bind $lk <1> \
3823 [list selectline $commitrow($curview,$id) 1]
3824 $ctext tag conf $lk -underline 1
3825 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3826 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3830 return [llength $tags]
3833 proc taglist {ids} {
3838 foreach tag $idtags($id) {
3845 # called when we have finished computing the nearby tags
3846 proc dispneartags {} {
3847 global selectedline currentid ctext anc_tags desc_tags showneartags
3850 if {![info exists selectedline] || !$showneartags} return
3852 $ctext conf -state normal
3853 if {[info exists desc_heads($id)]} {
3854 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3855 $ctext insert "branch -2c" "es"
3858 if {[info exists anc_tags($id)]} {
3859 appendrefs follows [taglist $anc_tags($id)] tagids
3861 if {[info exists desc_tags($id)]} {
3862 appendrefs precedes [taglist $desc_tags($id)] tagids
3864 $ctext conf -state disabled
3867 proc selectline {l isnew} {
3868 global canv canv2 canv3 ctext commitinfo selectedline
3869 global displayorder linehtag linentag linedtag
3870 global canvy0 linespc parentlist childlist
3871 global currentid sha1entry
3872 global commentend idtags linknum
3873 global mergemax numcommits pending_select
3874 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3876 catch {unset pending_select}
3879 cancel_next_highlight
3880 if {$l < 0 || $l >= $numcommits} return
3881 set y [expr {$canvy0 + $l * $linespc}]
3882 set ymax [lindex [$canv cget -scrollregion] 3]
3883 set ytop [expr {$y - $linespc - 1}]
3884 set ybot [expr {$y + $linespc + 1}]
3885 set wnow [$canv yview]
3886 set wtop [expr {[lindex $wnow 0] * $ymax}]
3887 set wbot [expr {[lindex $wnow 1] * $ymax}]
3888 set wh [expr {$wbot - $wtop}]
3890 if {$ytop < $wtop} {
3891 if {$ybot < $wtop} {
3892 set newtop [expr {$y - $wh / 2.0}]
3895 if {$newtop > $wtop - $linespc} {
3896 set newtop [expr {$wtop - $linespc}]
3899 } elseif {$ybot > $wbot} {
3900 if {$ytop > $wbot} {
3901 set newtop [expr {$y - $wh / 2.0}]
3903 set newtop [expr {$ybot - $wh}]
3904 if {$newtop < $wtop + $linespc} {
3905 set newtop [expr {$wtop + $linespc}]
3909 if {$newtop != $wtop} {
3913 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3917 if {![info exists linehtag($l)]} return
3919 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3920 -tags secsel -fill [$canv cget -selectbackground]]
3922 $canv2 delete secsel
3923 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3924 -tags secsel -fill [$canv2 cget -selectbackground]]
3926 $canv3 delete secsel
3927 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3928 -tags secsel -fill [$canv3 cget -selectbackground]]
3932 addtohistory [list selectline $l 0]
3937 set id [lindex $displayorder $l]
3939 $sha1entry delete 0 end
3940 $sha1entry insert 0 $id
3941 $sha1entry selection from 0
3942 $sha1entry selection to end
3945 $ctext conf -state normal
3948 set info $commitinfo($id)
3949 set date [formatdate [lindex $info 2]]
3950 $ctext insert end "Author: [lindex $info 1] $date\n"
3951 set date [formatdate [lindex $info 4]]
3952 $ctext insert end "Committer: [lindex $info 3] $date\n"
3953 if {[info exists idtags($id)]} {
3954 $ctext insert end "Tags:"
3955 foreach tag $idtags($id) {
3956 $ctext insert end " $tag"
3958 $ctext insert end "\n"
3962 set olds [lindex $parentlist $l]
3963 if {[llength $olds] > 1} {
3966 if {$np >= $mergemax} {
3971 $ctext insert end "Parent: " $tag
3972 appendwithlinks [commit_descriptor $p] {}
3977 append headers "Parent: [commit_descriptor $p]"
3981 foreach c [lindex $childlist $l] {
3982 append headers "Child: [commit_descriptor $c]"
3985 # make anything that looks like a SHA1 ID be a clickable link
3986 appendwithlinks $headers {}
3987 if {$showneartags} {
3988 if {![info exists allcommits]} {
3991 $ctext insert end "Branch: "
3992 $ctext mark set branch "end -1c"
3993 $ctext mark gravity branch left
3994 if {[info exists desc_heads($id)]} {
3995 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3996 # turn "Branch" into "Branches"
3997 $ctext insert "branch -2c" "es"
4000 $ctext insert end "\nFollows: "
4001 $ctext mark set follows "end -1c"
4002 $ctext mark gravity follows left
4003 if {[info exists anc_tags($id)]} {
4004 appendrefs follows [taglist $anc_tags($id)] tagids
4006 $ctext insert end "\nPrecedes: "
4007 $ctext mark set precedes "end -1c"
4008 $ctext mark gravity precedes left
4009 if {[info exists desc_tags($id)]} {
4010 appendrefs precedes [taglist $desc_tags($id)] tagids
4012 $ctext insert end "\n"
4014 $ctext insert end "\n"
4015 appendwithlinks [lindex $info 5] {comment}
4017 $ctext tag delete Comments
4018 $ctext tag remove found 1.0 end
4019 $ctext conf -state disabled
4020 set commentend [$ctext index "end - 1c"]
4022 init_flist "Comments"
4023 if {$cmitmode eq "tree"} {
4025 } elseif {[llength $olds] <= 1} {
4032 proc selfirstline {} {
4037 proc sellastline {} {
4040 set l [expr {$numcommits - 1}]
4044 proc selnextline {dir} {
4046 if {![info exists selectedline]} return
4047 set l [expr {$selectedline + $dir}]
4052 proc selnextpage {dir} {
4053 global canv linespc selectedline numcommits
4055 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4059 allcanvs yview scroll [expr {$dir * $lpp}] units
4061 if {![info exists selectedline]} return
4062 set l [expr {$selectedline + $dir * $lpp}]
4065 } elseif {$l >= $numcommits} {
4066 set l [expr $numcommits - 1]
4072 proc unselectline {} {
4073 global selectedline currentid
4075 catch {unset selectedline}
4076 catch {unset currentid}
4077 allcanvs delete secsel
4079 cancel_next_highlight
4082 proc reselectline {} {
4085 if {[info exists selectedline]} {
4086 selectline $selectedline 0
4090 proc addtohistory {cmd} {
4091 global history historyindex curview
4093 set elt [list $curview $cmd]
4094 if {$historyindex > 0
4095 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4099 if {$historyindex < [llength $history]} {
4100 set history [lreplace $history $historyindex end $elt]
4102 lappend history $elt
4105 if {$historyindex > 1} {
4106 .tf.bar.leftbut conf -state normal
4108 .tf.bar.leftbut conf -state disabled
4110 .tf.bar.rightbut conf -state disabled
4116 set view [lindex $elt 0]
4117 set cmd [lindex $elt 1]
4118 if {$curview != $view} {
4125 global history historyindex
4127 if {$historyindex > 1} {
4128 incr historyindex -1
4129 godo [lindex $history [expr {$historyindex - 1}]]
4130 .tf.bar.rightbut conf -state normal
4132 if {$historyindex <= 1} {
4133 .tf.bar.leftbut conf -state disabled
4138 global history historyindex
4140 if {$historyindex < [llength $history]} {
4141 set cmd [lindex $history $historyindex]
4144 .tf.bar.leftbut conf -state normal
4146 if {$historyindex >= [llength $history]} {
4147 .tf.bar.rightbut conf -state disabled
4152 global treefilelist treeidlist diffids diffmergeid treepending
4155 catch {unset diffmergeid}
4156 if {![info exists treefilelist($id)]} {
4157 if {![info exists treepending]} {
4158 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4162 set treefilelist($id) {}
4163 set treeidlist($id) {}
4164 fconfigure $gtf -blocking 0
4165 fileevent $gtf readable [list gettreeline $gtf $id]
4172 proc gettreeline {gtf id} {
4173 global treefilelist treeidlist treepending cmitmode diffids
4175 while {[gets $gtf line] >= 0} {
4176 if {[lindex $line 1] ne "blob"} continue
4177 set sha1 [lindex $line 2]
4178 set fname [lindex $line 3]
4179 lappend treefilelist($id) $fname
4180 lappend treeidlist($id) $sha1
4182 if {![eof $gtf]} return
4185 if {$cmitmode ne "tree"} {
4186 if {![info exists diffmergeid]} {
4187 gettreediffs $diffids
4189 } elseif {$id ne $diffids} {
4197 global treefilelist treeidlist diffids
4198 global ctext commentend
4200 set i [lsearch -exact $treefilelist($diffids) $f]
4202 puts "oops, $f not in list for id $diffids"
4205 set blob [lindex $treeidlist($diffids) $i]
4206 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4207 puts "oops, error reading blob $blob: $err"
4210 fconfigure $bf -blocking 0
4211 fileevent $bf readable [list getblobline $bf $diffids]
4212 $ctext config -state normal
4213 clear_ctext $commentend
4214 $ctext insert end "\n"
4215 $ctext insert end "$f\n" filesep
4216 $ctext config -state disabled
4217 $ctext yview $commentend
4220 proc getblobline {bf id} {
4221 global diffids cmitmode ctext
4223 if {$id ne $diffids || $cmitmode ne "tree"} {
4227 $ctext config -state normal
4228 while {[gets $bf line] >= 0} {
4229 $ctext insert end "$line\n"
4232 # delete last newline
4233 $ctext delete "end - 2c" "end - 1c"
4236 $ctext config -state disabled
4239 proc mergediff {id l} {
4240 global diffmergeid diffopts mdifffd
4246 # this doesn't seem to actually affect anything...
4247 set env(GIT_DIFF_OPTS) $diffopts
4248 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4249 if {[catch {set mdf [open $cmd r]} err]} {
4250 error_popup "Error getting merge diffs: $err"
4253 fconfigure $mdf -blocking 0
4254 set mdifffd($id) $mdf
4255 set np [llength [lindex $parentlist $l]]
4256 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4257 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4260 proc getmergediffline {mdf id np} {
4261 global diffmergeid ctext cflist nextupdate mergemax
4262 global difffilestart mdifffd
4264 set n [gets $mdf line]
4271 if {![info exists diffmergeid] || $id != $diffmergeid
4272 || $mdf != $mdifffd($id)} {
4275 $ctext conf -state normal
4276 if {[regexp {^diff --cc (.*)} $line match fname]} {
4277 # start of a new file
4278 $ctext insert end "\n"
4279 set here [$ctext index "end - 1c"]
4280 lappend difffilestart $here
4281 add_flist [list $fname]
4282 set l [expr {(78 - [string length $fname]) / 2}]
4283 set pad [string range "----------------------------------------" 1 $l]
4284 $ctext insert end "$pad $fname $pad\n" filesep
4285 } elseif {[regexp {^@@} $line]} {
4286 $ctext insert end "$line\n" hunksep
4287 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4290 # parse the prefix - one ' ', '-' or '+' for each parent
4295 for {set j 0} {$j < $np} {incr j} {
4296 set c [string range $line $j $j]
4299 } elseif {$c == "-"} {
4301 } elseif {$c == "+"} {
4310 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4311 # line doesn't appear in result, parents in $minuses have the line
4312 set num [lindex $minuses 0]
4313 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4314 # line appears in result, parents in $pluses don't have the line
4315 lappend tags mresult
4316 set num [lindex $spaces 0]
4319 if {$num >= $mergemax} {
4324 $ctext insert end "$line\n" $tags
4326 $ctext conf -state disabled
4327 if {[clock clicks -milliseconds] >= $nextupdate} {
4329 fileevent $mdf readable {}
4331 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4335 proc startdiff {ids} {
4336 global treediffs diffids treepending diffmergeid
4339 catch {unset diffmergeid}
4340 if {![info exists treediffs($ids)]} {
4341 if {![info exists treepending]} {
4349 proc addtocflist {ids} {
4350 global treediffs cflist
4351 add_flist $treediffs($ids)
4355 proc gettreediffs {ids} {
4356 global treediff treepending
4357 set treepending $ids
4360 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4362 fconfigure $gdtf -blocking 0
4363 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4366 proc gettreediffline {gdtf ids} {
4367 global treediff treediffs treepending diffids diffmergeid
4370 set n [gets $gdtf line]
4372 if {![eof $gdtf]} return
4374 set treediffs($ids) $treediff
4376 if {$cmitmode eq "tree"} {
4378 } elseif {$ids != $diffids} {
4379 if {![info exists diffmergeid]} {
4380 gettreediffs $diffids
4387 set file [lindex $line 5]
4388 lappend treediff $file
4391 proc getblobdiffs {ids} {
4392 global diffopts blobdifffd diffids env curdifftag curtagstart
4393 global nextupdate diffinhdr treediffs
4395 set env(GIT_DIFF_OPTS) $diffopts
4396 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4397 if {[catch {set bdf [open $cmd r]} err]} {
4398 puts "error getting diffs: $err"
4402 fconfigure $bdf -blocking 0
4403 set blobdifffd($ids) $bdf
4404 set curdifftag Comments
4406 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4407 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4410 proc setinlist {var i val} {
4413 while {[llength [set $var]] < $i} {
4416 if {[llength [set $var]] == $i} {
4423 proc getblobdiffline {bdf ids} {
4424 global diffids blobdifffd ctext curdifftag curtagstart
4425 global diffnexthead diffnextnote difffilestart
4426 global nextupdate diffinhdr treediffs
4428 set n [gets $bdf line]
4432 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4433 $ctext tag add $curdifftag $curtagstart end
4438 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4441 $ctext conf -state normal
4442 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4443 # start of a new file
4444 $ctext insert end "\n"
4445 $ctext tag add $curdifftag $curtagstart end
4446 set here [$ctext index "end - 1c"]
4447 set curtagstart $here
4449 set i [lsearch -exact $treediffs($ids) $fname]
4451 setinlist difffilestart $i $here
4453 if {$newname ne $fname} {
4454 set i [lsearch -exact $treediffs($ids) $newname]
4456 setinlist difffilestart $i $here
4459 set curdifftag "f:$fname"
4460 $ctext tag delete $curdifftag
4461 set l [expr {(78 - [string length $header]) / 2}]
4462 set pad [string range "----------------------------------------" 1 $l]
4463 $ctext insert end "$pad $header $pad\n" filesep
4465 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4467 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4469 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4470 $line match f1l f1c f2l f2c rest]} {
4471 $ctext insert end "$line\n" hunksep
4474 set x [string range $line 0 0]
4475 if {$x == "-" || $x == "+"} {
4476 set tag [expr {$x == "+"}]
4477 $ctext insert end "$line\n" d$tag
4478 } elseif {$x == " "} {
4479 $ctext insert end "$line\n"
4480 } elseif {$diffinhdr || $x == "\\"} {
4481 # e.g. "\ No newline at end of file"
4482 $ctext insert end "$line\n" filesep
4484 # Something else we don't recognize
4485 if {$curdifftag != "Comments"} {
4486 $ctext insert end "\n"
4487 $ctext tag add $curdifftag $curtagstart end
4488 set curtagstart [$ctext index "end - 1c"]
4489 set curdifftag Comments
4491 $ctext insert end "$line\n" filesep
4494 $ctext conf -state disabled
4495 if {[clock clicks -milliseconds] >= $nextupdate} {
4497 fileevent $bdf readable {}
4499 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4503 proc changediffdisp {} {
4504 global ctext diffelide
4506 $ctext tag conf d0 -elide [lindex $diffelide 0]
4507 $ctext tag conf d1 -elide [lindex $diffelide 1]
4511 global difffilestart ctext
4512 set prev [lindex $difffilestart 0]
4513 set here [$ctext index @0,0]
4514 foreach loc $difffilestart {
4515 if {[$ctext compare $loc >= $here]} {
4525 global difffilestart ctext
4526 set here [$ctext index @0,0]
4527 foreach loc $difffilestart {
4528 if {[$ctext compare $loc > $here]} {
4535 proc clear_ctext {{first 1.0}} {
4536 global ctext smarktop smarkbot
4538 set l [lindex [split $first .] 0]
4539 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4542 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4545 $ctext delete $first end
4548 proc incrsearch {name ix op} {
4549 global ctext searchstring searchdirn
4551 $ctext tag remove found 1.0 end
4552 if {[catch {$ctext index anchor}]} {
4553 # no anchor set, use start of selection, or of visible area
4554 set sel [$ctext tag ranges sel]
4556 $ctext mark set anchor [lindex $sel 0]
4557 } elseif {$searchdirn eq "-forwards"} {
4558 $ctext mark set anchor @0,0
4560 $ctext mark set anchor @0,[winfo height $ctext]
4563 if {$searchstring ne {}} {
4564 set here [$ctext search $searchdirn -- $searchstring anchor]
4573 global sstring ctext searchstring searchdirn
4576 $sstring icursor end
4577 set searchdirn -forwards
4578 if {$searchstring ne {}} {
4579 set sel [$ctext tag ranges sel]
4581 set start "[lindex $sel 0] + 1c"
4582 } elseif {[catch {set start [$ctext index anchor]}]} {
4585 set match [$ctext search -count mlen -- $searchstring $start]
4586 $ctext tag remove sel 1.0 end
4592 set mend "$match + $mlen c"
4593 $ctext tag add sel $match $mend
4594 $ctext mark unset anchor
4598 proc dosearchback {} {
4599 global sstring ctext searchstring searchdirn
4602 $sstring icursor end
4603 set searchdirn -backwards
4604 if {$searchstring ne {}} {
4605 set sel [$ctext tag ranges sel]
4607 set start [lindex $sel 0]
4608 } elseif {[catch {set start [$ctext index anchor]}]} {
4609 set start @0,[winfo height $ctext]
4611 set match [$ctext search -backwards -count ml -- $searchstring $start]
4612 $ctext tag remove sel 1.0 end
4618 set mend "$match + $ml c"
4619 $ctext tag add sel $match $mend
4620 $ctext mark unset anchor
4624 proc searchmark {first last} {
4625 global ctext searchstring
4629 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4630 if {$match eq {}} break
4631 set mend "$match + $mlen c"
4632 $ctext tag add found $match $mend
4636 proc searchmarkvisible {doall} {
4637 global ctext smarktop smarkbot
4639 set topline [lindex [split [$ctext index @0,0] .] 0]
4640 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4641 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4642 # no overlap with previous
4643 searchmark $topline $botline
4644 set smarktop $topline
4645 set smarkbot $botline
4647 if {$topline < $smarktop} {
4648 searchmark $topline [expr {$smarktop-1}]
4649 set smarktop $topline
4651 if {$botline > $smarkbot} {
4652 searchmark [expr {$smarkbot+1}] $botline
4653 set smarkbot $botline
4658 proc scrolltext {f0 f1} {
4661 .bleft.sb set $f0 $f1
4662 if {$searchstring ne {}} {
4668 global linespc charspc canvx0 canvy0 mainfont
4669 global xspc1 xspc2 lthickness
4671 set linespc [font metrics $mainfont -linespace]
4672 set charspc [font measure $mainfont "m"]
4673 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4674 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4675 set lthickness [expr {int($linespc / 9) + 1}]
4676 set xspc1(0) $linespc
4684 set ymax [lindex [$canv cget -scrollregion] 3]
4685 if {$ymax eq {} || $ymax == 0} return
4686 set span [$canv yview]
4689 allcanvs yview moveto [lindex $span 0]
4691 if {[info exists selectedline]} {
4692 selectline $selectedline 0
4693 allcanvs yview moveto [lindex $span 0]
4697 proc incrfont {inc} {
4698 global mainfont textfont ctext canv phase cflist
4699 global stopped entries
4701 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4702 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4704 $ctext conf -font $textfont
4705 $cflist conf -font $textfont
4706 $ctext tag conf filesep -font [concat $textfont bold]
4707 foreach e $entries {
4708 $e conf -font $mainfont
4710 if {$phase eq "getcommits"} {
4711 $canv itemconf textitems -font $mainfont
4717 global sha1entry sha1string
4718 if {[string length $sha1string] == 40} {
4719 $sha1entry delete 0 end
4723 proc sha1change {n1 n2 op} {
4724 global sha1string currentid sha1but
4725 if {$sha1string == {}
4726 || ([info exists currentid] && $sha1string == $currentid)} {
4731 if {[$sha1but cget -state] == $state} return
4732 if {$state == "normal"} {
4733 $sha1but conf -state normal -relief raised -text "Goto: "
4735 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4739 proc gotocommit {} {
4740 global sha1string currentid commitrow tagids headids
4741 global displayorder numcommits curview
4743 if {$sha1string == {}
4744 || ([info exists currentid] && $sha1string == $currentid)} return
4745 if {[info exists tagids($sha1string)]} {
4746 set id $tagids($sha1string)
4747 } elseif {[info exists headids($sha1string)]} {
4748 set id $headids($sha1string)
4750 set id [string tolower $sha1string]
4751 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4753 foreach i $displayorder {
4754 if {[string match $id* $i]} {
4758 if {$matches ne {}} {
4759 if {[llength $matches] > 1} {
4760 error_popup "Short SHA1 id $id is ambiguous"
4763 set id [lindex $matches 0]
4767 if {[info exists commitrow($curview,$id)]} {
4768 selectline $commitrow($curview,$id) 1
4771 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4776 error_popup "$type $sha1string is not known"
4779 proc lineenter {x y id} {
4780 global hoverx hovery hoverid hovertimer
4781 global commitinfo canv
4783 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4787 if {[info exists hovertimer]} {
4788 after cancel $hovertimer
4790 set hovertimer [after 500 linehover]
4794 proc linemotion {x y id} {
4795 global hoverx hovery hoverid hovertimer
4797 if {[info exists hoverid] && $id == $hoverid} {
4800 if {[info exists hovertimer]} {
4801 after cancel $hovertimer
4803 set hovertimer [after 500 linehover]
4807 proc lineleave {id} {
4808 global hoverid hovertimer canv
4810 if {[info exists hoverid] && $id == $hoverid} {
4812 if {[info exists hovertimer]} {
4813 after cancel $hovertimer
4821 global hoverx hovery hoverid hovertimer
4822 global canv linespc lthickness
4823 global commitinfo mainfont
4825 set text [lindex $commitinfo($hoverid) 0]
4826 set ymax [lindex [$canv cget -scrollregion] 3]
4827 if {$ymax == {}} return
4828 set yfrac [lindex [$canv yview] 0]
4829 set x [expr {$hoverx + 2 * $linespc}]
4830 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4831 set x0 [expr {$x - 2 * $lthickness}]
4832 set y0 [expr {$y - 2 * $lthickness}]
4833 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4834 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4835 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4836 -fill \#ffff80 -outline black -width 1 -tags hover]
4838 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4843 proc clickisonarrow {id y} {
4846 set ranges [rowranges $id]
4847 set thresh [expr {2 * $lthickness + 6}]
4848 set n [expr {[llength $ranges] - 1}]
4849 for {set i 1} {$i < $n} {incr i} {
4850 set row [lindex $ranges $i]
4851 if {abs([yc $row] - $y) < $thresh} {
4858 proc arrowjump {id n y} {
4861 # 1 <-> 2, 3 <-> 4, etc...
4862 set n [expr {(($n - 1) ^ 1) + 1}]
4863 set row [lindex [rowranges $id] $n]
4865 set ymax [lindex [$canv cget -scrollregion] 3]
4866 if {$ymax eq {} || $ymax <= 0} return
4867 set view [$canv yview]
4868 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4869 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4873 allcanvs yview moveto $yfrac
4876 proc lineclick {x y id isnew} {
4877 global ctext commitinfo children canv thickerline curview
4879 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4884 # draw this line thicker than normal
4888 set ymax [lindex [$canv cget -scrollregion] 3]
4889 if {$ymax eq {}} return
4890 set yfrac [lindex [$canv yview] 0]
4891 set y [expr {$y + $yfrac * $ymax}]
4893 set dirn [clickisonarrow $id $y]
4895 arrowjump $id $dirn $y
4900 addtohistory [list lineclick $x $y $id 0]
4902 # fill the details pane with info about this line
4903 $ctext conf -state normal
4905 $ctext tag conf link -foreground blue -underline 1
4906 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4907 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4908 $ctext insert end "Parent:\t"
4909 $ctext insert end $id [list link link0]
4910 $ctext tag bind link0 <1> [list selbyid $id]
4911 set info $commitinfo($id)
4912 $ctext insert end "\n\t[lindex $info 0]\n"
4913 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4914 set date [formatdate [lindex $info 2]]
4915 $ctext insert end "\tDate:\t$date\n"
4916 set kids $children($curview,$id)
4918 $ctext insert end "\nChildren:"
4920 foreach child $kids {
4922 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4923 set info $commitinfo($child)
4924 $ctext insert end "\n\t"
4925 $ctext insert end $child [list link link$i]
4926 $ctext tag bind link$i <1> [list selbyid $child]
4927 $ctext insert end "\n\t[lindex $info 0]"
4928 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4929 set date [formatdate [lindex $info 2]]
4930 $ctext insert end "\n\tDate:\t$date\n"
4933 $ctext conf -state disabled
4937 proc normalline {} {
4939 if {[info exists thickerline]} {
4947 global commitrow curview
4948 if {[info exists commitrow($curview,$id)]} {
4949 selectline $commitrow($curview,$id) 1
4955 if {![info exists startmstime]} {
4956 set startmstime [clock clicks -milliseconds]
4958 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4961 proc rowmenu {x y id} {
4962 global rowctxmenu commitrow selectedline rowmenuid curview
4964 if {![info exists selectedline]
4965 || $commitrow($curview,$id) eq $selectedline} {
4970 $rowctxmenu entryconfigure "Diff this*" -state $state
4971 $rowctxmenu entryconfigure "Diff selected*" -state $state
4972 $rowctxmenu entryconfigure "Make patch" -state $state
4974 tk_popup $rowctxmenu $x $y
4977 proc diffvssel {dirn} {
4978 global rowmenuid selectedline displayorder
4980 if {![info exists selectedline]} return
4982 set oldid [lindex $displayorder $selectedline]
4983 set newid $rowmenuid
4985 set oldid $rowmenuid
4986 set newid [lindex $displayorder $selectedline]
4988 addtohistory [list doseldiff $oldid $newid]
4989 doseldiff $oldid $newid
4992 proc doseldiff {oldid newid} {
4996 $ctext conf -state normal
4999 $ctext insert end "From "
5000 $ctext tag conf link -foreground blue -underline 1
5001 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5002 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5003 $ctext tag bind link0 <1> [list selbyid $oldid]
5004 $ctext insert end $oldid [list link link0]
5005 $ctext insert end "\n "
5006 $ctext insert end [lindex $commitinfo($oldid) 0]
5007 $ctext insert end "\n\nTo "
5008 $ctext tag bind link1 <1> [list selbyid $newid]
5009 $ctext insert end $newid [list link link1]
5010 $ctext insert end "\n "
5011 $ctext insert end [lindex $commitinfo($newid) 0]
5012 $ctext insert end "\n"
5013 $ctext conf -state disabled
5014 $ctext tag delete Comments
5015 $ctext tag remove found 1.0 end
5016 startdiff [list $oldid $newid]
5020 global rowmenuid currentid commitinfo patchtop patchnum
5022 if {![info exists currentid]} return
5023 set oldid $currentid
5024 set oldhead [lindex $commitinfo($oldid) 0]
5025 set newid $rowmenuid
5026 set newhead [lindex $commitinfo($newid) 0]
5029 catch {destroy $top}
5031 label $top.title -text "Generate patch"
5032 grid $top.title - -pady 10
5033 label $top.from -text "From:"
5034 entry $top.fromsha1 -width 40 -relief flat
5035 $top.fromsha1 insert 0 $oldid
5036 $top.fromsha1 conf -state readonly
5037 grid $top.from $top.fromsha1 -sticky w
5038 entry $top.fromhead -width 60 -relief flat
5039 $top.fromhead insert 0 $oldhead
5040 $top.fromhead conf -state readonly
5041 grid x $top.fromhead -sticky w
5042 label $top.to -text "To:"
5043 entry $top.tosha1 -width 40 -relief flat
5044 $top.tosha1 insert 0 $newid
5045 $top.tosha1 conf -state readonly
5046 grid $top.to $top.tosha1 -sticky w
5047 entry $top.tohead -width 60 -relief flat
5048 $top.tohead insert 0 $newhead
5049 $top.tohead conf -state readonly
5050 grid x $top.tohead -sticky w
5051 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5052 grid $top.rev x -pady 10
5053 label $top.flab -text "Output file:"
5054 entry $top.fname -width 60
5055 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5057 grid $top.flab $top.fname -sticky w
5059 button $top.buts.gen -text "Generate" -command mkpatchgo
5060 button $top.buts.can -text "Cancel" -command mkpatchcan
5061 grid $top.buts.gen $top.buts.can
5062 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5063 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5064 grid $top.buts - -pady 10 -sticky ew
5068 proc mkpatchrev {} {
5071 set oldid [$patchtop.fromsha1 get]
5072 set oldhead [$patchtop.fromhead get]
5073 set newid [$patchtop.tosha1 get]
5074 set newhead [$patchtop.tohead get]
5075 foreach e [list fromsha1 fromhead tosha1 tohead] \
5076 v [list $newid $newhead $oldid $oldhead] {
5077 $patchtop.$e conf -state normal
5078 $patchtop.$e delete 0 end
5079 $patchtop.$e insert 0 $v
5080 $patchtop.$e conf -state readonly
5087 set oldid [$patchtop.fromsha1 get]
5088 set newid [$patchtop.tosha1 get]
5089 set fname [$patchtop.fname get]
5090 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5091 error_popup "Error creating patch: $err"
5093 catch {destroy $patchtop}
5097 proc mkpatchcan {} {
5100 catch {destroy $patchtop}
5105 global rowmenuid mktagtop commitinfo
5109 catch {destroy $top}
5111 label $top.title -text "Create tag"
5112 grid $top.title - -pady 10
5113 label $top.id -text "ID:"
5114 entry $top.sha1 -width 40 -relief flat
5115 $top.sha1 insert 0 $rowmenuid
5116 $top.sha1 conf -state readonly
5117 grid $top.id $top.sha1 -sticky w
5118 entry $top.head -width 60 -relief flat
5119 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5120 $top.head conf -state readonly
5121 grid x $top.head -sticky w
5122 label $top.tlab -text "Tag name:"
5123 entry $top.tag -width 60
5124 grid $top.tlab $top.tag -sticky w
5126 button $top.buts.gen -text "Create" -command mktaggo
5127 button $top.buts.can -text "Cancel" -command mktagcan
5128 grid $top.buts.gen $top.buts.can
5129 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5130 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5131 grid $top.buts - -pady 10 -sticky ew
5136 global mktagtop env tagids idtags
5138 set id [$mktagtop.sha1 get]
5139 set tag [$mktagtop.tag get]
5141 error_popup "No tag name specified"
5144 if {[info exists tagids($tag)]} {
5145 error_popup "Tag \"$tag\" already exists"
5150 set fname [file join $dir "refs/tags" $tag]
5151 set f [open $fname w]
5155 error_popup "Error creating tag: $err"
5159 set tagids($tag) $id
5160 lappend idtags($id) $tag
5165 proc redrawtags {id} {
5166 global canv linehtag commitrow idpos selectedline curview
5167 global mainfont canvxmax
5169 if {![info exists commitrow($curview,$id)]} return
5170 drawcmitrow $commitrow($curview,$id)
5171 $canv delete tag.$id
5172 set xt [eval drawtags $id $idpos($id)]
5173 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5174 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5175 set xr [expr {$xt + [font measure $mainfont $text]}]
5176 if {$xr > $canvxmax} {
5180 if {[info exists selectedline]
5181 && $selectedline == $commitrow($curview,$id)} {
5182 selectline $selectedline 0
5189 catch {destroy $mktagtop}
5198 proc writecommit {} {
5199 global rowmenuid wrcomtop commitinfo wrcomcmd
5201 set top .writecommit
5203 catch {destroy $top}
5205 label $top.title -text "Write commit to file"
5206 grid $top.title - -pady 10
5207 label $top.id -text "ID:"
5208 entry $top.sha1 -width 40 -relief flat
5209 $top.sha1 insert 0 $rowmenuid
5210 $top.sha1 conf -state readonly
5211 grid $top.id $top.sha1 -sticky w
5212 entry $top.head -width 60 -relief flat
5213 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5214 $top.head conf -state readonly
5215 grid x $top.head -sticky w
5216 label $top.clab -text "Command:"
5217 entry $top.cmd -width 60 -textvariable wrcomcmd
5218 grid $top.clab $top.cmd -sticky w -pady 10
5219 label $top.flab -text "Output file:"
5220 entry $top.fname -width 60
5221 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5222 grid $top.flab $top.fname -sticky w
5224 button $top.buts.gen -text "Write" -command wrcomgo
5225 button $top.buts.can -text "Cancel" -command wrcomcan
5226 grid $top.buts.gen $top.buts.can
5227 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5228 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5229 grid $top.buts - -pady 10 -sticky ew
5236 set id [$wrcomtop.sha1 get]
5237 set cmd "echo $id | [$wrcomtop.cmd get]"
5238 set fname [$wrcomtop.fname get]
5239 if {[catch {exec sh -c $cmd >$fname &} err]} {
5240 error_popup "Error writing commit: $err"
5242 catch {destroy $wrcomtop}
5249 catch {destroy $wrcomtop}
5254 global rowmenuid mkbrtop
5257 catch {destroy $top}
5259 label $top.title -text "Create new branch"
5260 grid $top.title - -pady 10
5261 label $top.id -text "ID:"
5262 entry $top.sha1 -width 40 -relief flat
5263 $top.sha1 insert 0 $rowmenuid
5264 $top.sha1 conf -state readonly
5265 grid $top.id $top.sha1 -sticky w
5266 label $top.nlab -text "Name:"
5267 entry $top.name -width 40
5268 grid $top.nlab $top.name -sticky w
5270 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5271 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5272 grid $top.buts.go $top.buts.can
5273 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5274 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5275 grid $top.buts - -pady 10 -sticky ew
5280 global headids idheads
5282 set name [$top.name get]
5283 set id [$top.sha1 get]
5285 error_popup "Please specify a name for the new branch"
5288 catch {destroy $top}
5292 exec git branch $name $id
5298 # XXX should update list of heads displayed for selected commit
5304 proc cherrypick {} {
5305 global rowmenuid curview commitrow
5306 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5308 if {[info exists desc_heads($rowmenuid)]
5309 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5310 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5311 included in branch $mainhead -- really re-apply it?"]
5316 set oldhead [exec git rev-parse HEAD]
5317 # Unfortunately git-cherry-pick writes stuff to stderr even when
5318 # no error occurs, and exec takes that as an indication of error...
5319 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5324 set newhead [exec git rev-parse HEAD]
5325 if {$newhead eq $oldhead} {
5327 error_popup "No changes committed"
5330 set allparents($newhead) $oldhead
5331 lappend allchildren($oldhead) $newhead
5332 set desc_heads($newhead) $mainhead
5333 if {[info exists anc_tags($oldhead)]} {
5334 set anc_tags($newhead) $anc_tags($oldhead)
5336 set desc_tags($newhead) {}
5337 if {[info exists commitrow($curview,$oldhead)]} {
5338 insertrow $commitrow($curview,$oldhead) $newhead
5339 if {$mainhead ne {}} {
5340 movedhead $newhead $mainhead
5348 # context menu for a head
5349 proc headmenu {x y id head} {
5350 global headmenuid headmenuhead headctxmenu
5353 set headmenuhead $head
5354 tk_popup $headctxmenu $x $y
5358 global headmenuid headmenuhead mainhead headids
5360 # check the tree is clean first??
5361 set oldmainhead $mainhead
5365 exec git checkout -q $headmenuhead
5371 set mainhead $headmenuhead
5372 if {[info exists headids($oldmainhead)]} {
5373 redrawtags $headids($oldmainhead)
5375 redrawtags $headmenuid
5380 global desc_heads headmenuid headmenuhead mainhead
5381 global headids idheads
5383 set head $headmenuhead
5385 if {$head eq $mainhead} {
5386 error_popup "Cannot delete the currently checked-out branch"
5389 if {$desc_heads($id) eq $head} {
5390 # the stuff on this branch isn't on any other branch
5391 if {![confirm_popup "The commits on branch $head aren't on any other\
5392 branch.\nReally delete branch $head?"]} return
5396 if {[catch {exec git branch -D $head} err]} {
5401 removedhead $id $head
5406 # Stuff for finding nearby tags
5407 proc getallcommits {} {
5408 global allcstart allcommits allcfd allids
5411 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5413 fconfigure $fd -blocking 0
5414 set allcommits "reading"
5419 proc discardallcommits {} {
5420 global allparents allchildren allcommits allcfd
5421 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5423 if {![info exists allcommits]} return
5424 if {$allcommits eq "reading"} {
5425 catch {close $allcfd}
5427 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5428 alldtags tagisdesc desc_heads} {
5433 proc restartgetall {fd} {
5436 fileevent $fd readable [list getallclines $fd]
5437 set allcstart [clock clicks -milliseconds]
5440 proc combine_dtags {l1 l2} {
5441 global tagisdesc notfirstd
5443 set res [lsort -unique [concat $l1 $l2]]
5444 for {set i 0} {$i < [llength $res]} {incr i} {
5445 set x [lindex $res $i]
5446 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5447 set y [lindex $res $j]
5448 if {[info exists tagisdesc($x,$y)]} {
5449 if {$tagisdesc($x,$y) > 0} {
5450 # x is a descendent of y, exclude x
5451 set res [lreplace $res $i $i]
5455 # y is a descendent of x, exclude y
5456 set res [lreplace $res $j $j]
5459 # no relation, keep going
5467 proc combine_atags {l1 l2} {
5470 set res [lsort -unique [concat $l1 $l2]]
5471 for {set i 0} {$i < [llength $res]} {incr i} {
5472 set x [lindex $res $i]
5473 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5474 set y [lindex $res $j]
5475 if {[info exists tagisdesc($x,$y)]} {
5476 if {$tagisdesc($x,$y) < 0} {
5477 # x is an ancestor of y, exclude x
5478 set res [lreplace $res $i $i]
5482 # y is an ancestor of x, exclude y
5483 set res [lreplace $res $j $j]
5486 # no relation, keep going
5494 proc forward_pass {id children} {
5495 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5499 foreach child $children {
5500 if {[info exists idtags($child)]} {
5501 set ctags [list $child]
5503 set ctags $desc_tags($child)
5507 } elseif {$ctags ne $dtags} {
5508 set dtags [combine_dtags $dtags $ctags]
5510 set cheads $desc_heads($child)
5511 if {$dheads eq {}} {
5513 } elseif {$cheads ne $dheads} {
5514 set dheads [lsort -unique [concat $dheads $cheads]]
5517 set desc_tags($id) $dtags
5518 if {[info exists idtags($id)]} {
5520 foreach tag $dtags {
5521 set adt [concat $adt $alldtags($tag)]
5523 set adt [lsort -unique $adt]
5524 set alldtags($id) $adt
5526 set tagisdesc($id,$tag) -1
5527 set tagisdesc($tag,$id) 1
5530 if {[info exists idheads($id)]} {
5531 set dheads [concat $dheads $idheads($id)]
5533 set desc_heads($id) $dheads
5536 proc getallclines {fd} {
5537 global allparents allchildren allcommits allcstart
5538 global desc_tags anc_tags idtags tagisdesc allids
5539 global idheads travindex
5541 while {[gets $fd line] >= 0} {
5542 set id [lindex $line 0]
5544 set olds [lrange $line 1 end]
5545 set allparents($id) $olds
5546 if {![info exists allchildren($id)]} {
5547 set allchildren($id) {}
5550 lappend allchildren($p) $id
5552 # compute nearest tagged descendents as we go
5553 # also compute descendent heads
5554 forward_pass $id $allchildren($id)
5555 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5556 fileevent $fd readable {}
5557 after idle restartgetall $fd
5562 set travindex [llength $allids]
5563 set allcommits "traversing"
5564 after idle restartatags
5565 if {[catch {close $fd} err]} {
5566 error_popup "Error reading full commit graph: $err.\n\
5567 Results may be incomplete."
5572 # walk backward through the tree and compute nearest tagged ancestors
5573 proc restartatags {} {
5574 global allids allparents idtags anc_tags travindex
5576 set t0 [clock clicks -milliseconds]
5578 while {[incr i -1] >= 0} {
5579 set id [lindex $allids $i]
5581 foreach p $allparents($id) {
5582 if {[info exists idtags($p)]} {
5585 set ptags $anc_tags($p)
5589 } elseif {$ptags ne $atags} {
5590 set atags [combine_atags $atags $ptags]
5593 set anc_tags($id) $atags
5594 if {[clock clicks -milliseconds] - $t0 >= 50} {
5596 after idle restartatags
5600 set allcommits "done"
5606 # update the desc_tags and anc_tags arrays for a new tag just added
5607 proc addedtag {id} {
5608 global desc_tags anc_tags allparents allchildren allcommits
5609 global idtags tagisdesc alldtags
5611 if {![info exists desc_tags($id)]} return
5612 set adt $desc_tags($id)
5613 foreach t $desc_tags($id) {
5614 set adt [concat $adt $alldtags($t)]
5616 set adt [lsort -unique $adt]
5617 set alldtags($id) $adt
5619 set tagisdesc($id,$t) -1
5620 set tagisdesc($t,$id) 1
5622 if {[info exists anc_tags($id)]} {
5623 set todo $anc_tags($id)
5624 while {$todo ne {}} {
5625 set do [lindex $todo 0]
5626 set todo [lrange $todo 1 end]
5627 if {[info exists tagisdesc($id,$do)]} continue
5628 set tagisdesc($do,$id) -1
5629 set tagisdesc($id,$do) 1
5630 if {[info exists anc_tags($do)]} {
5631 set todo [concat $todo $anc_tags($do)]
5636 set lastold $desc_tags($id)
5637 set lastnew [list $id]
5640 set todo $allparents($id)
5641 while {$todo ne {}} {
5642 set do [lindex $todo 0]
5643 set todo [lrange $todo 1 end]
5644 if {![info exists desc_tags($do)]} continue
5645 if {$desc_tags($do) ne $lastold} {
5646 set lastold $desc_tags($do)
5647 set lastnew [combine_dtags $lastold [list $id]]
5650 if {$lastold eq $lastnew} continue
5651 set desc_tags($do) $lastnew
5653 if {![info exists idtags($do)]} {
5654 set todo [concat $todo $allparents($do)]
5658 if {![info exists anc_tags($id)]} return
5659 set lastold $anc_tags($id)
5660 set lastnew [list $id]
5663 set todo $allchildren($id)
5664 while {$todo ne {}} {
5665 set do [lindex $todo 0]
5666 set todo [lrange $todo 1 end]
5667 if {![info exists anc_tags($do)]} continue
5668 if {$anc_tags($do) ne $lastold} {
5669 set lastold $anc_tags($do)
5670 set lastnew [combine_atags $lastold [list $id]]
5673 if {$lastold eq $lastnew} continue
5674 set anc_tags($do) $lastnew
5676 if {![info exists idtags($do)]} {
5677 set todo [concat $todo $allchildren($do)]
5682 # update the desc_heads array for a new head just added
5683 proc addedhead {hid head} {
5684 global desc_heads allparents headids idheads
5686 set headids($head) $hid
5687 lappend idheads($hid) $head
5689 set todo [list $hid]
5690 while {$todo ne {}} {
5691 set do [lindex $todo 0]
5692 set todo [lrange $todo 1 end]
5693 if {![info exists desc_heads($do)] ||
5694 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5695 set oldheads $desc_heads($do)
5696 lappend desc_heads($do) $head
5697 set heads $desc_heads($do)
5699 set p $allparents($do)
5700 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5701 $desc_heads($p) ne $oldheads} break
5703 set desc_heads($do) $heads
5705 set todo [concat $todo $p]
5709 # update the desc_heads array for a head just removed
5710 proc removedhead {hid head} {
5711 global desc_heads allparents headids idheads
5713 unset headids($head)
5714 if {$idheads($hid) eq $head} {
5717 set i [lsearch -exact $idheads($hid) $head]
5719 set idheads($hid) [lreplace $idheads($hid) $i $i]
5723 set todo [list $hid]
5724 while {$todo ne {}} {
5725 set do [lindex $todo 0]
5726 set todo [lrange $todo 1 end]
5727 if {![info exists desc_heads($do)]} continue
5728 set i [lsearch -exact $desc_heads($do) $head]
5729 if {$i < 0} continue
5730 set oldheads $desc_heads($do)
5731 set heads [lreplace $desc_heads($do) $i $i]
5733 set desc_heads($do) $heads
5734 set p $allparents($do)
5735 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5736 $desc_heads($p) ne $oldheads} break
5739 set todo [concat $todo $p]
5743 # update things for a head moved to a child of its previous location
5744 proc movedhead {id name} {
5745 global headids idheads
5747 set oldid $headids($name)
5748 set headids($name) $id
5749 if {$idheads($oldid) eq $name} {
5750 unset idheads($oldid)
5752 set i [lsearch -exact $idheads($oldid) $name]
5754 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5757 lappend idheads($id) $name
5760 proc changedrefs {} {
5761 global desc_heads desc_tags anc_tags allcommits allids
5762 global allchildren allparents idtags travindex
5764 if {![info exists allcommits]} return
5765 catch {unset desc_heads}
5766 catch {unset desc_tags}
5767 catch {unset anc_tags}
5768 catch {unset alldtags}
5769 catch {unset tagisdesc}
5770 foreach id $allids {
5771 forward_pass $id $allchildren($id)
5773 if {$allcommits ne "reading"} {
5774 set travindex [llength $allids]
5775 if {$allcommits ne "traversing"} {
5776 set allcommits "traversing"
5777 after idle restartatags
5782 proc rereadrefs {} {
5783 global idtags idheads idotherrefs mainhead
5785 set refids [concat [array names idtags] \
5786 [array names idheads] [array names idotherrefs]]
5787 foreach id $refids {
5788 if {![info exists ref($id)]} {
5789 set ref($id) [listrefs $id]
5792 set oldmainhead $mainhead
5795 set refids [lsort -unique [concat $refids [array names idtags] \
5796 [array names idheads] [array names idotherrefs]]]
5797 foreach id $refids {
5798 set v [listrefs $id]
5799 if {![info exists ref($id)] || $ref($id) != $v ||
5800 ($id eq $oldmainhead && $id ne $mainhead) ||
5801 ($id eq $mainhead && $id ne $oldmainhead)} {
5807 proc listrefs {id} {
5808 global idtags idheads idotherrefs
5811 if {[info exists idtags($id)]} {
5815 if {[info exists idheads($id)]} {
5819 if {[info exists idotherrefs($id)]} {
5820 set z $idotherrefs($id)
5822 return [list $x $y $z]
5825 proc showtag {tag isnew} {
5826 global ctext tagcontents tagids linknum
5829 addtohistory [list showtag $tag 0]
5831 $ctext conf -state normal
5834 if {[info exists tagcontents($tag)]} {
5835 set text $tagcontents($tag)
5837 set text "Tag: $tag\nId: $tagids($tag)"
5839 appendwithlinks $text {}
5840 $ctext conf -state disabled
5852 global maxwidth maxgraphpct diffopts
5853 global oldprefs prefstop showneartags
5854 global bgcolor fgcolor ctext diffcolors selectbgcolor
5859 if {[winfo exists $top]} {
5863 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5864 set oldprefs($v) [set $v]
5867 wm title $top "Gitk preferences"
5868 label $top.ldisp -text "Commit list display options"
5869 $top.ldisp configure -font $uifont
5870 grid $top.ldisp - -sticky w -pady 10
5871 label $top.spacer -text " "
5872 label $top.maxwidthl -text "Maximum graph width (lines)" \
5874 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5875 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5876 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5878 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5879 grid x $top.maxpctl $top.maxpct -sticky w
5881 label $top.ddisp -text "Diff display options"
5882 $top.ddisp configure -font $uifont
5883 grid $top.ddisp - -sticky w -pady 10
5884 label $top.diffoptl -text "Options for diff program" \
5886 entry $top.diffopt -width 20 -textvariable diffopts
5887 grid x $top.diffoptl $top.diffopt -sticky w
5889 label $top.ntag.l -text "Display nearby tags" -font optionfont
5890 checkbutton $top.ntag.b -variable showneartags
5891 pack $top.ntag.b $top.ntag.l -side left
5892 grid x $top.ntag -sticky w
5894 label $top.cdisp -text "Colors: press to choose"
5895 $top.cdisp configure -font $uifont
5896 grid $top.cdisp - -sticky w -pady 10
5897 label $top.bg -padx 40 -relief sunk -background $bgcolor
5898 button $top.bgbut -text "Background" -font optionfont \
5899 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5900 grid x $top.bgbut $top.bg -sticky w
5901 label $top.fg -padx 40 -relief sunk -background $fgcolor
5902 button $top.fgbut -text "Foreground" -font optionfont \
5903 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5904 grid x $top.fgbut $top.fg -sticky w
5905 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5906 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5907 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5908 [list $ctext tag conf d0 -foreground]]
5909 grid x $top.diffoldbut $top.diffold -sticky w
5910 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5911 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5912 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5913 [list $ctext tag conf d1 -foreground]]
5914 grid x $top.diffnewbut $top.diffnew -sticky w
5915 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5916 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5917 -command [list choosecolor diffcolors 2 $top.hunksep \
5918 "diff hunk header" \
5919 [list $ctext tag conf hunksep -foreground]]
5920 grid x $top.hunksepbut $top.hunksep -sticky w
5921 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
5922 button $top.selbgbut -text "Select bg" -font optionfont \
5923 -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
5924 grid x $top.selbgbut $top.selbgsep -sticky w
5927 button $top.buts.ok -text "OK" -command prefsok -default active
5928 $top.buts.ok configure -font $uifont
5929 button $top.buts.can -text "Cancel" -command prefscan -default normal
5930 $top.buts.can configure -font $uifont
5931 grid $top.buts.ok $top.buts.can
5932 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5933 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5934 grid $top.buts - - -pady 10 -sticky ew
5935 bind $top <Visibility> "focus $top.buts.ok"
5938 proc choosecolor {v vi w x cmd} {
5941 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5942 -title "Gitk: choose color for $x"]
5943 if {$c eq {}} return
5944 $w conf -background $c
5950 global bglist cflist
5952 $w configure -selectbackground $c
5954 $cflist tag configure highlight \
5955 -background [$cflist cget -selectbackground]
5956 allcanvs itemconf secsel -fill $c
5963 $w conf -background $c
5971 $w conf -foreground $c
5973 allcanvs itemconf text -fill $c
5974 $canv itemconf circle -outline $c
5978 global maxwidth maxgraphpct diffopts
5979 global oldprefs prefstop showneartags
5981 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5982 set $v $oldprefs($v)
5984 catch {destroy $prefstop}
5989 global maxwidth maxgraphpct
5990 global oldprefs prefstop showneartags
5992 catch {destroy $prefstop}
5994 if {$maxwidth != $oldprefs(maxwidth)
5995 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5997 } elseif {$showneartags != $oldprefs(showneartags)} {
6002 proc formatdate {d} {
6003 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6006 # This list of encoding names and aliases is distilled from
6007 # http://www.iana.org/assignments/character-sets.
6008 # Not all of them are supported by Tcl.
6009 set encoding_aliases {
6010 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6011 ISO646-US US-ASCII us IBM367 cp367 csASCII }
6012 { ISO-10646-UTF-1 csISO10646UTF1 }
6013 { ISO_646.basic:1983 ref csISO646basic1983 }
6014 { INVARIANT csINVARIANT }
6015 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6016 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6017 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6018 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6019 { NATS-DANO iso-ir-9-1 csNATSDANO }
6020 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6021 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6022 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6023 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6024 { ISO-2022-KR csISO2022KR }
6026 { ISO-2022-JP csISO2022JP }
6027 { ISO-2022-JP-2 csISO2022JP2 }
6028 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6030 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6031 { IT iso-ir-15 ISO646-IT csISO15Italian }
6032 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6033 { ES iso-ir-17 ISO646-ES csISO17Spanish }
6034 { greek7-old iso-ir-18 csISO18Greek7Old }
6035 { latin-greek iso-ir-19 csISO19LatinGreek }
6036 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6037 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6038 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6039 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6040 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6041 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6042 { INIS iso-ir-49 csISO49INIS }
6043 { INIS-8 iso-ir-50 csISO50INIS8 }
6044 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6045 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6046 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6047 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6048 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6049 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6051 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6052 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6053 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6054 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6055 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6056 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6057 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6058 { greek7 iso-ir-88 csISO88Greek7 }
6059 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6060 { iso-ir-90 csISO90 }
6061 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6062 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6063 csISO92JISC62991984b }
6064 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6065 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6066 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6067 csISO95JIS62291984handadd }
6068 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6069 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6070 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6071 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6073 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6074 { T.61-7bit iso-ir-102 csISO102T617bit }
6075 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6076 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6077 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6078 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6079 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6080 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6081 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6082 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6083 arabic csISOLatinArabic }
6084 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6085 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6086 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6087 greek greek8 csISOLatinGreek }
6088 { T.101-G2 iso-ir-128 csISO128T101G2 }
6089 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6091 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6092 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6093 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6094 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6095 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6096 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6097 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6098 csISOLatinCyrillic }
6099 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6100 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6101 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6102 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6103 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6104 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6105 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6106 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6107 { ISO_10367-box iso-ir-155 csISO10367Box }
6108 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6109 { latin-lap lap iso-ir-158 csISO158Lap }
6110 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6111 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6114 { JIS_X0201 X0201 csHalfWidthKatakana }
6115 { KSC5636 ISO646-KR csKSC5636 }
6116 { ISO-10646-UCS-2 csUnicode }
6117 { ISO-10646-UCS-4 csUCS4 }
6118 { DEC-MCS dec csDECMCS }
6119 { hp-roman8 roman8 r8 csHPRoman8 }
6120 { macintosh mac csMacintosh }
6121 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6123 { IBM038 EBCDIC-INT cp038 csIBM038 }
6124 { IBM273 CP273 csIBM273 }
6125 { IBM274 EBCDIC-BE CP274 csIBM274 }
6126 { IBM275 EBCDIC-BR cp275 csIBM275 }
6127 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6128 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6129 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6130 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6131 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6132 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6133 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6134 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6135 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6136 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6137 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6138 { IBM437 cp437 437 csPC8CodePage437 }
6139 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6140 { IBM775 cp775 csPC775Baltic }
6141 { IBM850 cp850 850 csPC850Multilingual }
6142 { IBM851 cp851 851 csIBM851 }
6143 { IBM852 cp852 852 csPCp852 }
6144 { IBM855 cp855 855 csIBM855 }
6145 { IBM857 cp857 857 csIBM857 }
6146 { IBM860 cp860 860 csIBM860 }
6147 { IBM861 cp861 861 cp-is csIBM861 }
6148 { IBM862 cp862 862 csPC862LatinHebrew }
6149 { IBM863 cp863 863 csIBM863 }
6150 { IBM864 cp864 csIBM864 }
6151 { IBM865 cp865 865 csIBM865 }
6152 { IBM866 cp866 866 csIBM866 }
6153 { IBM868 CP868 cp-ar csIBM868 }
6154 { IBM869 cp869 869 cp-gr csIBM869 }
6155 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6156 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6157 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6158 { IBM891 cp891 csIBM891 }
6159 { IBM903 cp903 csIBM903 }
6160 { IBM904 cp904 904 csIBBM904 }
6161 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6162 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6163 { IBM1026 CP1026 csIBM1026 }
6164 { EBCDIC-AT-DE csIBMEBCDICATDE }
6165 { EBCDIC-AT-DE-A csEBCDICATDEA }
6166 { EBCDIC-CA-FR csEBCDICCAFR }
6167 { EBCDIC-DK-NO csEBCDICDKNO }
6168 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6169 { EBCDIC-FI-SE csEBCDICFISE }
6170 { EBCDIC-FI-SE-A csEBCDICFISEA }
6171 { EBCDIC-FR csEBCDICFR }
6172 { EBCDIC-IT csEBCDICIT }
6173 { EBCDIC-PT csEBCDICPT }
6174 { EBCDIC-ES csEBCDICES }
6175 { EBCDIC-ES-A csEBCDICESA }
6176 { EBCDIC-ES-S csEBCDICESS }
6177 { EBCDIC-UK csEBCDICUK }
6178 { EBCDIC-US csEBCDICUS }
6179 { UNKNOWN-8BIT csUnknown8BiT }
6180 { MNEMONIC csMnemonic }
6185 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6186 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6187 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6188 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6189 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6190 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6191 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6192 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6193 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6194 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6195 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6196 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6197 { IBM1047 IBM-1047 }
6198 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6199 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6200 { UNICODE-1-1 csUnicode11 }
6203 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6204 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6206 { ISO-8859-15 ISO_8859-15 Latin-9 }
6207 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6208 { GBK CP936 MS936 windows-936 }
6209 { JIS_Encoding csJISEncoding }
6210 { Shift_JIS MS_Kanji csShiftJIS }
6211 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6213 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6214 { ISO-10646-UCS-Basic csUnicodeASCII }
6215 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6216 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6217 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6218 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6219 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6220 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6221 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6222 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6223 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6224 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6225 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6226 { Ventura-US csVenturaUS }
6227 { Ventura-International csVenturaInternational }
6228 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6229 { PC8-Turkish csPC8Turkish }
6230 { IBM-Symbols csIBMSymbols }
6231 { IBM-Thai csIBMThai }
6232 { HP-Legal csHPLegal }
6233 { HP-Pi-font csHPPiFont }
6234 { HP-Math8 csHPMath8 }
6235 { Adobe-Symbol-Encoding csHPPSMath }
6236 { HP-DeskTop csHPDesktop }
6237 { Ventura-Math csVenturaMath }
6238 { Microsoft-Publishing csMicrosoftPublishing }
6239 { Windows-31J csWindows31J }
6244 proc tcl_encoding {enc} {
6245 global encoding_aliases
6246 set names [encoding names]
6247 set lcnames [string tolower $names]
6248 set enc [string tolower $enc]
6249 set i [lsearch -exact $lcnames $enc]
6251 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6252 if {[regsub {^iso[-_]} $enc iso encx]} {
6253 set i [lsearch -exact $lcnames $encx]
6257 foreach l $encoding_aliases {
6258 set ll [string tolower $l]
6259 if {[lsearch -exact $ll $enc] < 0} continue
6260 # look through the aliases for one that tcl knows about
6262 set i [lsearch -exact $lcnames $e]
6264 if {[regsub {^iso[-_]} $e iso ex]} {
6265 set i [lsearch -exact $lcnames $ex]
6274 return [lindex $names $i]
6281 set diffopts "-U 5 -p"
6282 set wrcomcmd "git diff-tree --stdin -p --pretty"
6286 set gitencoding [exec git config --get i18n.commitencoding]
6288 if {$gitencoding == ""} {
6289 set gitencoding "utf-8"
6291 set tclencoding [tcl_encoding $gitencoding]
6292 if {$tclencoding == {}} {
6293 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6296 set mainfont {Helvetica 9}
6297 set textfont {Courier 9}
6298 set uifont {Helvetica 9 bold}
6299 set findmergefiles 0
6307 set cmitmode "patch"
6308 set wrapcomment "none"
6311 set colors {green red blue magenta darkgrey brown orange}
6314 set diffcolors {red "#00a000" blue}
6315 set selectbgcolor gray85
6317 catch {source ~/.gitk}
6319 font create optionfont -family sans-serif -size -12
6323 switch -regexp -- $arg {
6325 "^-d" { set datemode 1 }
6327 lappend revtreeargs $arg
6332 # check that we can find a .git directory somewhere...
6334 if {![file isdirectory $gitdir]} {
6335 show_error {} . "Cannot find the git directory \"$gitdir\"."
6339 set cmdline_files {}
6340 set i [lsearch -exact $revtreeargs "--"]
6342 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6343 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6344 } elseif {$revtreeargs ne {}} {
6346 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6347 set cmdline_files [split $f "\n"]
6348 set n [llength $cmdline_files]
6349 set revtreeargs [lrange $revtreeargs 0 end-$n]
6351 # unfortunately we get both stdout and stderr in $err,
6352 # so look for "fatal:".
6353 set i [string first "fatal:" $err]
6355 set err [string range $err [expr {$i + 6}] end]
6357 show_error {} . "Bad arguments to gitk:\n$err"
6366 set highlight_paths {}
6367 set searchdirn -forwards
6377 set selectedhlview None
6388 wm title . "[file tail $argv0]: [file tail [pwd]]"
6391 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6392 # create a view for the files/dirs specified on the command line
6396 set viewname(1) "Command line"
6397 set viewfiles(1) $cmdline_files
6398 set viewargs(1) $revtreeargs
6401 .bar.view entryconf Edit* -state normal
6402 .bar.view entryconf Delete* -state normal
6405 if {[info exists permviews]} {
6406 foreach v $permviews {
6409 set viewname($n) [lindex $v 0]
6410 set viewfiles($n) [lindex $v 1]
6411 set viewargs($n) [lindex $v 2]