2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 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
)]} {
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
27 set commitidx
($view) 0
28 set args
$viewargs($view)
29 if {$viewfiles($view) ne
{}} {
30 set args
[concat
$args "--" $viewfiles($view)]
32 set order
"--topo-order"
34 set order
"--date-order"
37 set fd
[open
[concat | git rev-list
--header $order \
38 --parents --boundary --default HEAD
$args] r
]
40 puts stderr
"Error executing git rev-list: $err"
44 set leftover
($view) {}
45 fconfigure
$fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure
$fd -encoding $tclencoding
49 fileevent
$fd readable
[list getcommitlines
$fd $view]
53 proc stop_rev_list
{} {
56 if {![info exists commfd
($curview)]} return
57 set fd
$commfd($curview)
63 unset commfd
($curview)
67 global phase canv mainfont curview
71 start_rev_list
$curview
72 show_status
"Reading commits..."
75 proc getcommitlines
{fd view
} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof
$fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure
$fd -blocking 1
90 if {[catch
{close
$fd} err
]} {
92 if {$view != $curview} {
93 set fv
" for the \"$viewname($view)\" view"
95 if {[string range
$err 0 4] == "usage"} {
96 set err
"Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq
"Command line"} {
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
104 set err
"Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i
[string first
"\0" $stuff $start]
118 append leftover
($view) [string range
$stuff $start end
]
122 set cmit
$leftover($view)
123 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
124 set leftover
($view) {}
126 set cmit
[string range
$stuff $start [expr {$i - 1}]]
128 set start
[expr {$i + 1}]
129 set j
[string first
"\n" $cmit]
133 set ids
[string range
$cmit 0 [expr {$j - 1}]]
134 if {[string range
$ids 0 0] == "-"} {
136 set ids
[string range
$ids 1 end
]
140 if {[string length
$id] != 40} {
148 if {[string length
$shortcmit] > 80} {
149 set shortcmit
"[string range $shortcmit 0 80]..."
151 error_popup
"Can't parse git rev-list output: {$shortcmit}"
154 set id
[lindex
$ids 0]
156 set olds
[lrange
$ids 1 end
]
159 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
160 lappend children
($view,$p) $id
167 if {![info exists children
($view,$id)]} {
168 set children
($view,$id) {}
170 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
171 set commitrow
($view,$id) $commitidx($view)
172 incr commitidx
($view)
173 if {$view == $curview} {
174 lappend parentlist
$olds
175 lappend childlist
$children($view,$id)
176 lappend displayorder
$id
177 lappend commitlisted
$listed
179 lappend vparentlist
($view) $olds
180 lappend vchildlist
($view) $children($view,$id)
181 lappend vdisporder
($view) $id
182 lappend vcmitlisted
($view) $listed
187 if {$view == $curview} {
189 } elseif
{[info exists hlview
] && $view == $hlview} {
193 if {[clock clicks
-milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v
[array names commfd
] {
202 fileevent
$commfd($v) readable
{}
205 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate
[expr {$numcommits + 1}]
208 } elseif
{$numcommits < 10000} {
209 set ncmupdate
[expr {$numcommits + 10}]
211 set ncmupdate
[expr {$numcommits + 100}]
213 foreach v
[array names commfd
] {
215 fileevent
$fd readable
[list getcommitlines
$fd $v]
219 proc readcommit
{id
} {
220 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
221 parsecommit
$id $contents 0
224 proc updatecommits
{} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
233 foreach id
$displayorder {
234 catch
{unset children
($n,$id)}
235 catch
{unset commitrow
($n,$id)}
238 catch
{unset selectedline
}
239 catch
{unset thickerline
}
240 catch
{unset viewdata
($n)}
245 proc parsecommit
{id contents listed
} {
246 global commitinfo cdate
255 set hdrend
[string first
"\n\n" $contents]
257 # should never happen...
258 set hdrend
[string length
$contents]
260 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
261 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
262 foreach line
[split $header "\n"] {
263 set tag
[lindex
$line 0]
264 if {$tag == "author"} {
265 set audate
[lindex
$line end-1
]
266 set auname
[lrange
$line 1 end-2
]
267 } elseif
{$tag == "committer"} {
268 set comdate
[lindex
$line end-1
]
269 set comname
[lrange
$line 1 end-2
]
273 # take the first line of the comment as the headline
274 set i
[string first
"\n" $comment]
276 set headline
[string trim
[string range
$comment 0 $i]]
278 set headline
$comment
281 # git rev-list indents the comment by 4 spaces;
282 # if we got this via git cat-file, add the indentation
284 foreach line
[split $comment "\n"] {
285 append newcomment
" "
286 append newcomment
$line
287 append newcomment
"\n"
289 set comment
$newcomment
291 if {$comdate != {}} {
292 set cdate
($id) $comdate
294 set commitinfo
($id) [list
$headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit
{id
} {
299 global commitdata commitinfo
301 if {[info exists commitdata
($id)]} {
302 parsecommit
$id $commitdata($id) 1
305 if {![info exists commitinfo
($id)]} {
306 set commitinfo
($id) {"No commit information available"}
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
319 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
320 while {0 <= [set n
[gets
$refd line
]]} {
321 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
325 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
328 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
332 if {[regexp
{^remotes
/} $path match
]} {
335 if {$type == "tags"} {
336 set tagids
($name) $id
337 lappend idtags
($id) $name
342 set commit
[exec git rev-parse
"$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids
($name) $commit
345 lappend idtags
($commit) $name
349 set tagcontents
($name) [exec git cat-file tag
"$id"]
351 } elseif
{ $type == "heads" } {
352 set headids
($name) $id
353 lappend idheads
($id) $name
355 set otherrefids
($name) $id
356 lappend idotherrefs
($id) $name
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
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax wrapcomment
386 global highlight_files gdttype
387 global searchstring sstring
390 .bar add cascade
-label "File" -menu .bar.
file
391 .bar configure
-font $uifont
393 .bar.
file add
command -label "Update" -command updatecommits
394 .bar.
file add
command -label "Reread references" -command rereadrefs
395 .bar.
file add
command -label "Quit" -command doquit
396 .bar.
file configure
-font $uifont
398 .bar add cascade
-label "Edit" -menu .bar.edit
399 .bar.edit add
command -label "Preferences" -command doprefs
400 .bar.edit configure
-font $uifont
402 menu .bar.view
-font $uifont
403 .bar add cascade
-label "View" -menu .bar.view
404 .bar.view add
command -label "New view..." -command {newview
0}
405 .bar.view add
command -label "Edit view..." -command editview \
407 .bar.view add
command -label "Delete view" -command delview
-state disabled
408 .bar.view add separator
409 .bar.view add radiobutton
-label "All files" -command {showview
0} \
410 -variable selectedview
-value 0
413 .bar add cascade
-label "Help" -menu .bar.
help
414 .bar.
help add
command -label "About gitk" -command about
415 .bar.
help add
command -label "Key bindings" -command keys
416 .bar.
help configure
-font $uifont
417 . configure
-menu .bar
419 if {![info exists geometry
(canv1
)]} {
420 set geometry
(canv1
) [expr {45 * $charspc}]
421 set geometry
(canv2
) [expr {30 * $charspc}]
422 set geometry
(canv3
) [expr {15 * $charspc}]
423 set geometry
(canvh
) [expr {25 * $linespc + 4}]
424 set geometry
(ctextw
) 80
425 set geometry
(ctexth
) 30
426 set geometry
(cflistw
) 30
428 panedwindow .ctop
-orient vertical
429 if {[info exists geometry
(width
)]} {
430 .ctop conf
-width $geometry(width
) -height $geometry(height
)
431 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
432 set geometry
(ctexth
) [expr {($texth - 8) /
433 [font metrics
$textfont -linespace]}]
438 pack .ctop.top.lbar
-side bottom
-fill x
439 pack .ctop.top.bar
-side bottom
-fill x
440 set cscroll .ctop.top.csb
441 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
442 pack
$cscroll -side right
-fill y
443 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
444 pack .ctop.top.clist
-side top
-fill both
-expand 1
446 set canv .ctop.top.clist.canv
447 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add
$canv
451 set canv2 .ctop.top.clist.canv2
452 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
453 -bg white
-bd 0 -yscrollincr $linespc
454 .ctop.top.clist add
$canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
457 -bg white
-bd 0 -yscrollincr $linespc
458 .ctop.top.clist add
$canv3
459 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
461 set sha1entry .ctop.top.bar.sha1
462 set entries
$sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
465 -command gotocommit
-width 8 -font $uifont
466 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
467 pack .ctop.top.bar.sha1label
-side left
468 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string
write sha1change
470 pack
$sha1entry -side left
-pady 2
472 image create bitmap bm-left
-data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits
[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right
-data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits
[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
489 -state disabled
-width 26
490 pack .ctop.top.bar.leftbut
-side left
-fill y
491 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
492 -state disabled
-width 26
493 pack .ctop.top.bar.rightbut
-side left
-fill y
495 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
496 pack .ctop.top.bar.findbut
-side left
498 set fstring .ctop.top.bar.findstring
499 lappend entries
$fstring
500 entry
$fstring -width 30 -font $textfont -textvariable findstring
501 trace add variable findstring
write find_change
502 pack
$fstring -side left
-expand 1 -fill x
504 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
505 findtype Exact IgnCase Regexp
]
506 trace add variable findtype
write find_change
507 .ctop.top.bar.findtype configure
-font $uifont
508 .ctop.top.bar.findtype.menu configure
-font $uifont
509 set findloc
"All fields"
510 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
511 Comments Author Committer
512 trace add variable findloc
write find_change
513 .ctop.top.bar.findloc configure
-font $uifont
514 .ctop.top.bar.findloc.menu configure
-font $uifont
515 pack .ctop.top.bar.findloc
-side right
516 pack .ctop.top.bar.findtype
-side right
518 label .ctop.top.lbar.flabel
-text "Highlight: Commits " \
520 pack .ctop.top.lbar.flabel
-side left
-fill y
521 set gdttype
"touching paths:"
522 set gm
[tk_optionMenu .ctop.top.lbar.gdttype gdttype
"touching paths:" \
523 "adding/removing string:"]
524 trace add variable gdttype
write hfiles_change
525 $gm conf
-font $uifont
526 .ctop.top.lbar.gdttype conf
-font $uifont
527 pack .ctop.top.lbar.gdttype
-side left
-fill y
528 entry .ctop.top.lbar.fent
-width 25 -font $textfont \
529 -textvariable highlight_files
530 trace add variable highlight_files
write hfiles_change
531 lappend entries .ctop.top.lbar.fent
532 pack .ctop.top.lbar.fent
-side left
-fill x
-expand 1
533 label .ctop.top.lbar.vlabel
-text " OR in view" -font $uifont
534 pack .ctop.top.lbar.vlabel
-side left
-fill y
535 global viewhlmenu selectedhlview
536 set viewhlmenu
[tk_optionMenu .ctop.top.lbar.vhl selectedhlview None
]
537 $viewhlmenu entryconf
0 -command delvhighlight
538 $viewhlmenu conf
-font $uifont
539 .ctop.top.lbar.vhl conf
-font $uifont
540 pack .ctop.top.lbar.vhl
-side left
-fill y
541 label .ctop.top.lbar.rlabel
-text " OR " -font $uifont
542 pack .ctop.top.lbar.rlabel
-side left
-fill y
543 global highlight_related
544 set m
[tk_optionMenu .ctop.top.lbar.relm highlight_related None \
545 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
546 $m conf
-font $uifont
547 .ctop.top.lbar.relm conf
-font $uifont
548 trace add variable highlight_related
write vrel_change
549 pack .ctop.top.lbar.relm
-side left
-fill y
551 panedwindow .ctop.cdet
-orient horizontal
553 frame .ctop.cdet.left
554 frame .ctop.cdet.left.bot
555 pack .ctop.cdet.left.bot
-side bottom
-fill x
556 button .ctop.cdet.left.bot.search
-text "Search" -command dosearch \
558 pack .ctop.cdet.left.bot.search
-side left
-padx 5
559 set sstring .ctop.cdet.left.bot.sstring
560 entry
$sstring -width 20 -font $textfont -textvariable searchstring
561 lappend entries
$sstring
562 trace add variable searchstring
write incrsearch
563 pack
$sstring -side left
-expand 1 -fill x
564 set ctext .ctop.cdet.left.ctext
565 text
$ctext -bg white
-state disabled
-font $textfont \
566 -width $geometry(ctextw
) -height $geometry(ctexth
) \
567 -yscrollcommand scrolltext
-wrap none
568 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
569 pack .ctop.cdet.left.sb
-side right
-fill y
570 pack
$ctext -side left
-fill both
-expand 1
571 .ctop.cdet add .ctop.cdet.left
573 $ctext tag conf comment
-wrap $wrapcomment
574 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
575 $ctext tag conf hunksep
-fore blue
576 $ctext tag conf d0
-fore red
577 $ctext tag conf d1
-fore "#00a000"
578 $ctext tag conf m0
-fore red
579 $ctext tag conf m1
-fore blue
580 $ctext tag conf m2
-fore green
581 $ctext tag conf m3
-fore purple
582 $ctext tag conf
m4 -fore brown
583 $ctext tag conf m5
-fore "#009090"
584 $ctext tag conf m6
-fore magenta
585 $ctext tag conf m7
-fore "#808000"
586 $ctext tag conf m8
-fore "#009000"
587 $ctext tag conf m9
-fore "#ff0080"
588 $ctext tag conf m10
-fore cyan
589 $ctext tag conf m11
-fore "#b07070"
590 $ctext tag conf m12
-fore "#70b0f0"
591 $ctext tag conf m13
-fore "#70f0b0"
592 $ctext tag conf m14
-fore "#f0b070"
593 $ctext tag conf m15
-fore "#ff70b0"
594 $ctext tag conf mmax
-fore darkgrey
596 $ctext tag conf mresult
-font [concat
$textfont bold
]
597 $ctext tag conf msep
-font [concat
$textfont bold
]
598 $ctext tag conf found
-back yellow
600 frame .ctop.cdet.right
601 frame .ctop.cdet.right.mode
602 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
603 -command reselectline
-variable cmitmode
-value "patch"
604 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
605 -command reselectline
-variable cmitmode
-value "tree"
606 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
607 pack .ctop.cdet.right.mode
-side top
-fill x
608 set cflist .ctop.cdet.right.cfiles
609 set indent
[font measure
$mainfont "nn"]
610 text
$cflist -width $geometry(cflistw
) -background white
-font $mainfont \
611 -tabs [list
$indent [expr {2 * $indent}]] \
612 -yscrollcommand ".ctop.cdet.right.sb set" \
613 -cursor [. cget
-cursor] \
614 -spacing1 1 -spacing3 1
615 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
616 pack .ctop.cdet.right.sb
-side right
-fill y
617 pack
$cflist -side left
-fill both
-expand 1
618 $cflist tag configure highlight \
619 -background [$cflist cget
-selectbackground]
620 $cflist tag configure bold
-font [concat
$mainfont bold
]
621 .ctop.cdet add .ctop.cdet.right
622 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
624 pack .ctop
-side top
-fill both
-expand 1
626 bindall
<1> {selcanvline
%W
%x
%y
}
627 #bindall <B1-Motion> {selcanvline %W %x %y}
628 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
629 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
630 bindall
<2> "canvscan mark %W %x %y"
631 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
632 bindkey
<Home
> selfirstline
633 bindkey
<End
> sellastline
634 bind .
<Key-Up
> "selnextline -1"
635 bind .
<Key-Down
> "selnextline 1"
636 bind .
<Shift-Key-Up
> "next_highlight -1"
637 bind .
<Shift-Key-Down
> "next_highlight 1"
638 bindkey
<Key-Right
> "goforw"
639 bindkey
<Key-Left
> "goback"
640 bind .
<Key-Prior
> "selnextpage -1"
641 bind .
<Key-Next
> "selnextpage 1"
642 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
643 bind .
<Control-End
> "allcanvs yview moveto 1.0"
644 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
645 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
646 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
647 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
648 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
649 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
650 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
651 bindkey p
"selnextline -1"
652 bindkey n
"selnextline 1"
655 bindkey i
"selnextline -1"
656 bindkey k
"selnextline 1"
659 bindkey b
"$ctext yview scroll -1 pages"
660 bindkey d
"$ctext yview scroll 18 units"
661 bindkey u
"$ctext yview scroll -18 units"
662 bindkey
/ {findnext
1}
663 bindkey
<Key-Return
> {findnext
0}
666 bind .
<Control-q
> doquit
667 bind .
<Control-f
> dofind
668 bind .
<Control-g
> {findnext
0}
669 bind .
<Control-r
> dosearchback
670 bind .
<Control-s
> dosearch
671 bind .
<Control-equal
> {incrfont
1}
672 bind .
<Control-KP_Add
> {incrfont
1}
673 bind .
<Control-minus
> {incrfont
-1}
674 bind .
<Control-KP_Subtract
> {incrfont
-1}
675 bind .
<Destroy
> {savestuff
%W
}
676 bind .
<Button-1
> "click %W"
677 bind $fstring <Key-Return
> dofind
678 bind $sha1entry <Key-Return
> gotocommit
679 bind $sha1entry <<PasteSelection>> clearsha1
680 bind $cflist <1> {sel_flist %W %x %y; break}
681 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
682 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
684 set maincursor [. cget -cursor]
685 set textcursor [$ctext cget -cursor]
686 set curtextcursor $textcursor
688 set rowctxmenu .rowctxmenu
689 menu $rowctxmenu -tearoff 0
690 $rowctxmenu add command -label "Diff this -> selected" \
691 -command {diffvssel 0}
692 $rowctxmenu add command -label "Diff selected -> this" \
693 -command {diffvssel 1}
694 $rowctxmenu add command -label "Make patch" -command mkpatch
695 $rowctxmenu add command -label "Create tag" -command mktag
696 $rowctxmenu add command -label "Write commit to file" -command writecommit
699 # mouse-2 makes all windows scan vertically, but only the one
700 # the cursor is in scans horizontally
701 proc canvscan {op w x y} {
702 global canv canv2 canv3
703 foreach c [list $canv $canv2 $canv3] {
712 proc scrollcanv {cscroll f0 f1} {
718 # when we make a key binding for the toplevel, make sure
719 # it doesn't get triggered when that key is pressed in the
720 # find string entry widget.
721 proc bindkey {ev script} {
724 set escript [bind Entry $ev]
725 if {$escript == {}} {
726 set escript [bind Entry <Key>]
729 bind $e $ev "$escript; break"
733 # set the focus back to the toplevel for any click outside
744 global canv canv2 canv3 ctext cflist mainfont textfont uifont
745 global stuffsaved findmergefiles maxgraphpct
747 global viewname viewfiles viewargs viewperm nextviewnum
748 global cmitmode wrapcomment
750 if {$stuffsaved} return
751 if {![winfo viewable .]} return
753 set f [open "~/.gitk-new" w]
754 puts $f [list set mainfont $mainfont]
755 puts $f [list set textfont $textfont]
756 puts $f [list set uifont $uifont]
757 puts $f [list set findmergefiles $findmergefiles]
758 puts $f [list set maxgraphpct $maxgraphpct]
759 puts $f [list set maxwidth $maxwidth]
760 puts $f [list set cmitmode $cmitmode]
761 puts $f [list set wrapcomment $wrapcomment]
762 puts $f "set geometry(width) [winfo width .ctop]"
763 puts $f "set geometry(height) [winfo height .ctop]"
764 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
765 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
766 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
767 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
768 set wid [expr {([winfo width $ctext] - 8) \
769 / [font measure $textfont "0"]}]
770 puts $f "set geometry(ctextw) $wid"
771 set wid [expr {([winfo width $cflist] - 11) \
772 / [font measure [$cflist cget -font] "0"]}]
773 puts $f "set geometry(cflistw) $wid"
774 puts -nonewline $f "set permviews {"
775 for {set v 0} {$v < $nextviewnum} {incr v} {
777 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
782 file rename -force "~/.gitk-new" "~/.gitk"
787 proc resizeclistpanes {win w} {
789 if {[info exists oldwidth($win)]} {
790 set s0 [$win sash coord 0]
791 set s1 [$win sash coord 1]
793 set sash0 [expr {int($w/2 - 2)}]
794 set sash1 [expr {int($w*5/6 - 2)}]
796 set factor [expr {1.0 * $w / $oldwidth($win)}]
797 set sash0 [expr {int($factor * [lindex $s0 0])}]
798 set sash1 [expr {int($factor * [lindex $s1 0])}]
802 if {$sash1 < $sash0 + 20} {
803 set sash1 [expr {$sash0 + 20}]
805 if {$sash1 > $w - 10} {
806 set sash1 [expr {$w - 10}]
807 if {$sash0 > $sash1 - 20} {
808 set sash0 [expr {$sash1 - 20}]
812 $win sash place 0 $sash0 [lindex $s0 1]
813 $win sash place 1 $sash1 [lindex $s1 1]
815 set oldwidth($win) $w
818 proc resizecdetpanes {win w} {
820 if {[info exists oldwidth($win)]} {
821 set s0 [$win sash coord 0]
823 set sash0 [expr {int($w*3/4 - 2)}]
825 set factor [expr {1.0 * $w / $oldwidth($win)}]
826 set sash0 [expr {int($factor * [lindex $s0 0])}]
830 if {$sash0 > $w - 15} {
831 set sash0 [expr {$w - 15}]
834 $win sash place 0 $sash0 [lindex $s0 1]
836 set oldwidth($win) $w
840 global canv canv2 canv3
846 proc bindall {event action} {
847 global canv canv2 canv3
848 bind $canv $event $action
849 bind $canv2 $event $action
850 bind $canv3 $event $action
855 if {[winfo exists $w]} {
860 wm title $w "About gitk"
862 Gitk - a commit viewer for git
864 Copyright © 2005-2006 Paul Mackerras
866 Use and redistribute under the terms of the GNU General Public License} \
867 -justify center -aspect 400
868 pack $w.m -side top -fill x -padx 20 -pady 20
869 button $w.ok -text Close -command "destroy $w"
870 pack $w.ok -side bottom
875 if {[winfo exists $w]} {
880 wm title $w "Gitk key bindings"
885 <Home> Move to first commit
886 <End> Move to last commit
887 <Up>, p, i Move up one commit
888 <Down>, n, k Move down one commit
889 <Left>, z, j Go back in history list
890 <Right>, x, l Go forward in history list
891 <PageUp> Move up one page in commit list
892 <PageDown> Move down one page in commit list
893 <Ctrl-Home> Scroll to top of commit list
894 <Ctrl-End> Scroll to bottom of commit list
895 <Ctrl-Up> Scroll commit list up one line
896 <Ctrl-Down> Scroll commit list down one line
897 <Ctrl-PageUp> Scroll commit list up one page
898 <Ctrl-PageDown> Scroll commit list down one page
899 <Shift-Up> Move to previous highlighted line
900 <Shift-Down> Move to next highlighted line
901 <Delete>, b Scroll diff view up one page
902 <Backspace> Scroll diff view up one page
903 <Space> Scroll diff view down one page
904 u Scroll diff view up 18 lines
905 d Scroll diff view down 18 lines
907 <Ctrl-G> Move to next find hit
908 <Return> Move to next find hit
909 / Move to next find hit, or redo find
910 ? Move to previous find hit
911 f Scroll diff view to next file
912 <Ctrl-S> Search for next hit in diff view
913 <Ctrl-R> Search for previous hit in diff view
914 <Ctrl-KP+> Increase font size
915 <Ctrl-plus> Increase font size
916 <Ctrl-KP-> Decrease font size
917 <Ctrl-minus> Decrease font size
919 -justify left -bg white -border 2 -relief sunken
920 pack $w.m -side top -fill both
921 button $w.ok -text Close -command "destroy $w"
922 pack $w.ok -side bottom
925 # Procedures for manipulating the file list window at the
926 # bottom right of the overall window.
928 proc treeview {w l openlevs} {
929 global treecontents treediropen treeheight treeparent treeindex
939 set treecontents() {}
940 $w conf -state normal
942 while {[string range $f 0 $prefixend] ne $prefix} {
943 if {$lev <= $openlevs} {
944 $w mark set e:$treeindex($prefix) "end -1c"
945 $w mark gravity e:$treeindex($prefix) left
947 set treeheight($prefix) $ht
948 incr ht [lindex $htstack end]
949 set htstack [lreplace $htstack end end]
950 set prefixend [lindex $prefendstack end]
951 set prefendstack [lreplace $prefendstack end end]
952 set prefix [string range $prefix 0 $prefixend]
955 set tail [string range $f [expr {$prefixend+1}] end]
956 while {[set slash [string first "/" $tail]] >= 0} {
959 lappend prefendstack $prefixend
960 incr prefixend [expr {$slash + 1}]
961 set d [string range $tail 0 $slash]
962 lappend treecontents($prefix) $d
963 set oldprefix $prefix
965 set treecontents($prefix) {}
966 set treeindex($prefix) [incr ix]
967 set treeparent($prefix) $oldprefix
968 set tail [string range $tail [expr {$slash+1}] end]
969 if {$lev <= $openlevs} {
971 set treediropen($prefix) [expr {$lev < $openlevs}]
972 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
973 $w mark set d:$ix "end -1c"
974 $w mark gravity d:$ix left
976 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
978 $w image create end -align center -image $bm -padx 1 \
980 $w insert end $d [highlight_tag $prefix]
981 $w mark set s:$ix "end -1c"
982 $w mark gravity s:$ix left
987 if {$lev <= $openlevs} {
990 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
992 $w insert end $tail [highlight_tag $f]
994 lappend treecontents($prefix) $tail
997 while {$htstack ne {}} {
998 set treeheight($prefix) $ht
999 incr ht [lindex $htstack end]
1000 set htstack [lreplace $htstack end end]
1002 $w conf -state disabled
1005 proc linetoelt {l} {
1006 global treeheight treecontents
1011 foreach e $treecontents($prefix) {
1016 if {[string index $e end] eq "/"} {
1017 set n $treeheight($prefix$e)
1029 proc highlight_tree {y prefix} {
1030 global treeheight treecontents cflist
1032 foreach e $treecontents($prefix) {
1034 if {[highlight_tag $path] ne {}} {
1035 $cflist tag add bold $y.0 "$y.0 lineend"
1038 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1039 set y [highlight_tree $y $path]
1045 proc treeclosedir {w dir} {
1046 global treediropen treeheight treeparent treeindex
1048 set ix $treeindex($dir)
1049 $w conf -state normal
1050 $w delete s:$ix e:$ix
1051 set treediropen($dir) 0
1052 $w image configure a:$ix -image tri-rt
1053 $w conf -state disabled
1054 set n [expr {1 - $treeheight($dir)}]
1055 while {$dir ne {}} {
1056 incr treeheight($dir) $n
1057 set dir $treeparent($dir)
1061 proc treeopendir {w dir} {
1062 global treediropen treeheight treeparent treecontents treeindex
1064 set ix $treeindex($dir)
1065 $w conf -state normal
1066 $w image configure a:$ix -image tri-dn
1067 $w mark set e:$ix s:$ix
1068 $w mark gravity e:$ix right
1071 set n [llength $treecontents($dir)]
1072 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1075 incr treeheight($x) $n
1077 foreach e $treecontents($dir) {
1079 if {[string index $e end] eq "/"} {
1080 set iy $treeindex($de)
1081 $w mark set d:$iy e:$ix
1082 $w mark gravity d:$iy left
1083 $w insert e:$ix $str
1084 set treediropen($de) 0
1085 $w image create e:$ix -align center -image tri-rt -padx 1 \
1087 $w insert e:$ix $e [highlight_tag $de]
1088 $w mark set s:$iy e:$ix
1089 $w mark gravity s:$iy left
1090 set treeheight($de) 1
1092 $w insert e:$ix $str
1093 $w insert e:$ix $e [highlight_tag $de]
1096 $w mark gravity e:$ix left
1097 $w conf -state disabled
1098 set treediropen($dir) 1
1099 set top [lindex [split [$w index @0,0] .] 0]
1100 set ht [$w cget -height]
1101 set l [lindex [split [$w index s:$ix] .] 0]
1104 } elseif {$l + $n + 1 > $top + $ht} {
1105 set top [expr {$l + $n + 2 - $ht}]
1113 proc treeclick {w x y} {
1114 global treediropen cmitmode ctext cflist cflist_top
1116 if {$cmitmode ne "tree"} return
1117 if {![info exists cflist_top]} return
1118 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1119 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1120 $cflist tag add highlight $l.0 "$l.0 lineend"
1126 set e [linetoelt $l]
1127 if {[string index $e end] ne "/"} {
1129 } elseif {$treediropen($e)} {
1136 proc setfilelist {id} {
1137 global treefilelist cflist
1139 treeview $cflist $treefilelist($id) 0
1142 image create bitmap tri-rt -background black -foreground blue -data {
1143 #define tri-rt_width 13
1144 #define tri-rt_height 13
1145 static unsigned char tri-rt_bits[] = {
1146 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1147 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1150 #define tri-rt-mask_width 13
1151 #define tri-rt-mask_height 13
1152 static unsigned char tri-rt-mask_bits[] = {
1153 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1154 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1157 image create bitmap tri-dn -background black -foreground blue -data {
1158 #define tri-dn_width 13
1159 #define tri-dn_height 13
1160 static unsigned char tri-dn_bits[] = {
1161 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1162 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1165 #define tri-dn-mask_width 13
1166 #define tri-dn-mask_height 13
1167 static unsigned char tri-dn-mask_bits[] = {
1168 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1169 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1173 proc init_flist {first} {
1174 global cflist cflist_top selectedline difffilestart
1176 $cflist conf -state normal
1177 $cflist delete 0.0 end
1179 $cflist insert end $first
1181 $cflist tag add highlight 1.0 "1.0 lineend"
1183 catch {unset cflist_top}
1185 $cflist conf -state disabled
1186 set difffilestart {}
1189 proc highlight_tag {f} {
1190 global highlight_paths
1192 foreach p $highlight_paths {
1193 if {[string match $p $f]} {
1200 proc highlight_filelist {} {
1201 global cmitmode cflist
1203 $cflist conf -state normal
1204 if {$cmitmode ne "tree"} {
1205 set end [lindex [split [$cflist index end] .] 0]
1206 for {set l 2} {$l < $end} {incr l} {
1207 set line [$cflist get $l.0 "$l.0 lineend"]
1208 if {[highlight_tag $line] ne {}} {
1209 $cflist tag add bold $l.0 "$l.0 lineend"
1215 $cflist conf -state disabled
1218 proc unhighlight_filelist {} {
1221 $cflist conf -state normal
1222 $cflist tag remove bold 1.0 end
1223 $cflist conf -state disabled
1226 proc add_flist {fl} {
1229 $cflist conf -state normal
1231 $cflist insert end "\n"
1232 $cflist insert end $f [highlight_tag $f]
1234 $cflist conf -state disabled
1237 proc sel_flist {w x y} {
1238 global ctext difffilestart cflist cflist_top cmitmode
1240 if {$cmitmode eq "tree"} return
1241 if {![info exists cflist_top]} return
1242 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1243 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1244 $cflist tag add highlight $l.0 "$l.0 lineend"
1249 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1253 # Functions for adding and removing shell-type quoting
1255 proc shellquote {str} {
1256 if {![string match "*\['\"\\ \t]*" $str]} {
1259 if {![string match "*\['\"\\]*" $str]} {
1262 if {![string match "*'*" $str]} {
1265 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1268 proc shellarglist {l} {
1274 append str [shellquote $a]
1279 proc shelldequote {str} {
1284 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1285 append ret [string range $str $used end]
1286 set used [string length $str]
1289 set first [lindex $first 0]
1290 set ch [string index $str $first]
1291 if {$first > $used} {
1292 append ret [string range $str $used [expr {$first - 1}]]
1295 if {$ch eq " " || $ch eq "\t"} break
1298 set first [string first "'" $str $used]
1300 error "unmatched single-quote"
1302 append ret [string range $str $used [expr {$first - 1}]]
1307 if {$used >= [string length $str]} {
1308 error "trailing backslash"
1310 append ret [string index $str $used]
1315 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1316 error "unmatched double-quote"
1318 set first [lindex $first 0]
1319 set ch [string index $str $first]
1320 if {$first > $used} {
1321 append ret [string range $str $used [expr {$first - 1}]]
1324 if {$ch eq "\""} break
1326 append ret [string index $str $used]
1330 return [list $used $ret]
1333 proc shellsplit {str} {
1336 set str [string trimleft $str]
1337 if {$str eq {}} break
1338 set dq [shelldequote $str]
1339 set n [lindex $dq 0]
1340 set word [lindex $dq 1]
1341 set str [string range $str $n end]
1347 # Code to implement multiple views
1349 proc newview {ishighlight} {
1350 global nextviewnum newviewname newviewperm uifont newishighlight
1351 global newviewargs revtreeargs
1353 set newishighlight $ishighlight
1355 if {[winfo exists $top]} {
1359 set newviewname($nextviewnum) "View $nextviewnum"
1360 set newviewperm($nextviewnum) 0
1361 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1362 vieweditor $top $nextviewnum "Gitk view definition"
1367 global viewname viewperm newviewname newviewperm
1368 global viewargs newviewargs
1370 set top .gitkvedit-$curview
1371 if {[winfo exists $top]} {
1375 set newviewname($curview) $viewname($curview)
1376 set newviewperm($curview) $viewperm($curview)
1377 set newviewargs($curview) [shellarglist $viewargs($curview)]
1378 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1381 proc vieweditor {top n title} {
1382 global newviewname newviewperm viewfiles
1386 wm title $top $title
1387 label $top.nl -text "Name" -font $uifont
1388 entry $top.name -width 20 -textvariable newviewname($n)
1389 grid $top.nl $top.name -sticky w -pady 5
1390 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1391 grid $top.perm - -pady 5 -sticky w
1392 message $top.al -aspect 1000 -font $uifont \
1393 -text "Commits to include (arguments to git rev-list):"
1394 grid $top.al - -sticky w -pady 5
1395 entry $top.args -width 50 -textvariable newviewargs($n) \
1397 grid $top.args - -sticky ew -padx 5
1398 message $top.l -aspect 1000 -font $uifont \
1399 -text "Enter files and directories to include, one per line:"
1400 grid $top.l - -sticky w
1401 text $top.t -width 40 -height 10 -background white
1402 if {[info exists viewfiles($n)]} {
1403 foreach f $viewfiles($n) {
1404 $top.t insert end $f
1405 $top.t insert end "\n"
1407 $top.t delete {end - 1c} end
1408 $top.t mark set insert 0.0
1410 grid $top.t - -sticky ew -padx 5
1412 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1413 button $top.buts.can -text "Cancel" -command [list destroy $top]
1414 grid $top.buts.ok $top.buts.can
1415 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1416 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1417 grid $top.buts - -pady 10 -sticky ew
1421 proc doviewmenu {m first cmd op argv} {
1422 set nmenu [$m index end]
1423 for {set i $first} {$i <= $nmenu} {incr i} {
1424 if {[$m entrycget $i -command] eq $cmd} {
1425 eval $m $op $i $argv
1431 proc allviewmenus {n op args} {
1434 doviewmenu .bar.view 7 [list showview $n] $op $args
1435 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1438 proc newviewok {top n} {
1439 global nextviewnum newviewperm newviewname newishighlight
1440 global viewname viewfiles viewperm selectedview curview
1441 global viewargs newviewargs viewhlmenu
1444 set newargs [shellsplit $newviewargs($n)]
1446 error_popup "Error in commit selection arguments: $err"
1452 foreach f [split [$top.t get 0.0 end] "\n"] {
1453 set ft [string trim $f]
1458 if {![info exists viewfiles($n)]} {
1459 # creating a new view
1461 set viewname($n) $newviewname($n)
1462 set viewperm($n) $newviewperm($n)
1463 set viewfiles($n) $files
1464 set viewargs($n) $newargs
1466 if {!$newishighlight} {
1467 after idle showview $n
1469 after idle addvhighlight $n
1472 # editing an existing view
1473 set viewperm($n) $newviewperm($n)
1474 if {$newviewname($n) ne $viewname($n)} {
1475 set viewname($n) $newviewname($n)
1476 doviewmenu .bar.view 7 [list showview $n] \
1477 entryconf [list -label $viewname($n)]
1478 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1479 entryconf [list -label $viewname($n) -value $viewname($n)]
1481 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1482 set viewfiles($n) $files
1483 set viewargs($n) $newargs
1484 if {$curview == $n} {
1485 after idle updatecommits
1489 catch {destroy $top}
1493 global curview viewdata viewperm hlview selectedhlview
1495 if {$curview == 0} return
1496 if {[info exists hlview] && $hlview == $curview} {
1497 set selectedhlview None
1500 allviewmenus $curview delete
1501 set viewdata($curview) {}
1502 set viewperm($curview) 0
1506 proc addviewmenu {n} {
1507 global viewname viewhlmenu
1509 .bar.view add radiobutton -label $viewname($n) \
1510 -command [list showview $n] -variable selectedview -value $n
1511 $viewhlmenu add radiobutton -label $viewname($n) \
1512 -command [list addvhighlight $n] -variable selectedhlview
1515 proc flatten {var} {
1519 foreach i [array names $var] {
1520 lappend ret $i [set $var\($i\)]
1525 proc unflatten {var l} {
1535 global curview viewdata viewfiles
1536 global displayorder parentlist childlist rowidlist rowoffsets
1537 global colormap rowtextx commitrow nextcolor canvxmax
1538 global numcommits rowrangelist commitlisted idrowranges
1539 global selectedline currentid canv canvy0
1540 global matchinglines treediffs
1541 global pending_select phase
1542 global commitidx rowlaidout rowoptim linesegends
1543 global commfd nextupdate
1545 global vparentlist vchildlist vdisporder vcmitlisted
1546 global hlview selectedhlview
1548 if {$n == $curview} return
1550 if {[info exists selectedline]} {
1551 set selid $currentid
1552 set y [yc $selectedline]
1553 set ymax [lindex [$canv cget -scrollregion] 3]
1554 set span [$canv yview]
1555 set ytop [expr {[lindex $span 0] * $ymax}]
1556 set ybot [expr {[lindex $span 1] * $ymax}]
1557 if {$ytop < $y && $y < $ybot} {
1558 set yscreen [expr {$y - $ytop}]
1560 set yscreen [expr {($ybot - $ytop) / 2}]
1566 if {$curview >= 0} {
1567 set vparentlist($curview) $parentlist
1568 set vchildlist($curview) $childlist
1569 set vdisporder($curview) $displayorder
1570 set vcmitlisted($curview) $commitlisted
1572 set viewdata($curview) \
1573 [list $phase $rowidlist $rowoffsets $rowrangelist \
1574 [flatten idrowranges] [flatten idinlist] \
1575 $rowlaidout $rowoptim $numcommits $linesegends]
1576 } elseif {![info exists viewdata($curview)]
1577 || [lindex $viewdata($curview) 0] ne {}} {
1578 set viewdata($curview) \
1579 [list {} $rowidlist $rowoffsets $rowrangelist]
1582 catch {unset matchinglines}
1583 catch {unset treediffs}
1585 if {[info exists hlview] && $hlview == $n} {
1587 set selectedhlview None
1592 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1593 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1595 if {![info exists viewdata($n)]} {
1596 set pending_select $selid
1602 set phase [lindex $v 0]
1603 set displayorder $vdisporder($n)
1604 set parentlist $vparentlist($n)
1605 set childlist $vchildlist($n)
1606 set commitlisted $vcmitlisted($n)
1607 set rowidlist [lindex $v 1]
1608 set rowoffsets [lindex $v 2]
1609 set rowrangelist [lindex $v 3]
1611 set numcommits [llength $displayorder]
1612 catch {unset idrowranges}
1614 unflatten idrowranges [lindex $v 4]
1615 unflatten idinlist [lindex $v 5]
1616 set rowlaidout [lindex $v 6]
1617 set rowoptim [lindex $v 7]
1618 set numcommits [lindex $v 8]
1619 set linesegends [lindex $v 9]
1622 catch {unset colormap}
1623 catch {unset rowtextx}
1625 set canvxmax [$canv cget -width]
1631 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1632 set row $commitrow($n,$selid)
1633 # try to get the selected row in the same position on the screen
1634 set ymax [lindex [$canv cget -scrollregion] 3]
1635 set ytop [expr {[yc $row] - $yscreen}]
1639 set yf [expr {$ytop * 1.0 / $ymax}]
1641 allcanvs yview moveto $yf
1645 if {$phase eq "getcommits"} {
1646 show_status "Reading commits..."
1648 if {[info exists commfd($n)]} {
1653 } elseif {$numcommits == 0} {
1654 show_status "No commits selected"
1658 # Stuff relating to the highlighting facility
1660 proc ishighlighted {row} {
1661 global vhighlights fhighlights nhighlights rhighlights
1663 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1664 return $nhighlights($row)
1666 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1667 return $vhighlights($row)
1669 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1670 return $fhighlights($row)
1672 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1673 return $rhighlights($row)
1678 proc bolden {row font} {
1679 global canv linehtag selectedline boldrows
1681 lappend boldrows $row
1682 $canv itemconf $linehtag($row) -font $font
1683 if {[info exists selectedline] && $row == $selectedline} {
1685 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1686 -outline {{}} -tags secsel \
1687 -fill [$canv cget -selectbackground]]
1692 proc bolden_name {row font} {
1693 global canv2 linentag selectedline boldnamerows
1695 lappend boldnamerows $row
1696 $canv2 itemconf $linentag($row) -font $font
1697 if {[info exists selectedline] && $row == $selectedline} {
1698 $canv2 delete secsel
1699 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1700 -outline {{}} -tags secsel \
1701 -fill [$canv2 cget -selectbackground]]
1707 global mainfont boldrows
1710 foreach row $boldrows {
1711 if {![ishighlighted $row]} {
1712 bolden $row $mainfont
1714 lappend stillbold $row
1717 set boldrows $stillbold
1720 proc addvhighlight {n} {
1721 global hlview curview viewdata vhl_done vhighlights commitidx
1723 if {[info exists hlview]} {
1727 if {$n != $curview && ![info exists viewdata($n)]} {
1728 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1729 set vparentlist($n) {}
1730 set vchildlist($n) {}
1731 set vdisporder($n) {}
1732 set vcmitlisted($n) {}
1735 set vhl_done $commitidx($hlview)
1736 if {$vhl_done > 0} {
1741 proc delvhighlight {} {
1742 global hlview vhighlights
1744 if {![info exists hlview]} return
1746 catch {unset vhighlights}
1750 proc vhighlightmore {} {
1751 global hlview vhl_done commitidx vhighlights
1752 global displayorder vdisporder curview mainfont
1754 set font [concat $mainfont bold]
1755 set max $commitidx($hlview)
1756 if {$hlview == $curview} {
1757 set disp $displayorder
1759 set disp $vdisporder($hlview)
1761 set vr [visiblerows]
1762 set r0 [lindex $vr 0]
1763 set r1 [lindex $vr 1]
1764 for {set i $vhl_done} {$i < $max} {incr i} {
1765 set id [lindex $disp $i]
1766 if {[info exists commitrow($curview,$id)]} {
1767 set row $commitrow($curview,$id)
1768 if {$r0 <= $row && $row <= $r1} {
1769 if {![highlighted $row]} {
1772 set vhighlights($row) 1
1779 proc askvhighlight {row id} {
1780 global hlview vhighlights commitrow iddrawn mainfont
1782 if {[info exists commitrow($hlview,$id)]} {
1783 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1784 bolden $row [concat $mainfont bold]
1786 set vhighlights($row) 1
1788 set vhighlights($row) 0
1792 proc hfiles_change {name ix op} {
1793 global highlight_files filehighlight fhighlights fh_serial
1794 global mainfont highlight_paths
1796 if {[info exists filehighlight]} {
1797 # delete previous highlights
1798 catch {close $filehighlight}
1800 catch {unset fhighlights}
1802 unhighlight_filelist
1804 set highlight_paths {}
1805 after cancel do_file_hl $fh_serial
1807 if {$highlight_files ne {}} {
1808 after 300 do_file_hl $fh_serial
1812 proc makepatterns {l} {
1815 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1816 if {[string index $ee end] eq "/"} {
1826 proc do_file_hl {serial} {
1827 global highlight_files filehighlight highlight_paths gdttype fhl_list
1829 if {$gdttype eq "touching paths:"} {
1830 if {[catch {set paths [shellsplit $highlight_files]}]} return
1831 set highlight_paths [makepatterns $paths]
1833 set gdtargs [concat -- $paths]
1835 set gdtargs [list "-S$highlight_files"]
1837 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1838 set filehighlight [open $cmd r+]
1839 fconfigure $filehighlight -blocking 0
1840 fileevent $filehighlight readable readfhighlight
1846 proc flushhighlights {} {
1847 global filehighlight fhl_list
1849 if {[info exists filehighlight]} {
1851 puts $filehighlight ""
1852 flush $filehighlight
1856 proc askfilehighlight {row id} {
1857 global filehighlight fhighlights fhl_list
1859 lappend fhl_list $id
1860 set fhighlights($row) -1
1861 puts $filehighlight $id
1864 proc readfhighlight {} {
1865 global filehighlight fhighlights commitrow curview mainfont iddrawn
1868 while {[gets $filehighlight line] >= 0} {
1869 set line [string trim $line]
1870 set i [lsearch -exact $fhl_list $line]
1871 if {$i < 0} continue
1872 for {set j 0} {$j < $i} {incr j} {
1873 set id [lindex $fhl_list $j]
1874 if {[info exists commitrow($curview,$id)]} {
1875 set fhighlights($commitrow($curview,$id)) 0
1878 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1879 if {$line eq {}} continue
1880 if {![info exists commitrow($curview,$line)]} continue
1881 set row $commitrow($curview,$line)
1882 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1883 bolden $row [concat $mainfont bold]
1885 set fhighlights($row) 1
1887 if {[eof $filehighlight]} {
1889 puts "oops, git-diff-tree died"
1890 catch {close $filehighlight}
1896 proc find_change {name ix op} {
1897 global nhighlights mainfont boldnamerows
1898 global findstring findpattern findtype
1900 # delete previous highlights, if any
1901 foreach row $boldnamerows {
1902 bolden_name $row $mainfont
1905 catch {unset nhighlights}
1907 if {$findtype ne "Regexp"} {
1908 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1910 set findpattern "*$e*"
1915 proc askfindhighlight {row id} {
1916 global nhighlights commitinfo iddrawn mainfont
1917 global findstring findtype findloc findpattern
1919 if {![info exists commitinfo($id)]} {
1922 set info $commitinfo($id)
1924 set fldtypes {Headline Author Date Committer CDate Comments}
1925 foreach f $info ty $fldtypes {
1926 if {$findloc ne "All fields" && $findloc ne $ty} {
1929 if {$findtype eq "Regexp"} {
1930 set doesmatch [regexp $findstring $f]
1931 } elseif {$findtype eq "IgnCase"} {
1932 set doesmatch [string match -nocase $findpattern $f]
1934 set doesmatch [string match $findpattern $f]
1937 if {$ty eq "Author"} {
1944 if {[info exists iddrawn($id)]} {
1945 if {$isbold && ![ishighlighted $row]} {
1946 bolden $row [concat $mainfont bold]
1949 bolden_name $row [concat $mainfont bold]
1952 set nhighlights($row) $isbold
1955 proc vrel_change {name ix op} {
1956 global highlight_related
1959 if {$highlight_related ne "None"} {
1960 after idle drawvisible
1964 # prepare for testing whether commits are descendents or ancestors of a
1965 proc rhighlight_sel {a} {
1966 global descendent desc_todo ancestor anc_todo
1967 global highlight_related rhighlights
1969 catch {unset descendent}
1970 set desc_todo [list $a]
1971 catch {unset ancestor}
1972 set anc_todo [list $a]
1973 if {$highlight_related ne "None"} {
1975 after idle drawvisible
1979 proc rhighlight_none {} {
1982 catch {unset rhighlights}
1986 proc is_descendent {a} {
1987 global curview children commitrow descendent desc_todo
1990 set la $commitrow($v,$a)
1994 for {set i 0} {$i < [llength $todo]} {incr i} {
1995 set do [lindex $todo $i]
1996 if {$commitrow($v,$do) < $la} {
1997 lappend leftover $do
2000 foreach nk $children($v,$do) {
2001 if {![info exists descendent($nk)]} {
2002 set descendent($nk) 1
2010 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2014 set descendent($a) 0
2015 set desc_todo $leftover
2018 proc is_ancestor {a} {
2019 global curview parentlist commitrow ancestor anc_todo
2022 set la $commitrow($v,$a)
2026 for {set i 0} {$i < [llength $todo]} {incr i} {
2027 set do [lindex $todo $i]
2028 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2029 lappend leftover $do
2032 foreach np [lindex $parentlist $commitrow($v,$do)] {
2033 if {![info exists ancestor($np)]} {
2042 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2047 set anc_todo $leftover
2050 proc askrelhighlight {row id} {
2051 global descendent highlight_related iddrawn mainfont rhighlights
2052 global selectedline ancestor
2054 if {![info exists selectedline]} return
2056 if {$highlight_related eq "Descendent" ||
2057 $highlight_related eq "Not descendent"} {
2058 if {![info exists descendent($id)]} {
2061 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2064 } elseif {$highlight_related eq "Ancestor" ||
2065 $highlight_related eq "Not ancestor"} {
2066 if {![info exists ancestor($id)]} {
2069 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2073 if {[info exists iddrawn($id)]} {
2074 if {$isbold && ![ishighlighted $row]} {
2075 bolden $row [concat $mainfont bold]
2078 set rhighlights($row) $isbold
2081 proc next_hlcont {} {
2082 global fhl_row fhl_dirn displayorder numcommits
2083 global vhighlights fhighlights nhighlights rhighlights
2084 global hlview filehighlight findstring highlight_related
2086 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2089 if {$row < 0 || $row >= $numcommits} {
2094 set id [lindex $displayorder $row]
2095 if {[info exists hlview]} {
2096 if {![info exists vhighlights($row)]} {
2097 askvhighlight $row $id
2099 if {$vhighlights($row) > 0} break
2101 if {$findstring ne {}} {
2102 if {![info exists nhighlights($row)]} {
2103 askfindhighlight $row $id
2105 if {$nhighlights($row) > 0} break
2107 if {$highlight_related ne "None"} {
2108 if {![info exists rhighlights($row)]} {
2109 askrelhighlight $row $id
2111 if {$rhighlights($row) > 0} break
2113 if {[info exists filehighlight]} {
2114 if {![info exists fhighlights($row)]} {
2115 # ask for a few more while we're at it...
2117 for {set n 0} {$n < 100} {incr n} {
2118 if {![info exists fhighlights($r)]} {
2119 askfilehighlight $r [lindex $displayorder $r]
2122 if {$r < 0 || $r >= $numcommits} break
2126 if {$fhighlights($row) < 0} {
2130 if {$fhighlights($row) > 0} break
2138 proc next_highlight {dirn} {
2139 global selectedline fhl_row fhl_dirn
2140 global hlview filehighlight findstring highlight_related
2142 if {![info exists selectedline]} return
2143 if {!([info exists hlview] || $findstring ne {} ||
2144 $highlight_related ne "None" || [info exists filehighlight])} return
2145 set fhl_row [expr {$selectedline + $dirn}]
2150 proc cancel_next_highlight {} {
2156 # Graph layout functions
2158 proc shortids {ids} {
2161 if {[llength $id] > 1} {
2162 lappend res [shortids $id]
2163 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2164 lappend res [string range $id 0 7]
2172 proc incrange {l x o} {
2175 set e [lindex $l $x]
2177 lset l $x [expr {$e + $o}]
2186 for {} {$n > 0} {incr n -1} {
2192 proc usedinrange {id l1 l2} {
2193 global children commitrow childlist curview
2195 if {[info exists commitrow($curview,$id)]} {
2196 set r $commitrow($curview,$id)
2197 if {$l1 <= $r && $r <= $l2} {
2198 return [expr {$r - $l1 + 1}]
2200 set kids [lindex $childlist $r]
2202 set kids $children($curview,$id)
2205 set r $commitrow($curview,$c)
2206 if {$l1 <= $r && $r <= $l2} {
2207 return [expr {$r - $l1 + 1}]
2213 proc sanity {row {full 0}} {
2214 global rowidlist rowoffsets
2217 set ids [lindex $rowidlist $row]
2220 if {$id eq {}} continue
2221 if {$col < [llength $ids] - 1 &&
2222 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2223 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2225 set o [lindex $rowoffsets $row $col]
2231 if {[lindex $rowidlist $y $x] != $id} {
2232 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2233 puts " id=[shortids $id] check started at row $row"
2234 for {set i $row} {$i >= $y} {incr i -1} {
2235 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2240 set o [lindex $rowoffsets $y $x]
2245 proc makeuparrow {oid x y z} {
2246 global rowidlist rowoffsets uparrowlen idrowranges
2248 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2251 set off0 [lindex $rowoffsets $y]
2252 for {set x0 $x} {1} {incr x0} {
2253 if {$x0 >= [llength $off0]} {
2254 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2257 set z [lindex $off0 $x0]
2263 set z [expr {$x0 - $x}]
2264 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2265 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2267 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2268 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2269 lappend idrowranges($oid) $y
2272 proc initlayout {} {
2273 global rowidlist rowoffsets displayorder commitlisted
2274 global rowlaidout rowoptim
2275 global idinlist rowchk rowrangelist idrowranges
2276 global numcommits canvxmax canv
2278 global parentlist childlist children
2279 global colormap rowtextx
2291 catch {unset idinlist}
2292 catch {unset rowchk}
2295 set canvxmax [$canv cget -width]
2296 catch {unset colormap}
2297 catch {unset rowtextx}
2298 catch {unset idrowranges}
2302 proc setcanvscroll {} {
2303 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2305 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2306 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2307 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2308 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2311 proc visiblerows {} {
2312 global canv numcommits linespc
2314 set ymax [lindex [$canv cget -scrollregion] 3]
2315 if {$ymax eq {} || $ymax == 0} return
2317 set y0 [expr {int([lindex $f 0] * $ymax)}]
2318 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2322 set y1 [expr {int([lindex $f 1] * $ymax)}]
2323 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2324 if {$r1 >= $numcommits} {
2325 set r1 [expr {$numcommits - 1}]
2327 return [list $r0 $r1]
2330 proc layoutmore {} {
2331 global rowlaidout rowoptim commitidx numcommits optim_delay
2332 global uparrowlen curview
2335 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2336 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2337 if {$orow > $rowoptim} {
2338 optimize_rows $rowoptim 0 $orow
2341 set canshow [expr {$rowoptim - $optim_delay}]
2342 if {$canshow > $numcommits} {
2347 proc showstuff {canshow} {
2348 global numcommits commitrow pending_select selectedline
2349 global linesegends idrowranges idrangedrawn curview
2351 if {$numcommits == 0} {
2353 set phase "incrdraw"
2357 set numcommits $canshow
2359 set rows [visiblerows]
2360 set r0 [lindex $rows 0]
2361 set r1 [lindex $rows 1]
2363 for {set r $row} {$r < $canshow} {incr r} {
2364 foreach id [lindex $linesegends [expr {$r+1}]] {
2366 foreach {s e} [rowranges $id] {
2368 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2369 && ![info exists idrangedrawn($id,$i)]} {
2371 set idrangedrawn($id,$i) 1
2376 if {$canshow > $r1} {
2379 while {$row < $canshow} {
2383 if {[info exists pending_select] &&
2384 [info exists commitrow($curview,$pending_select)] &&
2385 $commitrow($curview,$pending_select) < $numcommits} {
2386 selectline $commitrow($curview,$pending_select) 1
2388 if {![info exists selectedline] && ![info exists pending_select]} {
2393 proc layoutrows {row endrow last} {
2394 global rowidlist rowoffsets displayorder
2395 global uparrowlen downarrowlen maxwidth mingaplen
2396 global childlist parentlist
2397 global idrowranges linesegends
2398 global commitidx curview
2399 global idinlist rowchk rowrangelist
2401 set idlist [lindex $rowidlist $row]
2402 set offs [lindex $rowoffsets $row]
2403 while {$row < $endrow} {
2404 set id [lindex $displayorder $row]
2407 foreach p [lindex $parentlist $row] {
2408 if {![info exists idinlist($p)]} {
2410 } elseif {!$idinlist($p)} {
2415 set nev [expr {[llength $idlist] + [llength $newolds]
2416 + [llength $oldolds] - $maxwidth + 1}]
2419 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2420 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2421 set i [lindex $idlist $x]
2422 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2423 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2424 [expr {$row + $uparrowlen + $mingaplen}]]
2426 set idlist [lreplace $idlist $x $x]
2427 set offs [lreplace $offs $x $x]
2428 set offs [incrange $offs $x 1]
2430 set rm1 [expr {$row - 1}]
2432 lappend idrowranges($i) $rm1
2433 if {[incr nev -1] <= 0} break
2436 set rowchk($id) [expr {$row + $r}]
2439 lset rowidlist $row $idlist
2440 lset rowoffsets $row $offs
2442 lappend linesegends $lse
2443 set col [lsearch -exact $idlist $id]
2445 set col [llength $idlist]
2447 lset rowidlist $row $idlist
2449 if {[lindex $childlist $row] ne {}} {
2450 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2454 lset rowoffsets $row $offs
2456 makeuparrow $id $col $row $z
2462 if {[info exists idrowranges($id)]} {
2463 set ranges $idrowranges($id)
2465 unset idrowranges($id)
2467 lappend rowrangelist $ranges
2469 set offs [ntimes [llength $idlist] 0]
2470 set l [llength $newolds]
2471 set idlist [eval lreplace \$idlist $col $col $newolds]
2474 set offs [lrange $offs 0 [expr {$col - 1}]]
2475 foreach x $newolds {
2480 set tmp [expr {[llength $idlist] - [llength $offs]}]
2482 set offs [concat $offs [ntimes $tmp $o]]
2487 foreach i $newolds {
2489 set idrowranges($i) $row
2492 foreach oid $oldolds {
2493 set idinlist($oid) 1
2494 set idlist [linsert $idlist $col $oid]
2495 set offs [linsert $offs $col $o]
2496 makeuparrow $oid $col $row $o
2499 lappend rowidlist $idlist
2500 lappend rowoffsets $offs
2505 proc addextraid {id row} {
2506 global displayorder commitrow commitinfo
2507 global commitidx commitlisted
2508 global parentlist childlist children curview
2510 incr commitidx($curview)
2511 lappend displayorder $id
2512 lappend commitlisted 0
2513 lappend parentlist {}
2514 set commitrow($curview,$id) $row
2516 if {![info exists commitinfo($id)]} {
2517 set commitinfo($id) {"No commit information available"}
2519 if {![info exists children($curview,$id)]} {
2520 set children($curview,$id) {}
2522 lappend childlist $children($curview,$id)
2525 proc layouttail {} {
2526 global rowidlist rowoffsets idinlist commitidx curview
2527 global idrowranges rowrangelist
2529 set row $commitidx($curview)
2530 set idlist [lindex $rowidlist $row]
2531 while {$idlist ne {}} {
2532 set col [expr {[llength $idlist] - 1}]
2533 set id [lindex $idlist $col]
2536 lappend idrowranges($id) $row
2537 lappend rowrangelist $idrowranges($id)
2538 unset idrowranges($id)
2540 set offs [ntimes $col 0]
2541 set idlist [lreplace $idlist $col $col]
2542 lappend rowidlist $idlist
2543 lappend rowoffsets $offs
2546 foreach id [array names idinlist] {
2548 lset rowidlist $row [list $id]
2549 lset rowoffsets $row 0
2550 makeuparrow $id 0 $row 0
2551 lappend idrowranges($id) $row
2552 lappend rowrangelist $idrowranges($id)
2553 unset idrowranges($id)
2555 lappend rowidlist {}
2556 lappend rowoffsets {}
2560 proc insert_pad {row col npad} {
2561 global rowidlist rowoffsets
2563 set pad [ntimes $npad {}]
2564 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2565 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2566 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2569 proc optimize_rows {row col endrow} {
2570 global rowidlist rowoffsets idrowranges displayorder
2572 for {} {$row < $endrow} {incr row} {
2573 set idlist [lindex $rowidlist $row]
2574 set offs [lindex $rowoffsets $row]
2576 for {} {$col < [llength $offs]} {incr col} {
2577 if {[lindex $idlist $col] eq {}} {
2581 set z [lindex $offs $col]
2582 if {$z eq {}} continue
2584 set x0 [expr {$col + $z}]
2585 set y0 [expr {$row - 1}]
2586 set z0 [lindex $rowoffsets $y0 $x0]
2588 set id [lindex $idlist $col]
2589 set ranges [rowranges $id]
2590 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2594 if {$z < -1 || ($z < 0 && $isarrow)} {
2595 set npad [expr {-1 - $z + $isarrow}]
2596 set offs [incrange $offs $col $npad]
2597 insert_pad $y0 $x0 $npad
2599 optimize_rows $y0 $x0 $row
2601 set z [lindex $offs $col]
2602 set x0 [expr {$col + $z}]
2603 set z0 [lindex $rowoffsets $y0 $x0]
2604 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2605 set npad [expr {$z - 1 + $isarrow}]
2606 set y1 [expr {$row + 1}]
2607 set offs2 [lindex $rowoffsets $y1]
2611 if {$z eq {} || $x1 + $z < $col} continue
2612 if {$x1 + $z > $col} {
2615 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2618 set pad [ntimes $npad {}]
2619 set idlist [eval linsert \$idlist $col $pad]
2620 set tmp [eval linsert \$offs $col $pad]
2622 set offs [incrange $tmp $col [expr {-$npad}]]
2623 set z [lindex $offs $col]
2626 if {$z0 eq {} && !$isarrow} {
2627 # this line links to its first child on row $row-2
2628 set rm2 [expr {$row - 2}]
2629 set id [lindex $displayorder $rm2]
2630 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2632 set z0 [expr {$xc - $x0}]
2635 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2636 insert_pad $y0 $x0 1
2637 set offs [incrange $offs $col 1]
2638 optimize_rows $y0 [expr {$x0 + 1}] $row
2643 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2644 set o [lindex $offs $col]
2646 # check if this is the link to the first child
2647 set id [lindex $idlist $col]
2648 set ranges [rowranges $id]
2649 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2650 # it is, work out offset to child
2651 set y0 [expr {$row - 1}]
2652 set id [lindex $displayorder $y0]
2653 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2655 set o [expr {$x0 - $col}]
2659 if {$o eq {} || $o <= 0} break
2661 if {$o ne {} && [incr col] < [llength $idlist]} {
2662 set y1 [expr {$row + 1}]
2663 set offs2 [lindex $rowoffsets $y1]
2667 if {$z eq {} || $x1 + $z < $col} continue
2668 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2671 set idlist [linsert $idlist $col {}]
2672 set tmp [linsert $offs $col {}]
2674 set offs [incrange $tmp $col -1]
2677 lset rowidlist $row $idlist
2678 lset rowoffsets $row $offs
2684 global canvx0 linespc
2685 return [expr {$canvx0 + $col * $linespc}]
2689 global canvy0 linespc
2690 return [expr {$canvy0 + $row * $linespc}]
2693 proc linewidth {id} {
2694 global thickerline lthickness
2697 if {[info exists thickerline] && $id eq $thickerline} {
2698 set wid [expr {2 * $lthickness}]
2703 proc rowranges {id} {
2704 global phase idrowranges commitrow rowlaidout rowrangelist curview
2708 ([info exists commitrow($curview,$id)]
2709 && $commitrow($curview,$id) < $rowlaidout)} {
2710 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2711 } elseif {[info exists idrowranges($id)]} {
2712 set ranges $idrowranges($id)
2717 proc drawlineseg {id i} {
2718 global rowoffsets rowidlist
2720 global canv colormap linespc
2721 global numcommits commitrow curview
2723 set ranges [rowranges $id]
2725 if {[info exists commitrow($curview,$id)]
2726 && $commitrow($curview,$id) < $numcommits} {
2727 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2731 set startrow [lindex $ranges [expr {2 * $i}]]
2732 set row [lindex $ranges [expr {2 * $i + 1}]]
2733 if {$startrow == $row} return
2736 set col [lsearch -exact [lindex $rowidlist $row] $id]
2738 puts "oops: drawline: id $id not on row $row"
2744 set o [lindex $rowoffsets $row $col]
2747 # changing direction
2748 set x [xc $row $col]
2750 lappend coords $x $y
2756 set x [xc $row $col]
2758 lappend coords $x $y
2760 # draw the link to the first child as part of this line
2762 set child [lindex $displayorder $row]
2763 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2765 set x [xc $row $ccol]
2767 if {$ccol < $col - 1} {
2768 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2769 } elseif {$ccol > $col + 1} {
2770 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2772 lappend coords $x $y
2775 if {[llength $coords] < 4} return
2777 # This line has an arrow at the lower end: check if the arrow is
2778 # on a diagonal segment, and if so, work around the Tk 8.4
2779 # refusal to draw arrows on diagonal lines.
2780 set x0 [lindex $coords 0]
2781 set x1 [lindex $coords 2]
2783 set y0 [lindex $coords 1]
2784 set y1 [lindex $coords 3]
2785 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2786 # we have a nearby vertical segment, just trim off the diag bit
2787 set coords [lrange $coords 2 end]
2789 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2790 set xi [expr {$x0 - $slope * $linespc / 2}]
2791 set yi [expr {$y0 - $linespc / 2}]
2792 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2796 set arrow [expr {2 * ($i > 0) + $downarrow}]
2797 set arrow [lindex {none first last both} $arrow]
2798 set t [$canv create line $coords -width [linewidth $id] \
2799 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2804 proc drawparentlinks {id row col olds} {
2805 global rowidlist canv colormap
2807 set row2 [expr {$row + 1}]
2808 set x [xc $row $col]
2811 set ids [lindex $rowidlist $row2]
2812 # rmx = right-most X coord used
2815 set i [lsearch -exact $ids $p]
2817 puts "oops, parent $p of $id not in list"
2820 set x2 [xc $row2 $i]
2824 set ranges [rowranges $p]
2825 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2826 && $row2 < [lindex $ranges 1]} {
2827 # drawlineseg will do this one for us
2831 # should handle duplicated parents here...
2832 set coords [list $x $y]
2833 if {$i < $col - 1} {
2834 lappend coords [xc $row [expr {$i + 1}]] $y
2835 } elseif {$i > $col + 1} {
2836 lappend coords [xc $row [expr {$i - 1}]] $y
2838 lappend coords $x2 $y2
2839 set t [$canv create line $coords -width [linewidth $p] \
2840 -fill $colormap($p) -tags lines.$p]
2847 proc drawlines {id} {
2848 global colormap canv
2850 global children iddrawn commitrow rowidlist curview
2852 $canv delete lines.$id
2853 set nr [expr {[llength [rowranges $id]] / 2}]
2854 for {set i 0} {$i < $nr} {incr i} {
2855 if {[info exists idrangedrawn($id,$i)]} {
2859 foreach child $children($curview,$id) {
2860 if {[info exists iddrawn($child)]} {
2861 set row $commitrow($curview,$child)
2862 set col [lsearch -exact [lindex $rowidlist $row] $child]
2864 drawparentlinks $child $row $col [list $id]
2870 proc drawcmittext {id row col rmx} {
2871 global linespc canv canv2 canv3 canvy0
2872 global commitlisted commitinfo rowidlist
2873 global rowtextx idpos idtags idheads idotherrefs
2874 global linehtag linentag linedtag
2875 global mainfont canvxmax boldrows boldnamerows
2877 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2878 set x [xc $row $col]
2880 set orad [expr {$linespc / 3}]
2881 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2882 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2883 -fill $ofill -outline black -width 1]
2885 $canv bind $t <1> {selcanvline {} %x %y}
2886 set xt [xc $row [llength [lindex $rowidlist $row]]]
2890 set rowtextx($row) $xt
2891 set idpos($id) [list $x $xt $y]
2892 if {[info exists idtags($id)] || [info exists idheads($id)]
2893 || [info exists idotherrefs($id)]} {
2894 set xt [drawtags $id $x $xt $y]
2896 set headline [lindex $commitinfo($id) 0]
2897 set name [lindex $commitinfo($id) 1]
2898 set date [lindex $commitinfo($id) 2]
2899 set date [formatdate $date]
2902 set isbold [ishighlighted $row]
2904 lappend boldrows $row
2907 lappend boldnamerows $row
2911 set linehtag($row) [$canv create text $xt $y -anchor w \
2912 -text $headline -font $font]
2913 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2914 set linentag($row) [$canv2 create text 3 $y -anchor w \
2915 -text $name -font $nfont]
2916 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2917 -text $date -font $mainfont]
2918 set xr [expr {$xt + [font measure $mainfont $headline]}]
2919 if {$xr > $canvxmax} {
2925 proc drawcmitrow {row} {
2926 global displayorder rowidlist
2927 global idrangedrawn iddrawn
2928 global commitinfo parentlist numcommits
2929 global filehighlight fhighlights findstring nhighlights
2930 global hlview vhighlights
2931 global highlight_related rhighlights
2933 if {$row >= $numcommits} return
2934 foreach id [lindex $rowidlist $row] {
2935 if {$id eq {}} continue
2937 foreach {s e} [rowranges $id] {
2939 if {$row < $s} continue
2942 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2944 set idrangedrawn($id,$i) 1
2951 set id [lindex $displayorder $row]
2952 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2953 askvhighlight $row $id
2955 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2956 askfilehighlight $row $id
2958 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2959 askfindhighlight $row $id
2961 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2962 askrelhighlight $row $id
2964 if {[info exists iddrawn($id)]} return
2965 set col [lsearch -exact [lindex $rowidlist $row] $id]
2967 puts "oops, row $row id $id not in list"
2970 if {![info exists commitinfo($id)]} {
2974 set olds [lindex $parentlist $row]
2976 set rmx [drawparentlinks $id $row $col $olds]
2980 drawcmittext $id $row $col $rmx
2984 proc drawfrac {f0 f1} {
2985 global numcommits canv
2988 set ymax [lindex [$canv cget -scrollregion] 3]
2989 if {$ymax eq {} || $ymax == 0} return
2990 set y0 [expr {int($f0 * $ymax)}]
2991 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2995 set y1 [expr {int($f1 * $ymax)}]
2996 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2997 if {$endrow >= $numcommits} {
2998 set endrow [expr {$numcommits - 1}]
3000 for {} {$row <= $endrow} {incr row} {
3005 proc drawvisible {} {
3007 eval drawfrac [$canv yview]
3010 proc clear_display {} {
3011 global iddrawn idrangedrawn
3012 global vhighlights fhighlights nhighlights rhighlights
3015 catch {unset iddrawn}
3016 catch {unset idrangedrawn}
3017 catch {unset vhighlights}
3018 catch {unset fhighlights}
3019 catch {unset nhighlights}
3020 catch {unset rhighlights}
3023 proc findcrossings {id} {
3024 global rowidlist parentlist numcommits rowoffsets displayorder
3028 foreach {s e} [rowranges $id] {
3029 if {$e >= $numcommits} {
3030 set e [expr {$numcommits - 1}]
3032 if {$e <= $s} continue
3033 set x [lsearch -exact [lindex $rowidlist $e] $id]
3035 puts "findcrossings: oops, no [shortids $id] in row $e"
3038 for {set row $e} {[incr row -1] >= $s} {} {
3039 set olds [lindex $parentlist $row]
3040 set kid [lindex $displayorder $row]
3041 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3042 if {$kidx < 0} continue
3043 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3045 set px [lsearch -exact $nextrow $p]
3046 if {$px < 0} continue
3047 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3048 if {[lsearch -exact $ccross $p] >= 0} continue
3049 if {$x == $px + ($kidx < $px? -1: 1)} {
3051 } elseif {[lsearch -exact $cross $p] < 0} {
3056 set inc [lindex $rowoffsets $row $x]
3057 if {$inc eq {}} break
3061 return [concat $ccross {{}} $cross]
3064 proc assigncolor {id} {
3065 global colormap colors nextcolor
3066 global commitrow parentlist children children curview
3068 if {[info exists colormap($id)]} return
3069 set ncolors [llength $colors]
3070 if {[info exists children($curview,$id)]} {
3071 set kids $children($curview,$id)
3075 if {[llength $kids] == 1} {
3076 set child [lindex $kids 0]
3077 if {[info exists colormap($child)]
3078 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3079 set colormap($id) $colormap($child)
3085 foreach x [findcrossings $id] {
3087 # delimiter between corner crossings and other crossings
3088 if {[llength $badcolors] >= $ncolors - 1} break
3089 set origbad $badcolors
3091 if {[info exists colormap($x)]
3092 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3093 lappend badcolors $colormap($x)
3096 if {[llength $badcolors] >= $ncolors} {
3097 set badcolors $origbad
3099 set origbad $badcolors
3100 if {[llength $badcolors] < $ncolors - 1} {
3101 foreach child $kids {
3102 if {[info exists colormap($child)]
3103 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3104 lappend badcolors $colormap($child)
3106 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3107 if {[info exists colormap($p)]
3108 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3109 lappend badcolors $colormap($p)
3113 if {[llength $badcolors] >= $ncolors} {
3114 set badcolors $origbad
3117 for {set i 0} {$i <= $ncolors} {incr i} {
3118 set c [lindex $colors $nextcolor]
3119 if {[incr nextcolor] >= $ncolors} {
3122 if {[lsearch -exact $badcolors $c]} break
3124 set colormap($id) $c
3127 proc bindline {t id} {
3130 $canv bind $t <Enter> "lineenter %x %y $id"
3131 $canv bind $t <Motion> "linemotion %x %y $id"
3132 $canv bind $t <Leave> "lineleave $id"
3133 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3136 proc drawtags {id x xt y1} {
3137 global idtags idheads idotherrefs
3138 global linespc lthickness
3139 global canv mainfont commitrow rowtextx curview
3144 if {[info exists idtags($id)]} {
3145 set marks $idtags($id)
3146 set ntags [llength $marks]
3148 if {[info exists idheads($id)]} {
3149 set marks [concat $marks $idheads($id)]
3150 set nheads [llength $idheads($id)]
3152 if {[info exists idotherrefs($id)]} {
3153 set marks [concat $marks $idotherrefs($id)]
3159 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3160 set yt [expr {$y1 - 0.5 * $linespc}]
3161 set yb [expr {$yt + $linespc - 1}]
3164 foreach tag $marks {
3165 set wid [font measure $mainfont $tag]
3168 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3170 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3171 -width $lthickness -fill black -tags tag.$id]
3173 foreach tag $marks x $xvals wid $wvals {
3174 set xl [expr {$x + $delta}]
3175 set xr [expr {$x + $delta + $wid + $lthickness}]
3176 if {[incr ntags -1] >= 0} {
3178 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3179 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3180 -width 1 -outline black -fill yellow -tags tag.$id]
3181 $canv bind $t <1> [list showtag $tag 1]
3182 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3184 # draw a head or other ref
3185 if {[incr nheads -1] >= 0} {
3190 set xl [expr {$xl - $delta/2}]
3191 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3192 -width 1 -outline black -fill $col -tags tag.$id
3193 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3194 set rwid [font measure $mainfont $remoteprefix]
3195 set xi [expr {$x + 1}]
3196 set yti [expr {$yt + 1}]
3197 set xri [expr {$x + $rwid}]
3198 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3199 -width 0 -fill "#ffddaa" -tags tag.$id
3202 set t [$canv create text $xl $y1 -anchor w -text $tag \
3203 -font $mainfont -tags tag.$id]
3205 $canv bind $t <1> [list showtag $tag 1]
3211 proc xcoord {i level ln} {
3212 global canvx0 xspc1 xspc2
3214 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3215 if {$i > 0 && $i == $level} {
3216 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3217 } elseif {$i > $level} {
3218 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3223 proc show_status {msg} {
3224 global canv mainfont
3227 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3230 proc finishcommits {} {
3231 global commitidx phase curview
3232 global canv mainfont ctext maincursor textcursor
3233 global findinprogress pending_select
3235 if {$commitidx($curview) > 0} {
3238 show_status "No commits selected"
3241 catch {unset pending_select}
3244 # Don't change the text pane cursor if it is currently the hand cursor,
3245 # showing that we are over a sha1 ID link.
3246 proc settextcursor {c} {
3247 global ctext curtextcursor
3249 if {[$ctext cget -cursor] == $curtextcursor} {
3250 $ctext config -cursor $c
3252 set curtextcursor $c
3255 proc nowbusy {what} {
3258 if {[array names isbusy] eq {}} {
3259 . config -cursor watch
3265 proc notbusy {what} {
3266 global isbusy maincursor textcursor
3268 catch {unset isbusy($what)}
3269 if {[array names isbusy] eq {}} {
3270 . config -cursor $maincursor
3271 settextcursor $textcursor
3278 global canvy0 numcommits linespc
3279 global rowlaidout commitidx curview
3280 global pending_select
3283 layoutrows $rowlaidout $commitidx($curview) 1
3285 optimize_rows $row 0 $commitidx($curview)
3286 showstuff $commitidx($curview)
3287 if {[info exists pending_select]} {
3291 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3292 #puts "overall $drawmsecs ms for $numcommits commits"
3295 proc findmatches {f} {
3296 global findtype foundstring foundstrlen
3297 if {$findtype == "Regexp"} {
3298 set matches [regexp -indices -all -inline $foundstring $f]
3300 if {$findtype == "IgnCase"} {
3301 set str [string tolower $f]
3307 while {[set j [string first $foundstring $str $i]] >= 0} {
3308 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3309 set i [expr {$j + $foundstrlen}]
3316 global findtype findloc findstring markedmatches commitinfo
3317 global numcommits displayorder linehtag linentag linedtag
3318 global mainfont canv canv2 canv3 selectedline
3319 global matchinglines foundstring foundstrlen matchstring
3324 cancel_next_highlight
3326 set matchinglines {}
3327 if {$findtype == "IgnCase"} {
3328 set foundstring [string tolower $findstring]
3330 set foundstring $findstring
3332 set foundstrlen [string length $findstring]
3333 if {$foundstrlen == 0} return
3334 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3335 set matchstring "*$matchstring*"
3336 if {![info exists selectedline]} {
3339 set oldsel $selectedline
3342 set fldtypes {Headline Author Date Committer CDate Comments}
3344 foreach id $displayorder {
3345 set d $commitdata($id)
3347 if {$findtype == "Regexp"} {
3348 set doesmatch [regexp $foundstring $d]
3349 } elseif {$findtype == "IgnCase"} {
3350 set doesmatch [string match -nocase $matchstring $d]
3352 set doesmatch [string match $matchstring $d]
3354 if {!$doesmatch} continue
3355 if {![info exists commitinfo($id)]} {
3358 set info $commitinfo($id)
3360 foreach f $info ty $fldtypes {
3361 if {$findloc != "All fields" && $findloc != $ty} {
3364 set matches [findmatches $f]
3365 if {$matches == {}} continue
3367 if {$ty == "Headline"} {
3369 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3370 } elseif {$ty == "Author"} {
3372 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3373 } elseif {$ty == "Date"} {
3375 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3379 lappend matchinglines $l
3380 if {!$didsel && $l > $oldsel} {
3386 if {$matchinglines == {}} {
3388 } elseif {!$didsel} {
3389 findselectline [lindex $matchinglines 0]
3393 proc findselectline {l} {
3394 global findloc commentend ctext
3396 if {$findloc == "All fields" || $findloc == "Comments"} {
3397 # highlight the matches in the comments
3398 set f [$ctext get 1.0 $commentend]
3399 set matches [findmatches $f]
3400 foreach match $matches {
3401 set start [lindex $match 0]
3402 set end [expr {[lindex $match 1] + 1}]
3403 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3408 proc findnext {restart} {
3409 global matchinglines selectedline
3410 if {![info exists matchinglines]} {
3416 if {![info exists selectedline]} return
3417 foreach l $matchinglines {
3418 if {$l > $selectedline} {
3427 global matchinglines selectedline
3428 if {![info exists matchinglines]} {
3432 if {![info exists selectedline]} return
3434 foreach l $matchinglines {
3435 if {$l >= $selectedline} break
3439 findselectline $prev
3445 proc stopfindproc {{done 0}} {
3446 global findprocpid findprocfile findids
3447 global ctext findoldcursor phase maincursor textcursor
3448 global findinprogress
3450 catch {unset findids}
3451 if {[info exists findprocpid]} {
3453 catch {exec kill $findprocpid}
3455 catch {close $findprocfile}
3458 catch {unset findinprogress}
3462 # mark a commit as matching by putting a yellow background
3463 # behind the headline
3464 proc markheadline {l id} {
3465 global canv mainfont linehtag
3468 set bbox [$canv bbox $linehtag($l)]
3469 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3473 # mark the bits of a headline, author or date that match a find string
3474 proc markmatches {canv l str tag matches font} {
3475 set bbox [$canv bbox $tag]
3476 set x0 [lindex $bbox 0]
3477 set y0 [lindex $bbox 1]
3478 set y1 [lindex $bbox 3]
3479 foreach match $matches {
3480 set start [lindex $match 0]
3481 set end [lindex $match 1]
3482 if {$start > $end} continue
3483 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3484 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3485 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3486 [expr {$x0+$xlen+2}] $y1 \
3487 -outline {} -tags matches -fill yellow]
3492 proc unmarkmatches {} {
3493 global matchinglines findids
3494 allcanvs delete matches
3495 catch {unset matchinglines}
3496 catch {unset findids}
3499 proc selcanvline {w x y} {
3500 global canv canvy0 ctext linespc
3502 set ymax [lindex [$canv cget -scrollregion] 3]
3503 if {$ymax == {}} return
3504 set yfrac [lindex [$canv yview] 0]
3505 set y [expr {$y + $yfrac * $ymax}]
3506 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3511 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3517 proc commit_descriptor {p} {
3519 if {![info exists commitinfo($p)]} {
3523 if {[llength $commitinfo($p)] > 1} {
3524 set l [lindex $commitinfo($p) 0]
3529 # append some text to the ctext widget, and make any SHA1 ID
3530 # that we know about be a clickable link.
3531 proc appendwithlinks {text tags} {
3532 global ctext commitrow linknum curview
3534 set start [$ctext index "end - 1c"]
3535 $ctext insert end $text $tags
3536 $ctext insert end "\n"
3537 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3541 set linkid [string range $text $s $e]
3542 if {![info exists commitrow($curview,$linkid)]} continue
3544 $ctext tag add link "$start + $s c" "$start + $e c"
3545 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3546 $ctext tag bind link$linknum <1> \
3547 [list selectline $commitrow($curview,$linkid) 1]
3550 $ctext tag conf link -foreground blue -underline 1
3551 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3552 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3555 proc viewnextline {dir} {
3559 set ymax [lindex [$canv cget -scrollregion] 3]
3560 set wnow [$canv yview]
3561 set wtop [expr {[lindex $wnow 0] * $ymax}]
3562 set newtop [expr {$wtop + $dir * $linespc}]
3565 } elseif {$newtop > $ymax} {
3568 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3571 proc selectline {l isnew} {
3572 global canv canv2 canv3 ctext commitinfo selectedline
3573 global displayorder linehtag linentag linedtag
3574 global canvy0 linespc parentlist childlist
3575 global currentid sha1entry
3576 global commentend idtags linknum
3577 global mergemax numcommits pending_select
3580 catch {unset pending_select}
3583 cancel_next_highlight
3584 if {$l < 0 || $l >= $numcommits} return
3585 set y [expr {$canvy0 + $l * $linespc}]
3586 set ymax [lindex [$canv cget -scrollregion] 3]
3587 set ytop [expr {$y - $linespc - 1}]
3588 set ybot [expr {$y + $linespc + 1}]
3589 set wnow [$canv yview]
3590 set wtop [expr {[lindex $wnow 0] * $ymax}]
3591 set wbot [expr {[lindex $wnow 1] * $ymax}]
3592 set wh [expr {$wbot - $wtop}]
3594 if {$ytop < $wtop} {
3595 if {$ybot < $wtop} {
3596 set newtop [expr {$y - $wh / 2.0}]
3599 if {$newtop > $wtop - $linespc} {
3600 set newtop [expr {$wtop - $linespc}]
3603 } elseif {$ybot > $wbot} {
3604 if {$ytop > $wbot} {
3605 set newtop [expr {$y - $wh / 2.0}]
3607 set newtop [expr {$ybot - $wh}]
3608 if {$newtop < $wtop + $linespc} {
3609 set newtop [expr {$wtop + $linespc}]
3613 if {$newtop != $wtop} {
3617 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3621 if {![info exists linehtag($l)]} return
3623 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3624 -tags secsel -fill [$canv cget -selectbackground]]
3626 $canv2 delete secsel
3627 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3628 -tags secsel -fill [$canv2 cget -selectbackground]]
3630 $canv3 delete secsel
3631 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3632 -tags secsel -fill [$canv3 cget -selectbackground]]
3636 addtohistory [list selectline $l 0]
3641 set id [lindex $displayorder $l]
3643 $sha1entry delete 0 end
3644 $sha1entry insert 0 $id
3645 $sha1entry selection from 0
3646 $sha1entry selection to end
3649 $ctext conf -state normal
3652 set info $commitinfo($id)
3653 set date [formatdate [lindex $info 2]]
3654 $ctext insert end "Author: [lindex $info 1] $date\n"
3655 set date [formatdate [lindex $info 4]]
3656 $ctext insert end "Committer: [lindex $info 3] $date\n"
3657 if {[info exists idtags($id)]} {
3658 $ctext insert end "Tags:"
3659 foreach tag $idtags($id) {
3660 $ctext insert end " $tag"
3662 $ctext insert end "\n"
3666 set olds [lindex $parentlist $l]
3667 if {[llength $olds] > 1} {
3670 if {$np >= $mergemax} {
3675 $ctext insert end "Parent: " $tag
3676 appendwithlinks [commit_descriptor $p] {}
3681 append headers "Parent: [commit_descriptor $p]\n"
3685 foreach c [lindex $childlist $l] {
3686 append headers "Child: [commit_descriptor $c]\n"
3689 # make anything that looks like a SHA1 ID be a clickable link
3690 appendwithlinks $headers {}
3691 appendwithlinks [lindex $info 5] {comment}
3693 $ctext tag delete Comments
3694 $ctext tag remove found 1.0 end
3695 $ctext conf -state disabled
3696 set commentend [$ctext index "end - 1c"]
3698 init_flist "Comments"
3699 if {$cmitmode eq "tree"} {
3701 } elseif {[llength $olds] <= 1} {
3708 proc selfirstline {} {
3713 proc sellastline {} {
3716 set l [expr {$numcommits - 1}]
3720 proc selnextline {dir} {
3722 if {![info exists selectedline]} return
3723 set l [expr {$selectedline + $dir}]
3728 proc selnextpage {dir} {
3729 global canv linespc selectedline numcommits
3731 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3735 allcanvs yview scroll [expr {$dir * $lpp}] units
3737 if {![info exists selectedline]} return
3738 set l [expr {$selectedline + $dir * $lpp}]
3741 } elseif {$l >= $numcommits} {
3742 set l [expr $numcommits - 1]
3748 proc unselectline {} {
3749 global selectedline currentid
3751 catch {unset selectedline}
3752 catch {unset currentid}
3753 allcanvs delete secsel
3755 cancel_next_highlight
3758 proc reselectline {} {
3761 if {[info exists selectedline]} {
3762 selectline $selectedline 0
3766 proc addtohistory {cmd} {
3767 global history historyindex curview
3769 set elt [list $curview $cmd]
3770 if {$historyindex > 0
3771 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3775 if {$historyindex < [llength $history]} {
3776 set history [lreplace $history $historyindex end $elt]
3778 lappend history $elt
3781 if {$historyindex > 1} {
3782 .ctop.top.bar.leftbut conf -state normal
3784 .ctop.top.bar.leftbut conf -state disabled
3786 .ctop.top.bar.rightbut conf -state disabled
3792 set view [lindex $elt 0]
3793 set cmd [lindex $elt 1]
3794 if {$curview != $view} {
3801 global history historyindex
3803 if {$historyindex > 1} {
3804 incr historyindex -1
3805 godo [lindex $history [expr {$historyindex - 1}]]
3806 .ctop.top.bar.rightbut conf -state normal
3808 if {$historyindex <= 1} {
3809 .ctop.top.bar.leftbut conf -state disabled
3814 global history historyindex
3816 if {$historyindex < [llength $history]} {
3817 set cmd [lindex $history $historyindex]
3820 .ctop.top.bar.leftbut conf -state normal
3822 if {$historyindex >= [llength $history]} {
3823 .ctop.top.bar.rightbut conf -state disabled
3828 global treefilelist treeidlist diffids diffmergeid treepending
3831 catch {unset diffmergeid}
3832 if {![info exists treefilelist($id)]} {
3833 if {![info exists treepending]} {
3834 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3838 set treefilelist($id) {}
3839 set treeidlist($id) {}
3840 fconfigure $gtf -blocking 0
3841 fileevent $gtf readable [list gettreeline $gtf $id]
3848 proc gettreeline {gtf id} {
3849 global treefilelist treeidlist treepending cmitmode diffids
3851 while {[gets $gtf line] >= 0} {
3852 if {[lindex $line 1] ne "blob"} continue
3853 set sha1 [lindex $line 2]
3854 set fname [lindex $line 3]
3855 lappend treefilelist($id) $fname
3856 lappend treeidlist($id) $sha1
3858 if {![eof $gtf]} return
3861 if {$cmitmode ne "tree"} {
3862 if {![info exists diffmergeid]} {
3863 gettreediffs $diffids
3865 } elseif {$id ne $diffids} {
3873 global treefilelist treeidlist diffids
3874 global ctext commentend
3876 set i [lsearch -exact $treefilelist($diffids) $f]
3878 puts "oops, $f not in list for id $diffids"
3881 set blob [lindex $treeidlist($diffids) $i]
3882 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3883 puts "oops, error reading blob $blob: $err"
3886 fconfigure $bf -blocking 0
3887 fileevent $bf readable [list getblobline $bf $diffids]
3888 $ctext config -state normal
3889 clear_ctext $commentend
3890 $ctext insert end "\n"
3891 $ctext insert end "$f\n" filesep
3892 $ctext config -state disabled
3893 $ctext yview $commentend
3896 proc getblobline {bf id} {
3897 global diffids cmitmode ctext
3899 if {$id ne $diffids || $cmitmode ne "tree"} {
3903 $ctext config -state normal
3904 while {[gets $bf line] >= 0} {
3905 $ctext insert end "$line\n"
3908 # delete last newline
3909 $ctext delete "end - 2c" "end - 1c"
3912 $ctext config -state disabled
3915 proc mergediff {id l} {
3916 global diffmergeid diffopts mdifffd
3922 # this doesn't seem to actually affect anything...
3923 set env(GIT_DIFF_OPTS) $diffopts
3924 set cmd [concat | git diff-tree --no-commit-id --cc $id]
3925 if {[catch {set mdf [open $cmd r]} err]} {
3926 error_popup "Error getting merge diffs: $err"
3929 fconfigure $mdf -blocking 0
3930 set mdifffd($id) $mdf
3931 set np [llength [lindex $parentlist $l]]
3932 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3933 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3936 proc getmergediffline {mdf id np} {
3937 global diffmergeid ctext cflist nextupdate mergemax
3938 global difffilestart mdifffd
3940 set n [gets $mdf line]
3947 if {![info exists diffmergeid] || $id != $diffmergeid
3948 || $mdf != $mdifffd($id)} {
3951 $ctext conf -state normal
3952 if {[regexp {^diff --cc (.*)} $line match fname]} {
3953 # start of a new file
3954 $ctext insert end "\n"
3955 set here [$ctext index "end - 1c"]
3956 lappend difffilestart $here
3957 add_flist [list $fname]
3958 set l [expr {(78 - [string length $fname]) / 2}]
3959 set pad [string range "----------------------------------------" 1 $l]
3960 $ctext insert end "$pad $fname $pad\n" filesep
3961 } elseif {[regexp {^@@} $line]} {
3962 $ctext insert end "$line\n" hunksep
3963 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3966 # parse the prefix - one ' ', '-' or '+' for each parent
3971 for {set j 0} {$j < $np} {incr j} {
3972 set c [string range $line $j $j]
3975 } elseif {$c == "-"} {
3977 } elseif {$c == "+"} {
3986 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3987 # line doesn't appear in result, parents in $minuses have the line
3988 set num [lindex $minuses 0]
3989 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3990 # line appears in result, parents in $pluses don't have the line
3991 lappend tags mresult
3992 set num [lindex $spaces 0]
3995 if {$num >= $mergemax} {
4000 $ctext insert end "$line\n" $tags
4002 $ctext conf -state disabled
4003 if {[clock clicks -milliseconds] >= $nextupdate} {
4005 fileevent $mdf readable {}
4007 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4011 proc startdiff {ids} {
4012 global treediffs diffids treepending diffmergeid
4015 catch {unset diffmergeid}
4016 if {![info exists treediffs($ids)]} {
4017 if {![info exists treepending]} {
4025 proc addtocflist {ids} {
4026 global treediffs cflist
4027 add_flist $treediffs($ids)
4031 proc gettreediffs {ids} {
4032 global treediff treepending
4033 set treepending $ids
4036 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4038 fconfigure $gdtf -blocking 0
4039 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4042 proc gettreediffline {gdtf ids} {
4043 global treediff treediffs treepending diffids diffmergeid
4046 set n [gets $gdtf line]
4048 if {![eof $gdtf]} return
4050 set treediffs($ids) $treediff
4052 if {$cmitmode eq "tree"} {
4054 } elseif {$ids != $diffids} {
4055 if {![info exists diffmergeid]} {
4056 gettreediffs $diffids
4063 set file [lindex $line 5]
4064 lappend treediff $file
4067 proc getblobdiffs {ids} {
4068 global diffopts blobdifffd diffids env curdifftag curtagstart
4069 global nextupdate diffinhdr treediffs
4071 set env(GIT_DIFF_OPTS) $diffopts
4072 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4073 if {[catch {set bdf [open $cmd r]} err]} {
4074 puts "error getting diffs: $err"
4078 fconfigure $bdf -blocking 0
4079 set blobdifffd($ids) $bdf
4080 set curdifftag Comments
4082 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4083 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4086 proc setinlist {var i val} {
4089 while {[llength [set $var]] < $i} {
4092 if {[llength [set $var]] == $i} {
4099 proc getblobdiffline {bdf ids} {
4100 global diffids blobdifffd ctext curdifftag curtagstart
4101 global diffnexthead diffnextnote difffilestart
4102 global nextupdate diffinhdr treediffs
4104 set n [gets $bdf line]
4108 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4109 $ctext tag add $curdifftag $curtagstart end
4114 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4117 $ctext conf -state normal
4118 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4119 # start of a new file
4120 $ctext insert end "\n"
4121 $ctext tag add $curdifftag $curtagstart end
4122 set here [$ctext index "end - 1c"]
4123 set curtagstart $here
4125 set i [lsearch -exact $treediffs($ids) $fname]
4127 setinlist difffilestart $i $here
4129 if {$newname ne $fname} {
4130 set i [lsearch -exact $treediffs($ids) $newname]
4132 setinlist difffilestart $i $here
4135 set curdifftag "f:$fname"
4136 $ctext tag delete $curdifftag
4137 set l [expr {(78 - [string length $header]) / 2}]
4138 set pad [string range "----------------------------------------" 1 $l]
4139 $ctext insert end "$pad $header $pad\n" filesep
4141 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4143 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4145 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4146 $line match f1l f1c f2l f2c rest]} {
4147 $ctext insert end "$line\n" hunksep
4150 set x [string range $line 0 0]
4151 if {$x == "-" || $x == "+"} {
4152 set tag [expr {$x == "+"}]
4153 $ctext insert end "$line\n" d$tag
4154 } elseif {$x == " "} {
4155 $ctext insert end "$line\n"
4156 } elseif {$diffinhdr || $x == "\\"} {
4157 # e.g. "\ No newline at end of file"
4158 $ctext insert end "$line\n" filesep
4160 # Something else we don't recognize
4161 if {$curdifftag != "Comments"} {
4162 $ctext insert end "\n"
4163 $ctext tag add $curdifftag $curtagstart end
4164 set curtagstart [$ctext index "end - 1c"]
4165 set curdifftag Comments
4167 $ctext insert end "$line\n" filesep
4170 $ctext conf -state disabled
4171 if {[clock clicks -milliseconds] >= $nextupdate} {
4173 fileevent $bdf readable {}
4175 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4180 global difffilestart ctext
4181 set here [$ctext index @0,0]
4182 foreach loc $difffilestart {
4183 if {[$ctext compare $loc > $here]} {
4189 proc clear_ctext {{first 1.0}} {
4190 global ctext smarktop smarkbot
4192 set l [lindex [split $first .] 0]
4193 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4196 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4199 $ctext delete $first end
4202 proc incrsearch {name ix op} {
4203 global ctext searchstring searchdirn
4205 $ctext tag remove found 1.0 end
4206 if {[catch {$ctext index anchor}]} {
4207 # no anchor set, use start of selection, or of visible area
4208 set sel [$ctext tag ranges sel]
4210 $ctext mark set anchor [lindex $sel 0]
4211 } elseif {$searchdirn eq "-forwards"} {
4212 $ctext mark set anchor @0,0
4214 $ctext mark set anchor @0,[winfo height $ctext]
4217 if {$searchstring ne {}} {
4218 set here [$ctext search $searchdirn -- $searchstring anchor]
4227 global sstring ctext searchstring searchdirn
4230 $sstring icursor end
4231 set searchdirn -forwards
4232 if {$searchstring ne {}} {
4233 set sel [$ctext tag ranges sel]
4235 set start "[lindex $sel 0] + 1c"
4236 } elseif {[catch {set start [$ctext index anchor]}]} {
4239 set match [$ctext search -count mlen -- $searchstring $start]
4240 $ctext tag remove sel 1.0 end
4246 set mend "$match + $mlen c"
4247 $ctext tag add sel $match $mend
4248 $ctext mark unset anchor
4252 proc dosearchback {} {
4253 global sstring ctext searchstring searchdirn
4256 $sstring icursor end
4257 set searchdirn -backwards
4258 if {$searchstring ne {}} {
4259 set sel [$ctext tag ranges sel]
4261 set start [lindex $sel 0]
4262 } elseif {[catch {set start [$ctext index anchor]}]} {
4263 set start @0,[winfo height $ctext]
4265 set match [$ctext search -backwards -count ml -- $searchstring $start]
4266 $ctext tag remove sel 1.0 end
4272 set mend "$match + $ml c"
4273 $ctext tag add sel $match $mend
4274 $ctext mark unset anchor
4278 proc searchmark {first last} {
4279 global ctext searchstring
4283 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4284 if {$match eq {}} break
4285 set mend "$match + $mlen c"
4286 $ctext tag add found $match $mend
4290 proc searchmarkvisible {doall} {
4291 global ctext smarktop smarkbot
4293 set topline [lindex [split [$ctext index @0,0] .] 0]
4294 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4295 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4296 # no overlap with previous
4297 searchmark $topline $botline
4298 set smarktop $topline
4299 set smarkbot $botline
4301 if {$topline < $smarktop} {
4302 searchmark $topline [expr {$smarktop-1}]
4303 set smarktop $topline
4305 if {$botline > $smarkbot} {
4306 searchmark [expr {$smarkbot+1}] $botline
4307 set smarkbot $botline
4312 proc scrolltext {f0 f1} {
4315 .ctop.cdet.left.sb set $f0 $f1
4316 if {$searchstring ne {}} {
4322 global linespc charspc canvx0 canvy0 mainfont
4323 global xspc1 xspc2 lthickness
4325 set linespc [font metrics $mainfont -linespace]
4326 set charspc [font measure $mainfont "m"]
4327 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4328 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4329 set lthickness [expr {int($linespc / 9) + 1}]
4330 set xspc1(0) $linespc
4338 set ymax [lindex [$canv cget -scrollregion] 3]
4339 if {$ymax eq {} || $ymax == 0} return
4340 set span [$canv yview]
4343 allcanvs yview moveto [lindex $span 0]
4345 if {[info exists selectedline]} {
4346 selectline $selectedline 0
4350 proc incrfont {inc} {
4351 global mainfont textfont ctext canv phase
4352 global stopped entries
4354 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4355 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4357 $ctext conf -font $textfont
4358 $ctext tag conf filesep -font [concat $textfont bold]
4359 foreach e $entries {
4360 $e conf -font $mainfont
4362 if {$phase eq "getcommits"} {
4363 $canv itemconf textitems -font $mainfont
4369 global sha1entry sha1string
4370 if {[string length $sha1string] == 40} {
4371 $sha1entry delete 0 end
4375 proc sha1change {n1 n2 op} {
4376 global sha1string currentid sha1but
4377 if {$sha1string == {}
4378 || ([info exists currentid] && $sha1string == $currentid)} {
4383 if {[$sha1but cget -state] == $state} return
4384 if {$state == "normal"} {
4385 $sha1but conf -state normal -relief raised -text "Goto: "
4387 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4391 proc gotocommit {} {
4392 global sha1string currentid commitrow tagids headids
4393 global displayorder numcommits curview
4395 if {$sha1string == {}
4396 || ([info exists currentid] && $sha1string == $currentid)} return
4397 if {[info exists tagids($sha1string)]} {
4398 set id $tagids($sha1string)
4399 } elseif {[info exists headids($sha1string)]} {
4400 set id $headids($sha1string)
4402 set id [string tolower $sha1string]
4403 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4405 foreach i $displayorder {
4406 if {[string match $id* $i]} {
4410 if {$matches ne {}} {
4411 if {[llength $matches] > 1} {
4412 error_popup "Short SHA1 id $id is ambiguous"
4415 set id [lindex $matches 0]
4419 if {[info exists commitrow($curview,$id)]} {
4420 selectline $commitrow($curview,$id) 1
4423 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4428 error_popup "$type $sha1string is not known"
4431 proc lineenter {x y id} {
4432 global hoverx hovery hoverid hovertimer
4433 global commitinfo canv
4435 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4439 if {[info exists hovertimer]} {
4440 after cancel $hovertimer
4442 set hovertimer [after 500 linehover]
4446 proc linemotion {x y id} {
4447 global hoverx hovery hoverid hovertimer
4449 if {[info exists hoverid] && $id == $hoverid} {
4452 if {[info exists hovertimer]} {
4453 after cancel $hovertimer
4455 set hovertimer [after 500 linehover]
4459 proc lineleave {id} {
4460 global hoverid hovertimer canv
4462 if {[info exists hoverid] && $id == $hoverid} {
4464 if {[info exists hovertimer]} {
4465 after cancel $hovertimer
4473 global hoverx hovery hoverid hovertimer
4474 global canv linespc lthickness
4475 global commitinfo mainfont
4477 set text [lindex $commitinfo($hoverid) 0]
4478 set ymax [lindex [$canv cget -scrollregion] 3]
4479 if {$ymax == {}} return
4480 set yfrac [lindex [$canv yview] 0]
4481 set x [expr {$hoverx + 2 * $linespc}]
4482 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4483 set x0 [expr {$x - 2 * $lthickness}]
4484 set y0 [expr {$y - 2 * $lthickness}]
4485 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4486 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4487 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4488 -fill \#ffff80 -outline black -width 1 -tags hover]
4490 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4494 proc clickisonarrow {id y} {
4497 set ranges [rowranges $id]
4498 set thresh [expr {2 * $lthickness + 6}]
4499 set n [expr {[llength $ranges] - 1}]
4500 for {set i 1} {$i < $n} {incr i} {
4501 set row [lindex $ranges $i]
4502 if {abs([yc $row] - $y) < $thresh} {
4509 proc arrowjump {id n y} {
4512 # 1 <-> 2, 3 <-> 4, etc...
4513 set n [expr {(($n - 1) ^ 1) + 1}]
4514 set row [lindex [rowranges $id] $n]
4516 set ymax [lindex [$canv cget -scrollregion] 3]
4517 if {$ymax eq {} || $ymax <= 0} return
4518 set view [$canv yview]
4519 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4520 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4524 allcanvs yview moveto $yfrac
4527 proc lineclick {x y id isnew} {
4528 global ctext commitinfo children canv thickerline curview
4530 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4535 # draw this line thicker than normal
4539 set ymax [lindex [$canv cget -scrollregion] 3]
4540 if {$ymax eq {}} return
4541 set yfrac [lindex [$canv yview] 0]
4542 set y [expr {$y + $yfrac * $ymax}]
4544 set dirn [clickisonarrow $id $y]
4546 arrowjump $id $dirn $y
4551 addtohistory [list lineclick $x $y $id 0]
4553 # fill the details pane with info about this line
4554 $ctext conf -state normal
4556 $ctext tag conf link -foreground blue -underline 1
4557 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4558 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4559 $ctext insert end "Parent:\t"
4560 $ctext insert end $id [list link link0]
4561 $ctext tag bind link0 <1> [list selbyid $id]
4562 set info $commitinfo($id)
4563 $ctext insert end "\n\t[lindex $info 0]\n"
4564 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4565 set date [formatdate [lindex $info 2]]
4566 $ctext insert end "\tDate:\t$date\n"
4567 set kids $children($curview,$id)
4569 $ctext insert end "\nChildren:"
4571 foreach child $kids {
4573 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4574 set info $commitinfo($child)
4575 $ctext insert end "\n\t"
4576 $ctext insert end $child [list link link$i]
4577 $ctext tag bind link$i <1> [list selbyid $child]
4578 $ctext insert end "\n\t[lindex $info 0]"
4579 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4580 set date [formatdate [lindex $info 2]]
4581 $ctext insert end "\n\tDate:\t$date\n"
4584 $ctext conf -state disabled
4588 proc normalline {} {
4590 if {[info exists thickerline]} {
4598 global commitrow curview
4599 if {[info exists commitrow($curview,$id)]} {
4600 selectline $commitrow($curview,$id) 1
4606 if {![info exists startmstime]} {
4607 set startmstime [clock clicks -milliseconds]
4609 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4612 proc rowmenu {x y id} {
4613 global rowctxmenu commitrow selectedline rowmenuid curview
4615 if {![info exists selectedline]
4616 || $commitrow($curview,$id) eq $selectedline} {
4621 $rowctxmenu entryconfigure 0 -state $state
4622 $rowctxmenu entryconfigure 1 -state $state
4623 $rowctxmenu entryconfigure 2 -state $state
4625 tk_popup $rowctxmenu $x $y
4628 proc diffvssel {dirn} {
4629 global rowmenuid selectedline displayorder
4631 if {![info exists selectedline]} return
4633 set oldid [lindex $displayorder $selectedline]
4634 set newid $rowmenuid
4636 set oldid $rowmenuid
4637 set newid [lindex $displayorder $selectedline]
4639 addtohistory [list doseldiff $oldid $newid]
4640 doseldiff $oldid $newid
4643 proc doseldiff {oldid newid} {
4647 $ctext conf -state normal
4650 $ctext insert end "From "
4651 $ctext tag conf link -foreground blue -underline 1
4652 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4653 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4654 $ctext tag bind link0 <1> [list selbyid $oldid]
4655 $ctext insert end $oldid [list link link0]
4656 $ctext insert end "\n "
4657 $ctext insert end [lindex $commitinfo($oldid) 0]
4658 $ctext insert end "\n\nTo "
4659 $ctext tag bind link1 <1> [list selbyid $newid]
4660 $ctext insert end $newid [list link link1]
4661 $ctext insert end "\n "
4662 $ctext insert end [lindex $commitinfo($newid) 0]
4663 $ctext insert end "\n"
4664 $ctext conf -state disabled
4665 $ctext tag delete Comments
4666 $ctext tag remove found 1.0 end
4667 startdiff [list $oldid $newid]
4671 global rowmenuid currentid commitinfo patchtop patchnum
4673 if {![info exists currentid]} return
4674 set oldid $currentid
4675 set oldhead [lindex $commitinfo($oldid) 0]
4676 set newid $rowmenuid
4677 set newhead [lindex $commitinfo($newid) 0]
4680 catch {destroy $top}
4682 label $top.title -text "Generate patch"
4683 grid $top.title - -pady 10
4684 label $top.from -text "From:"
4685 entry $top.fromsha1 -width 40 -relief flat
4686 $top.fromsha1 insert 0 $oldid
4687 $top.fromsha1 conf -state readonly
4688 grid $top.from $top.fromsha1 -sticky w
4689 entry $top.fromhead -width 60 -relief flat
4690 $top.fromhead insert 0 $oldhead
4691 $top.fromhead conf -state readonly
4692 grid x $top.fromhead -sticky w
4693 label $top.to -text "To:"
4694 entry $top.tosha1 -width 40 -relief flat
4695 $top.tosha1 insert 0 $newid
4696 $top.tosha1 conf -state readonly
4697 grid $top.to $top.tosha1 -sticky w
4698 entry $top.tohead -width 60 -relief flat
4699 $top.tohead insert 0 $newhead
4700 $top.tohead conf -state readonly
4701 grid x $top.tohead -sticky w
4702 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4703 grid $top.rev x -pady 10
4704 label $top.flab -text "Output file:"
4705 entry $top.fname -width 60
4706 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4708 grid $top.flab $top.fname -sticky w
4710 button $top.buts.gen -text "Generate" -command mkpatchgo
4711 button $top.buts.can -text "Cancel" -command mkpatchcan
4712 grid $top.buts.gen $top.buts.can
4713 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4714 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4715 grid $top.buts - -pady 10 -sticky ew
4719 proc mkpatchrev {} {
4722 set oldid [$patchtop.fromsha1 get]
4723 set oldhead [$patchtop.fromhead get]
4724 set newid [$patchtop.tosha1 get]
4725 set newhead [$patchtop.tohead get]
4726 foreach e [list fromsha1 fromhead tosha1 tohead] \
4727 v [list $newid $newhead $oldid $oldhead] {
4728 $patchtop.$e conf -state normal
4729 $patchtop.$e delete 0 end
4730 $patchtop.$e insert 0 $v
4731 $patchtop.$e conf -state readonly
4738 set oldid [$patchtop.fromsha1 get]
4739 set newid [$patchtop.tosha1 get]
4740 set fname [$patchtop.fname get]
4741 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4742 error_popup "Error creating patch: $err"
4744 catch {destroy $patchtop}
4748 proc mkpatchcan {} {
4751 catch {destroy $patchtop}
4756 global rowmenuid mktagtop commitinfo
4760 catch {destroy $top}
4762 label $top.title -text "Create tag"
4763 grid $top.title - -pady 10
4764 label $top.id -text "ID:"
4765 entry $top.sha1 -width 40 -relief flat
4766 $top.sha1 insert 0 $rowmenuid
4767 $top.sha1 conf -state readonly
4768 grid $top.id $top.sha1 -sticky w
4769 entry $top.head -width 60 -relief flat
4770 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4771 $top.head conf -state readonly
4772 grid x $top.head -sticky w
4773 label $top.tlab -text "Tag name:"
4774 entry $top.tag -width 60
4775 grid $top.tlab $top.tag -sticky w
4777 button $top.buts.gen -text "Create" -command mktaggo
4778 button $top.buts.can -text "Cancel" -command mktagcan
4779 grid $top.buts.gen $top.buts.can
4780 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4781 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4782 grid $top.buts - -pady 10 -sticky ew
4787 global mktagtop env tagids idtags
4789 set id [$mktagtop.sha1 get]
4790 set tag [$mktagtop.tag get]
4792 error_popup "No tag name specified"
4795 if {[info exists tagids($tag)]} {
4796 error_popup "Tag \"$tag\" already exists"
4801 set fname [file join $dir "refs/tags" $tag]
4802 set f [open $fname w]
4806 error_popup "Error creating tag: $err"
4810 set tagids($tag) $id
4811 lappend idtags($id) $tag
4815 proc redrawtags {id} {
4816 global canv linehtag commitrow idpos selectedline curview
4818 if {![info exists commitrow($curview,$id)]} return
4819 drawcmitrow $commitrow($curview,$id)
4820 $canv delete tag.$id
4821 set xt [eval drawtags $id $idpos($id)]
4822 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4823 if {[info exists selectedline]
4824 && $selectedline == $commitrow($curview,$id)} {
4825 selectline $selectedline 0
4832 catch {destroy $mktagtop}
4841 proc writecommit {} {
4842 global rowmenuid wrcomtop commitinfo wrcomcmd
4844 set top .writecommit
4846 catch {destroy $top}
4848 label $top.title -text "Write commit to file"
4849 grid $top.title - -pady 10
4850 label $top.id -text "ID:"
4851 entry $top.sha1 -width 40 -relief flat
4852 $top.sha1 insert 0 $rowmenuid
4853 $top.sha1 conf -state readonly
4854 grid $top.id $top.sha1 -sticky w
4855 entry $top.head -width 60 -relief flat
4856 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4857 $top.head conf -state readonly
4858 grid x $top.head -sticky w
4859 label $top.clab -text "Command:"
4860 entry $top.cmd -width 60 -textvariable wrcomcmd
4861 grid $top.clab $top.cmd -sticky w -pady 10
4862 label $top.flab -text "Output file:"
4863 entry $top.fname -width 60
4864 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4865 grid $top.flab $top.fname -sticky w
4867 button $top.buts.gen -text "Write" -command wrcomgo
4868 button $top.buts.can -text "Cancel" -command wrcomcan
4869 grid $top.buts.gen $top.buts.can
4870 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4871 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4872 grid $top.buts - -pady 10 -sticky ew
4879 set id [$wrcomtop.sha1 get]
4880 set cmd "echo $id | [$wrcomtop.cmd get]"
4881 set fname [$wrcomtop.fname get]
4882 if {[catch {exec sh -c $cmd >$fname &} err]} {
4883 error_popup "Error writing commit: $err"
4885 catch {destroy $wrcomtop}
4892 catch {destroy $wrcomtop}
4896 proc listrefs {id} {
4897 global idtags idheads idotherrefs
4900 if {[info exists idtags($id)]} {
4904 if {[info exists idheads($id)]} {
4908 if {[info exists idotherrefs($id)]} {
4909 set z $idotherrefs($id)
4911 return [list $x $y $z]
4914 proc rereadrefs {} {
4915 global idtags idheads idotherrefs
4917 set refids [concat [array names idtags] \
4918 [array names idheads] [array names idotherrefs]]
4919 foreach id $refids {
4920 if {![info exists ref($id)]} {
4921 set ref($id) [listrefs $id]
4925 set refids [lsort -unique [concat $refids [array names idtags] \
4926 [array names idheads] [array names idotherrefs]]]
4927 foreach id $refids {
4928 set v [listrefs $id]
4929 if {![info exists ref($id)] || $ref($id) != $v} {
4935 proc showtag {tag isnew} {
4936 global ctext tagcontents tagids linknum
4939 addtohistory [list showtag $tag 0]
4941 $ctext conf -state normal
4944 if {[info exists tagcontents($tag)]} {
4945 set text $tagcontents($tag)
4947 set text "Tag: $tag\nId: $tagids($tag)"
4949 appendwithlinks $text {}
4950 $ctext conf -state disabled
4961 global maxwidth maxgraphpct diffopts
4962 global oldprefs prefstop
4966 if {[winfo exists $top]} {
4970 foreach v {maxwidth maxgraphpct diffopts} {
4971 set oldprefs($v) [set $v]
4974 wm title $top "Gitk preferences"
4975 label $top.ldisp -text "Commit list display options"
4976 grid $top.ldisp - -sticky w -pady 10
4977 label $top.spacer -text " "
4978 label $top.maxwidthl -text "Maximum graph width (lines)" \
4980 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4981 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4982 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4984 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4985 grid x $top.maxpctl $top.maxpct -sticky w
4986 label $top.ddisp -text "Diff display options"
4987 grid $top.ddisp - -sticky w -pady 10
4988 label $top.diffoptl -text "Options for diff program" \
4990 entry $top.diffopt -width 20 -textvariable diffopts
4991 grid x $top.diffoptl $top.diffopt -sticky w
4993 button $top.buts.ok -text "OK" -command prefsok
4994 button $top.buts.can -text "Cancel" -command prefscan
4995 grid $top.buts.ok $top.buts.can
4996 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4997 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4998 grid $top.buts - - -pady 10 -sticky ew
5002 global maxwidth maxgraphpct diffopts
5003 global oldprefs prefstop
5005 foreach v {maxwidth maxgraphpct diffopts} {
5006 set $v $oldprefs($v)
5008 catch {destroy $prefstop}
5013 global maxwidth maxgraphpct
5014 global oldprefs prefstop
5016 catch {destroy $prefstop}
5018 if {$maxwidth != $oldprefs(maxwidth)
5019 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5024 proc formatdate {d} {
5025 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5028 # This list of encoding names and aliases is distilled from
5029 # http://www.iana.org/assignments/character-sets.
5030 # Not all of them are supported by Tcl.
5031 set encoding_aliases {
5032 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5033 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5034 { ISO-10646-UTF-1 csISO10646UTF1 }
5035 { ISO_646.basic:1983 ref csISO646basic1983 }
5036 { INVARIANT csINVARIANT }
5037 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5038 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5039 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5040 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5041 { NATS-DANO iso-ir-9-1 csNATSDANO }
5042 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5043 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5044 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5045 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5046 { ISO-2022-KR csISO2022KR }
5048 { ISO-2022-JP csISO2022JP }
5049 { ISO-2022-JP-2 csISO2022JP2 }
5050 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5052 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5053 { IT iso-ir-15 ISO646-IT csISO15Italian }
5054 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5055 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5056 { greek7-old iso-ir-18 csISO18Greek7Old }
5057 { latin-greek iso-ir-19 csISO19LatinGreek }
5058 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5059 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5060 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5061 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5062 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5063 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5064 { INIS iso-ir-49 csISO49INIS }
5065 { INIS-8 iso-ir-50 csISO50INIS8 }
5066 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5067 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5068 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5069 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5070 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5071 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5073 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5074 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5075 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5076 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5077 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5078 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5079 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5080 { greek7 iso-ir-88 csISO88Greek7 }
5081 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5082 { iso-ir-90 csISO90 }
5083 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5084 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5085 csISO92JISC62991984b }
5086 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5087 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5088 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5089 csISO95JIS62291984handadd }
5090 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5091 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5092 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5093 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5095 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5096 { T.61-7bit iso-ir-102 csISO102T617bit }
5097 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5098 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5099 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5100 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5101 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5102 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5103 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5104 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5105 arabic csISOLatinArabic }
5106 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5107 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5108 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5109 greek greek8 csISOLatinGreek }
5110 { T.101-G2 iso-ir-128 csISO128T101G2 }
5111 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5113 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5114 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5115 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5116 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5117 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5118 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5119 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5120 csISOLatinCyrillic }
5121 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5122 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5123 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5124 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5125 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5126 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5127 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5128 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5129 { ISO_10367-box iso-ir-155 csISO10367Box }
5130 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5131 { latin-lap lap iso-ir-158 csISO158Lap }
5132 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5133 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5136 { JIS_X0201 X0201 csHalfWidthKatakana }
5137 { KSC5636 ISO646-KR csKSC5636 }
5138 { ISO-10646-UCS-2 csUnicode }
5139 { ISO-10646-UCS-4 csUCS4 }
5140 { DEC-MCS dec csDECMCS }
5141 { hp-roman8 roman8 r8 csHPRoman8 }
5142 { macintosh mac csMacintosh }
5143 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5145 { IBM038 EBCDIC-INT cp038 csIBM038 }
5146 { IBM273 CP273 csIBM273 }
5147 { IBM274 EBCDIC-BE CP274 csIBM274 }
5148 { IBM275 EBCDIC-BR cp275 csIBM275 }
5149 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5150 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5151 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5152 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5153 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5154 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5155 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5156 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5157 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5158 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5159 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5160 { IBM437 cp437 437 csPC8CodePage437 }
5161 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5162 { IBM775 cp775 csPC775Baltic }
5163 { IBM850 cp850 850 csPC850Multilingual }
5164 { IBM851 cp851 851 csIBM851 }
5165 { IBM852 cp852 852 csPCp852 }
5166 { IBM855 cp855 855 csIBM855 }
5167 { IBM857 cp857 857 csIBM857 }
5168 { IBM860 cp860 860 csIBM860 }
5169 { IBM861 cp861 861 cp-is csIBM861 }
5170 { IBM862 cp862 862 csPC862LatinHebrew }
5171 { IBM863 cp863 863 csIBM863 }
5172 { IBM864 cp864 csIBM864 }
5173 { IBM865 cp865 865 csIBM865 }
5174 { IBM866 cp866 866 csIBM866 }
5175 { IBM868 CP868 cp-ar csIBM868 }
5176 { IBM869 cp869 869 cp-gr csIBM869 }
5177 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5178 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5179 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5180 { IBM891 cp891 csIBM891 }
5181 { IBM903 cp903 csIBM903 }
5182 { IBM904 cp904 904 csIBBM904 }
5183 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5184 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5185 { IBM1026 CP1026 csIBM1026 }
5186 { EBCDIC-AT-DE csIBMEBCDICATDE }
5187 { EBCDIC-AT-DE-A csEBCDICATDEA }
5188 { EBCDIC-CA-FR csEBCDICCAFR }
5189 { EBCDIC-DK-NO csEBCDICDKNO }
5190 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5191 { EBCDIC-FI-SE csEBCDICFISE }
5192 { EBCDIC-FI-SE-A csEBCDICFISEA }
5193 { EBCDIC-FR csEBCDICFR }
5194 { EBCDIC-IT csEBCDICIT }
5195 { EBCDIC-PT csEBCDICPT }
5196 { EBCDIC-ES csEBCDICES }
5197 { EBCDIC-ES-A csEBCDICESA }
5198 { EBCDIC-ES-S csEBCDICESS }
5199 { EBCDIC-UK csEBCDICUK }
5200 { EBCDIC-US csEBCDICUS }
5201 { UNKNOWN-8BIT csUnknown8BiT }
5202 { MNEMONIC csMnemonic }
5207 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5208 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5209 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5210 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5211 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5212 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5213 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5214 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5215 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5216 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5217 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5218 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5219 { IBM1047 IBM-1047 }
5220 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5221 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5222 { UNICODE-1-1 csUnicode11 }
5225 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5226 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5228 { ISO-8859-15 ISO_8859-15 Latin-9 }
5229 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5230 { GBK CP936 MS936 windows-936 }
5231 { JIS_Encoding csJISEncoding }
5232 { Shift_JIS MS_Kanji csShiftJIS }
5233 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5235 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5236 { ISO-10646-UCS-Basic csUnicodeASCII }
5237 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5238 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5239 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5240 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5241 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5242 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5243 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5244 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5245 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5246 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5247 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5248 { Ventura-US csVenturaUS }
5249 { Ventura-International csVenturaInternational }
5250 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5251 { PC8-Turkish csPC8Turkish }
5252 { IBM-Symbols csIBMSymbols }
5253 { IBM-Thai csIBMThai }
5254 { HP-Legal csHPLegal }
5255 { HP-Pi-font csHPPiFont }
5256 { HP-Math8 csHPMath8 }
5257 { Adobe-Symbol-Encoding csHPPSMath }
5258 { HP-DeskTop csHPDesktop }
5259 { Ventura-Math csVenturaMath }
5260 { Microsoft-Publishing csMicrosoftPublishing }
5261 { Windows-31J csWindows31J }
5266 proc tcl_encoding {enc} {
5267 global encoding_aliases
5268 set names [encoding names]
5269 set lcnames [string tolower $names]
5270 set enc [string tolower $enc]
5271 set i [lsearch -exact $lcnames $enc]
5273 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5274 if {[regsub {^iso[-_]} $enc iso encx]} {
5275 set i [lsearch -exact $lcnames $encx]
5279 foreach l $encoding_aliases {
5280 set ll [string tolower $l]
5281 if {[lsearch -exact $ll $enc] < 0} continue
5282 # look through the aliases for one that tcl knows about
5284 set i [lsearch -exact $lcnames $e]
5286 if {[regsub {^iso[-_]} $e iso ex]} {
5287 set i [lsearch -exact $lcnames $ex]
5296 return [lindex $names $i]
5303 set diffopts "-U 5 -p"
5304 set wrcomcmd "git diff-tree --stdin -p --pretty"
5308 set gitencoding [exec git repo-config --get i18n.commitencoding]
5310 if {$gitencoding == ""} {
5311 set gitencoding "utf-8"
5313 set tclencoding [tcl_encoding $gitencoding]
5314 if {$tclencoding == {}} {
5315 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5318 set mainfont {Helvetica 9}
5319 set textfont {Courier 9}
5320 set uifont {Helvetica 9 bold}
5321 set findmergefiles 0
5329 set cmitmode "patch"
5330 set wrapcomment "none"
5332 set colors {green red blue magenta darkgrey brown orange}
5334 catch {source ~/.gitk}
5336 font create optionfont -family sans-serif -size -12
5340 switch -regexp -- $arg {
5342 "^-d" { set datemode 1 }
5344 lappend revtreeargs $arg
5349 # check that we can find a .git directory somewhere...
5351 if {![file isdirectory $gitdir]} {
5352 show_error {} . "Cannot find the git directory \"$gitdir\"."
5356 set cmdline_files {}
5357 set i [lsearch -exact $revtreeargs "--"]
5359 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5360 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5361 } elseif {$revtreeargs ne {}} {
5363 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5364 set cmdline_files [split $f "\n"]
5365 set n [llength $cmdline_files]
5366 set revtreeargs [lrange $revtreeargs 0 end-$n]
5368 # unfortunately we get both stdout and stderr in $err,
5369 # so look for "fatal:".
5370 set i [string first "fatal:" $err]
5372 set err [string range $err [expr {$i + 6}] end]
5374 show_error {} . "Bad arguments to gitk:\n$err"
5383 set highlight_paths {}
5384 set searchdirn -forwards
5393 set selectedhlview None
5406 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5407 # create a view for the files/dirs specified on the command line
5411 set viewname(1) "Command line"
5412 set viewfiles(1) $cmdline_files
5413 set viewargs(1) $revtreeargs
5416 .bar.view entryconf 2 -state normal
5417 .bar.view entryconf 3 -state normal
5420 if {[info exists permviews]} {
5421 foreach v $permviews {
5424 set viewname($n) [lindex $v 0]
5425 set viewfiles($n) [lindex $v 1]
5426 set viewargs($n) [lindex $v 2]