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 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 $w"
366 pack
$w.ok
-side bottom
-fill x
367 bind $w <Visibility
> "grab $w; focus $w"
368 bind $w <Key-Return
> "destroy $w"
372 proc error_popup 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
386 global highlight_files highlight_names
389 .bar add cascade
-label "File" -menu .bar.
file
390 .bar configure
-font $uifont
392 .bar.
file add
command -label "Update" -command updatecommits
393 .bar.
file add
command -label "Reread references" -command rereadrefs
394 .bar.
file add
command -label "Quit" -command doquit
395 .bar.
file configure
-font $uifont
397 .bar add cascade
-label "Edit" -menu .bar.edit
398 .bar.edit add
command -label "Preferences" -command doprefs
399 .bar.edit configure
-font $uifont
401 menu .bar.view
-font $uifont
402 .bar add cascade
-label "View" -menu .bar.view
403 .bar.view add
command -label "New view..." -command {newview
0}
404 .bar.view add
command -label "Edit view..." -command editview \
406 .bar.view add
command -label "Delete view" -command delview
-state disabled
407 .bar.view add separator
408 .bar.view add radiobutton
-label "All files" -command {showview
0} \
409 -variable selectedview
-value 0
412 .bar add cascade
-label "Help" -menu .bar.
help
413 .bar.
help add
command -label "About gitk" -command about
414 .bar.
help add
command -label "Key bindings" -command keys
415 .bar.
help configure
-font $uifont
416 . configure
-menu .bar
418 if {![info exists geometry
(canv1
)]} {
419 set geometry
(canv1
) [expr {45 * $charspc}]
420 set geometry
(canv2
) [expr {30 * $charspc}]
421 set geometry
(canv3
) [expr {15 * $charspc}]
422 set geometry
(canvh
) [expr {25 * $linespc + 4}]
423 set geometry
(ctextw
) 80
424 set geometry
(ctexth
) 30
425 set geometry
(cflistw
) 30
427 panedwindow .ctop
-orient vertical
428 if {[info exists geometry
(width
)]} {
429 .ctop conf
-width $geometry(width
) -height $geometry(height
)
430 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
431 set geometry
(ctexth
) [expr {($texth - 8) /
432 [font metrics
$textfont -linespace]}]
437 pack .ctop.top.lbar
-side bottom
-fill x
438 pack .ctop.top.bar
-side bottom
-fill x
439 set cscroll .ctop.top.csb
440 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
441 pack
$cscroll -side right
-fill y
442 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
443 pack .ctop.top.clist
-side top
-fill both
-expand 1
445 set canv .ctop.top.clist.canv
446 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
448 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
449 .ctop.top.clist add
$canv
450 set canv2 .ctop.top.clist.canv2
451 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
452 -bg white
-bd 0 -yscrollincr $linespc
453 .ctop.top.clist add
$canv2
454 set canv3 .ctop.top.clist.canv3
455 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
456 -bg white
-bd 0 -yscrollincr $linespc
457 .ctop.top.clist add
$canv3
458 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
460 set sha1entry .ctop.top.bar.sha1
461 set entries
$sha1entry
462 set sha1but .ctop.top.bar.sha1label
463 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
464 -command gotocommit
-width 8 -font $uifont
465 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
466 pack .ctop.top.bar.sha1label
-side left
467 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
468 trace add variable sha1string
write sha1change
469 pack
$sha1entry -side left
-pady 2
471 image create bitmap bm-left
-data {
472 #define left_width 16
473 #define left_height 16
474 static unsigned char left_bits
[] = {
475 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
476 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
477 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
479 image create bitmap bm-right
-data {
480 #define right_width 16
481 #define right_height 16
482 static unsigned char right_bits
[] = {
483 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
484 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
485 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
487 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
488 -state disabled
-width 26
489 pack .ctop.top.bar.leftbut
-side left
-fill y
490 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
491 -state disabled
-width 26
492 pack .ctop.top.bar.rightbut
-side left
-fill y
494 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
495 pack .ctop.top.bar.findbut
-side left
497 set fstring .ctop.top.bar.findstring
498 lappend entries
$fstring
499 entry
$fstring -width 30 -font $textfont -textvariable findstring
500 pack
$fstring -side left
-expand 1 -fill x
502 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
503 findtype Exact IgnCase Regexp
]
504 .ctop.top.bar.findtype configure
-font $uifont
505 .ctop.top.bar.findtype.menu configure
-font $uifont
506 set findloc
"All fields"
507 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
508 Comments Author Committer Files Pickaxe
509 .ctop.top.bar.findloc configure
-font $uifont
510 .ctop.top.bar.findloc.menu configure
-font $uifont
512 pack .ctop.top.bar.findloc
-side right
513 pack .ctop.top.bar.findtype
-side right
514 # for making sure type==Exact whenever loc==Pickaxe
515 trace add variable findloc
write findlocchange
517 label .ctop.top.lbar.flabel
-text "Highlight: Commits touching paths:" \
519 pack .ctop.top.lbar.flabel
-side left
-fill y
520 entry .ctop.top.lbar.fent
-width 25 -font $textfont \
521 -textvariable highlight_files
522 trace add variable highlight_files
write hfiles_change
523 lappend entries .ctop.top.lbar.fent
524 pack .ctop.top.lbar.fent
-side left
-fill x
-expand 1
525 label .ctop.top.lbar.vlabel
-text " OR in view" -font $uifont
526 pack .ctop.top.lbar.vlabel
-side left
-fill y
527 global viewhlmenu selectedhlview
528 set viewhlmenu
[tk_optionMenu .ctop.top.lbar.vhl selectedhlview None
]
529 $viewhlmenu entryconf
0 -command delvhighlight
530 $viewhlmenu conf
-font $uifont
531 .ctop.top.lbar.vhl conf
-font $uifont
532 pack .ctop.top.lbar.vhl
-side left
-fill y
533 label .ctop.top.lbar.alabel
-text " OR author/committer:" \
535 pack .ctop.top.lbar.alabel
-side left
-fill y
536 entry .ctop.top.lbar.aent
-width 20 -font $textfont \
537 -textvariable highlight_names
538 trace add variable highlight_names
write hnames_change
539 lappend entries .ctop.top.lbar.aent
540 pack .ctop.top.lbar.aent
-side right
-fill x
-expand 1
542 panedwindow .ctop.cdet
-orient horizontal
544 frame .ctop.cdet.left
545 set ctext .ctop.cdet.left.ctext
546 text
$ctext -bg white
-state disabled
-font $textfont \
547 -width $geometry(ctextw
) -height $geometry(ctexth
) \
548 -yscrollcommand {.ctop.cdet.left.sb
set} -wrap none
549 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
550 pack .ctop.cdet.left.sb
-side right
-fill y
551 pack
$ctext -side left
-fill both
-expand 1
552 .ctop.cdet add .ctop.cdet.left
554 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
555 $ctext tag conf hunksep
-fore blue
556 $ctext tag conf d0
-fore red
557 $ctext tag conf d1
-fore "#00a000"
558 $ctext tag conf m0
-fore red
559 $ctext tag conf m1
-fore blue
560 $ctext tag conf m2
-fore green
561 $ctext tag conf m3
-fore purple
562 $ctext tag conf
m4 -fore brown
563 $ctext tag conf m5
-fore "#009090"
564 $ctext tag conf m6
-fore magenta
565 $ctext tag conf m7
-fore "#808000"
566 $ctext tag conf m8
-fore "#009000"
567 $ctext tag conf m9
-fore "#ff0080"
568 $ctext tag conf m10
-fore cyan
569 $ctext tag conf m11
-fore "#b07070"
570 $ctext tag conf m12
-fore "#70b0f0"
571 $ctext tag conf m13
-fore "#70f0b0"
572 $ctext tag conf m14
-fore "#f0b070"
573 $ctext tag conf m15
-fore "#ff70b0"
574 $ctext tag conf mmax
-fore darkgrey
576 $ctext tag conf mresult
-font [concat
$textfont bold
]
577 $ctext tag conf msep
-font [concat
$textfont bold
]
578 $ctext tag conf found
-back yellow
580 frame .ctop.cdet.right
581 frame .ctop.cdet.right.mode
582 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
583 -command reselectline
-variable cmitmode
-value "patch"
584 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
585 -command reselectline
-variable cmitmode
-value "tree"
586 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
587 pack .ctop.cdet.right.mode
-side top
-fill x
588 set cflist .ctop.cdet.right.cfiles
589 set indent
[font measure
$mainfont "nn"]
590 text
$cflist -width $geometry(cflistw
) -background white
-font $mainfont \
591 -tabs [list
$indent [expr {2 * $indent}]] \
592 -yscrollcommand ".ctop.cdet.right.sb set" \
593 -cursor [. cget
-cursor] \
594 -spacing1 1 -spacing3 1
595 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
596 pack .ctop.cdet.right.sb
-side right
-fill y
597 pack
$cflist -side left
-fill both
-expand 1
598 $cflist tag configure highlight \
599 -background [$cflist cget
-selectbackground]
600 $cflist tag configure bold
-font [concat
$mainfont bold
]
601 .ctop.cdet add .ctop.cdet.right
602 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
604 pack .ctop
-side top
-fill both
-expand 1
606 bindall
<1> {selcanvline
%W
%x
%y
}
607 #bindall <B1-Motion> {selcanvline %W %x %y}
608 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
609 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
610 bindall
<2> "canvscan mark %W %x %y"
611 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
612 bindkey
<Home
> selfirstline
613 bindkey
<End
> sellastline
614 bind .
<Key-Up
> "selnextline -1"
615 bind .
<Key-Down
> "selnextline 1"
616 bindkey
<Key-Right
> "goforw"
617 bindkey
<Key-Left
> "goback"
618 bind .
<Key-Prior
> "selnextpage -1"
619 bind .
<Key-Next
> "selnextpage 1"
620 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
621 bind .
<Control-End
> "allcanvs yview moveto 1.0"
622 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
623 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
624 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
625 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
626 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
627 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
628 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
629 bindkey p
"selnextline -1"
630 bindkey n
"selnextline 1"
633 bindkey i
"selnextline -1"
634 bindkey k
"selnextline 1"
637 bindkey b
"$ctext yview scroll -1 pages"
638 bindkey d
"$ctext yview scroll 18 units"
639 bindkey u
"$ctext yview scroll -18 units"
640 bindkey
/ {findnext
1}
641 bindkey
<Key-Return
> {findnext
0}
644 bind .
<Control-q
> doquit
645 bind .
<Control-f
> dofind
646 bind .
<Control-g
> {findnext
0}
647 bind .
<Control-r
> findprev
648 bind .
<Control-equal
> {incrfont
1}
649 bind .
<Control-KP_Add
> {incrfont
1}
650 bind .
<Control-minus
> {incrfont
-1}
651 bind .
<Control-KP_Subtract
> {incrfont
-1}
652 bind .
<Destroy
> {savestuff
%W
}
653 bind .
<Button-1
> "click %W"
654 bind $fstring <Key-Return
> dofind
655 bind $sha1entry <Key-Return
> gotocommit
656 bind $sha1entry <<PasteSelection>> clearsha1
657 bind $cflist <1> {sel_flist %W %x %y; break}
658 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
659 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
661 set maincursor [. cget -cursor]
662 set textcursor [$ctext cget -cursor]
663 set curtextcursor $textcursor
665 set rowctxmenu .rowctxmenu
666 menu $rowctxmenu -tearoff 0
667 $rowctxmenu add command -label "Diff this -> selected" \
668 -command {diffvssel 0}
669 $rowctxmenu add command -label "Diff selected -> this" \
670 -command {diffvssel 1}
671 $rowctxmenu add command -label "Make patch" -command mkpatch
672 $rowctxmenu add command -label "Create tag" -command mktag
673 $rowctxmenu add command -label "Write commit to file" -command writecommit
676 # mouse-2 makes all windows scan vertically, but only the one
677 # the cursor is in scans horizontally
678 proc canvscan {op w x y} {
679 global canv canv2 canv3
680 foreach c [list $canv $canv2 $canv3] {
689 proc scrollcanv {cscroll f0 f1} {
695 # when we make a key binding for the toplevel, make sure
696 # it doesn't get triggered when that key is pressed in the
697 # find string entry widget.
698 proc bindkey {ev script} {
701 set escript [bind Entry $ev]
702 if {$escript == {}} {
703 set escript [bind Entry <Key>]
706 bind $e $ev "$escript; break"
710 # set the focus back to the toplevel for any click outside
721 global canv canv2 canv3 ctext cflist mainfont textfont uifont
722 global stuffsaved findmergefiles maxgraphpct
724 global viewname viewfiles viewargs viewperm nextviewnum
727 if {$stuffsaved} return
728 if {![winfo viewable .]} return
730 set f [open "~/.gitk-new" w]
731 puts $f [list set mainfont $mainfont]
732 puts $f [list set textfont $textfont]
733 puts $f [list set uifont $uifont]
734 puts $f [list set findmergefiles $findmergefiles]
735 puts $f [list set maxgraphpct $maxgraphpct]
736 puts $f [list set maxwidth $maxwidth]
737 puts $f [list set cmitmode $cmitmode]
738 puts $f "set geometry(width) [winfo width .ctop]"
739 puts $f "set geometry(height) [winfo height .ctop]"
740 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
741 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
742 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
743 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
744 set wid [expr {([winfo width $ctext] - 8) \
745 / [font measure $textfont "0"]}]
746 puts $f "set geometry(ctextw) $wid"
747 set wid [expr {([winfo width $cflist] - 11) \
748 / [font measure [$cflist cget -font] "0"]}]
749 puts $f "set geometry(cflistw) $wid"
750 puts -nonewline $f "set permviews {"
751 for {set v 0} {$v < $nextviewnum} {incr v} {
753 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
758 file rename -force "~/.gitk-new" "~/.gitk"
763 proc resizeclistpanes {win w} {
765 if {[info exists oldwidth($win)]} {
766 set s0 [$win sash coord 0]
767 set s1 [$win sash coord 1]
769 set sash0 [expr {int($w/2 - 2)}]
770 set sash1 [expr {int($w*5/6 - 2)}]
772 set factor [expr {1.0 * $w / $oldwidth($win)}]
773 set sash0 [expr {int($factor * [lindex $s0 0])}]
774 set sash1 [expr {int($factor * [lindex $s1 0])}]
778 if {$sash1 < $sash0 + 20} {
779 set sash1 [expr {$sash0 + 20}]
781 if {$sash1 > $w - 10} {
782 set sash1 [expr {$w - 10}]
783 if {$sash0 > $sash1 - 20} {
784 set sash0 [expr {$sash1 - 20}]
788 $win sash place 0 $sash0 [lindex $s0 1]
789 $win sash place 1 $sash1 [lindex $s1 1]
791 set oldwidth($win) $w
794 proc resizecdetpanes {win w} {
796 if {[info exists oldwidth($win)]} {
797 set s0 [$win sash coord 0]
799 set sash0 [expr {int($w*3/4 - 2)}]
801 set factor [expr {1.0 * $w / $oldwidth($win)}]
802 set sash0 [expr {int($factor * [lindex $s0 0])}]
806 if {$sash0 > $w - 15} {
807 set sash0 [expr {$w - 15}]
810 $win sash place 0 $sash0 [lindex $s0 1]
812 set oldwidth($win) $w
816 global canv canv2 canv3
822 proc bindall {event action} {
823 global canv canv2 canv3
824 bind $canv $event $action
825 bind $canv2 $event $action
826 bind $canv3 $event $action
831 if {[winfo exists $w]} {
836 wm title $w "About gitk"
838 Gitk - a commit viewer for git
840 Copyright © 2005-2006 Paul Mackerras
842 Use and redistribute under the terms of the GNU General Public License} \
843 -justify center -aspect 400
844 pack $w.m -side top -fill x -padx 20 -pady 20
845 button $w.ok -text Close -command "destroy $w"
846 pack $w.ok -side bottom
851 if {[winfo exists $w]} {
856 wm title $w "Gitk key bindings"
861 <Home> Move to first commit
862 <End> Move to last commit
863 <Up>, p, i Move up one commit
864 <Down>, n, k Move down one commit
865 <Left>, z, j Go back in history list
866 <Right>, x, l Go forward in history list
867 <PageUp> Move up one page in commit list
868 <PageDown> Move down one page in commit list
869 <Ctrl-Home> Scroll to top of commit list
870 <Ctrl-End> Scroll to bottom of commit list
871 <Ctrl-Up> Scroll commit list up one line
872 <Ctrl-Down> Scroll commit list down one line
873 <Ctrl-PageUp> Scroll commit list up one page
874 <Ctrl-PageDown> Scroll commit list down one page
875 <Delete>, b Scroll diff view up one page
876 <Backspace> Scroll diff view up one page
877 <Space> Scroll diff view down one page
878 u Scroll diff view up 18 lines
879 d Scroll diff view down 18 lines
881 <Ctrl-G> Move to next find hit
882 <Ctrl-R> Move to previous find hit
883 <Return> Move to next find hit
884 / Move to next find hit, or redo find
885 ? Move to previous find hit
886 f Scroll diff view to next file
887 <Ctrl-KP+> Increase font size
888 <Ctrl-plus> Increase font size
889 <Ctrl-KP-> Decrease font size
890 <Ctrl-minus> Decrease font size
892 -justify left -bg white -border 2 -relief sunken
893 pack $w.m -side top -fill both
894 button $w.ok -text Close -command "destroy $w"
895 pack $w.ok -side bottom
898 # Procedures for manipulating the file list window at the
899 # bottom right of the overall window.
901 proc treeview {w l openlevs} {
902 global treecontents treediropen treeheight treeparent treeindex
912 set treecontents() {}
913 $w conf -state normal
915 while {[string range $f 0 $prefixend] ne $prefix} {
916 if {$lev <= $openlevs} {
917 $w mark set e:$treeindex($prefix) "end -1c"
918 $w mark gravity e:$treeindex($prefix) left
920 set treeheight($prefix) $ht
921 incr ht [lindex $htstack end]
922 set htstack [lreplace $htstack end end]
923 set prefixend [lindex $prefendstack end]
924 set prefendstack [lreplace $prefendstack end end]
925 set prefix [string range $prefix 0 $prefixend]
928 set tail [string range $f [expr {$prefixend+1}] end]
929 while {[set slash [string first "/" $tail]] >= 0} {
932 lappend prefendstack $prefixend
933 incr prefixend [expr {$slash + 1}]
934 set d [string range $tail 0 $slash]
935 lappend treecontents($prefix) $d
936 set oldprefix $prefix
938 set treecontents($prefix) {}
939 set treeindex($prefix) [incr ix]
940 set treeparent($prefix) $oldprefix
941 set tail [string range $tail [expr {$slash+1}] end]
942 if {$lev <= $openlevs} {
944 set treediropen($prefix) [expr {$lev < $openlevs}]
945 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
946 $w mark set d:$ix "end -1c"
947 $w mark gravity d:$ix left
949 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
951 $w image create end -align center -image $bm -padx 1 \
954 $w mark set s:$ix "end -1c"
955 $w mark gravity s:$ix left
960 if {$lev <= $openlevs} {
963 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
967 lappend treecontents($prefix) $tail
970 while {$htstack ne {}} {
971 set treeheight($prefix) $ht
972 incr ht [lindex $htstack end]
973 set htstack [lreplace $htstack end end]
975 $w conf -state disabled
979 global treeheight treecontents
984 foreach e $treecontents($prefix) {
989 if {[string index $e end] eq "/"} {
990 set n $treeheight($prefix$e)
1002 proc treeclosedir {w dir} {
1003 global treediropen treeheight treeparent treeindex
1005 set ix $treeindex($dir)
1006 $w conf -state normal
1007 $w delete s:$ix e:$ix
1008 set treediropen($dir) 0
1009 $w image configure a:$ix -image tri-rt
1010 $w conf -state disabled
1011 set n [expr {1 - $treeheight($dir)}]
1012 while {$dir ne {}} {
1013 incr treeheight($dir) $n
1014 set dir $treeparent($dir)
1018 proc treeopendir {w dir} {
1019 global treediropen treeheight treeparent treecontents treeindex
1021 set ix $treeindex($dir)
1022 $w conf -state normal
1023 $w image configure a:$ix -image tri-dn
1024 $w mark set e:$ix s:$ix
1025 $w mark gravity e:$ix right
1028 set n [llength $treecontents($dir)]
1029 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1032 incr treeheight($x) $n
1034 foreach e $treecontents($dir) {
1035 if {[string index $e end] eq "/"} {
1037 set iy $treeindex($de)
1038 $w mark set d:$iy e:$ix
1039 $w mark gravity d:$iy left
1040 $w insert e:$ix $str
1041 set treediropen($de) 0
1042 $w image create e:$ix -align center -image tri-rt -padx 1 \
1045 $w mark set s:$iy e:$ix
1046 $w mark gravity s:$iy left
1047 set treeheight($de) 1
1049 $w insert e:$ix $str
1053 $w mark gravity e:$ix left
1054 $w conf -state disabled
1055 set treediropen($dir) 1
1056 set top [lindex [split [$w index @0,0] .] 0]
1057 set ht [$w cget -height]
1058 set l [lindex [split [$w index s:$ix] .] 0]
1061 } elseif {$l + $n + 1 > $top + $ht} {
1062 set top [expr {$l + $n + 2 - $ht}]
1070 proc treeclick {w x y} {
1071 global treediropen cmitmode ctext cflist cflist_top
1073 if {$cmitmode ne "tree"} return
1074 if {![info exists cflist_top]} return
1075 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1076 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1077 $cflist tag add highlight $l.0 "$l.0 lineend"
1083 set e [linetoelt $l]
1084 if {[string index $e end] ne "/"} {
1086 } elseif {$treediropen($e)} {
1093 proc setfilelist {id} {
1094 global treefilelist cflist
1096 treeview $cflist $treefilelist($id) 0
1099 image create bitmap tri-rt -background black -foreground blue -data {
1100 #define tri-rt_width 13
1101 #define tri-rt_height 13
1102 static unsigned char tri-rt_bits[] = {
1103 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1104 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1107 #define tri-rt-mask_width 13
1108 #define tri-rt-mask_height 13
1109 static unsigned char tri-rt-mask_bits[] = {
1110 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1111 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1114 image create bitmap tri-dn -background black -foreground blue -data {
1115 #define tri-dn_width 13
1116 #define tri-dn_height 13
1117 static unsigned char tri-dn_bits[] = {
1118 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1119 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1122 #define tri-dn-mask_width 13
1123 #define tri-dn-mask_height 13
1124 static unsigned char tri-dn-mask_bits[] = {
1125 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1126 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1130 proc init_flist {first} {
1131 global cflist cflist_top selectedline difffilestart
1133 $cflist conf -state normal
1134 $cflist delete 0.0 end
1136 $cflist insert end $first
1138 $cflist tag add highlight 1.0 "1.0 lineend"
1140 catch {unset cflist_top}
1142 $cflist conf -state disabled
1143 set difffilestart {}
1146 proc highlight_tag {f} {
1147 global highlight_paths
1149 foreach p $highlight_paths {
1150 if {[string match $p $f]} {
1157 proc highlight_filelist {} {
1158 global flistmode cflist
1160 global highlight_paths
1161 if {$flistmode eq "flat"} {
1162 $cflist conf -state normal
1163 set end [lindex [split [$cflist index end] .] 0]
1164 for {set l 2} {$l < $end} {incr l} {
1165 set line [$cflist get $l.0 "$l.0 lineend"]
1166 if {[highlight_tag $line] ne {}} {
1167 $cflist tag add bold $l.0 "$l.0 lineend"
1170 $cflist conf -state disabled
1174 proc unhighlight_filelist {} {
1175 global flistmode cflist
1177 if {$flistmode eq "flat"} {
1178 $cflist conf -state normal
1179 $cflist tag remove bold 1.0 end
1180 $cflist conf -state disabled
1184 proc add_flist {fl} {
1185 global flistmode cflist
1187 if {$flistmode eq "flat"} {
1188 $cflist conf -state normal
1190 $cflist insert end "\n"
1191 $cflist insert end $f [highlight_tag $f]
1193 $cflist conf -state disabled
1197 proc sel_flist {w x y} {
1198 global flistmode ctext difffilestart cflist cflist_top cmitmode
1200 if {$cmitmode eq "tree"} return
1201 if {![info exists cflist_top]} return
1202 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1203 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1204 $cflist tag add highlight $l.0 "$l.0 lineend"
1209 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1213 # Functions for adding and removing shell-type quoting
1215 proc shellquote {str} {
1216 if {![string match "*\['\"\\ \t]*" $str]} {
1219 if {![string match "*\['\"\\]*" $str]} {
1222 if {![string match "*'*" $str]} {
1225 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1228 proc shellarglist {l} {
1234 append str [shellquote $a]
1239 proc shelldequote {str} {
1244 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1245 append ret [string range $str $used end]
1246 set used [string length $str]
1249 set first [lindex $first 0]
1250 set ch [string index $str $first]
1251 if {$first > $used} {
1252 append ret [string range $str $used [expr {$first - 1}]]
1255 if {$ch eq " " || $ch eq "\t"} break
1258 set first [string first "'" $str $used]
1260 error "unmatched single-quote"
1262 append ret [string range $str $used [expr {$first - 1}]]
1267 if {$used >= [string length $str]} {
1268 error "trailing backslash"
1270 append ret [string index $str $used]
1275 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1276 error "unmatched double-quote"
1278 set first [lindex $first 0]
1279 set ch [string index $str $first]
1280 if {$first > $used} {
1281 append ret [string range $str $used [expr {$first - 1}]]
1284 if {$ch eq "\""} break
1286 append ret [string index $str $used]
1290 return [list $used $ret]
1293 proc shellsplit {str} {
1296 set str [string trimleft $str]
1297 if {$str eq {}} break
1298 set dq [shelldequote $str]
1299 set n [lindex $dq 0]
1300 set word [lindex $dq 1]
1301 set str [string range $str $n end]
1307 # Code to implement multiple views
1309 proc newview {ishighlight} {
1310 global nextviewnum newviewname newviewperm uifont newishighlight
1311 global newviewargs revtreeargs
1313 set newishighlight $ishighlight
1315 if {[winfo exists $top]} {
1319 set newviewname($nextviewnum) "View $nextviewnum"
1320 set newviewperm($nextviewnum) 0
1321 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1322 vieweditor $top $nextviewnum "Gitk view definition"
1327 global viewname viewperm newviewname newviewperm
1328 global viewargs newviewargs
1330 set top .gitkvedit-$curview
1331 if {[winfo exists $top]} {
1335 set newviewname($curview) $viewname($curview)
1336 set newviewperm($curview) $viewperm($curview)
1337 set newviewargs($curview) [shellarglist $viewargs($curview)]
1338 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1341 proc vieweditor {top n title} {
1342 global newviewname newviewperm viewfiles
1346 wm title $top $title
1347 label $top.nl -text "Name" -font $uifont
1348 entry $top.name -width 20 -textvariable newviewname($n)
1349 grid $top.nl $top.name -sticky w -pady 5
1350 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1351 grid $top.perm - -pady 5 -sticky w
1352 message $top.al -aspect 1000 -font $uifont \
1353 -text "Commits to include (arguments to git-rev-list):"
1354 grid $top.al - -sticky w -pady 5
1355 entry $top.args -width 50 -textvariable newviewargs($n) \
1357 grid $top.args - -sticky ew -padx 5
1358 message $top.l -aspect 1000 -font $uifont \
1359 -text "Enter files and directories to include, one per line:"
1360 grid $top.l - -sticky w
1361 text $top.t -width 40 -height 10 -background white
1362 if {[info exists viewfiles($n)]} {
1363 foreach f $viewfiles($n) {
1364 $top.t insert end $f
1365 $top.t insert end "\n"
1367 $top.t delete {end - 1c} end
1368 $top.t mark set insert 0.0
1370 grid $top.t - -sticky ew -padx 5
1372 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1373 button $top.buts.can -text "Cancel" -command [list destroy $top]
1374 grid $top.buts.ok $top.buts.can
1375 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1376 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1377 grid $top.buts - -pady 10 -sticky ew
1381 proc doviewmenu {m first cmd op argv} {
1382 set nmenu [$m index end]
1383 for {set i $first} {$i <= $nmenu} {incr i} {
1384 if {[$m entrycget $i -command] eq $cmd} {
1385 eval $m $op $i $argv
1391 proc allviewmenus {n op args} {
1394 doviewmenu .bar.view 7 [list showview $n] $op $args
1395 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1398 proc newviewok {top n} {
1399 global nextviewnum newviewperm newviewname newishighlight
1400 global viewname viewfiles viewperm selectedview curview
1401 global viewargs newviewargs viewhlmenu
1404 set newargs [shellsplit $newviewargs($n)]
1406 error_popup "Error in commit selection arguments: $err"
1412 foreach f [split [$top.t get 0.0 end] "\n"] {
1413 set ft [string trim $f]
1418 if {![info exists viewfiles($n)]} {
1419 # creating a new view
1421 set viewname($n) $newviewname($n)
1422 set viewperm($n) $newviewperm($n)
1423 set viewfiles($n) $files
1424 set viewargs($n) $newargs
1426 if {!$newishighlight} {
1427 after idle showview $n
1429 after idle addvhighlight $n
1432 # editing an existing view
1433 set viewperm($n) $newviewperm($n)
1434 if {$newviewname($n) ne $viewname($n)} {
1435 set viewname($n) $newviewname($n)
1436 doviewmenu .bar.view 7 [list showview $n] \
1437 entryconf [list -label $viewname($n)]
1438 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1439 entryconf [list -label $viewname($n) -value $viewname($n)]
1441 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1442 set viewfiles($n) $files
1443 set viewargs($n) $newargs
1444 if {$curview == $n} {
1445 after idle updatecommits
1449 catch {destroy $top}
1453 global curview viewdata viewperm hlview selectedhlview
1455 if {$curview == 0} return
1456 if {[info exists hlview] && $hlview == $curview} {
1457 set selectedhlview None
1460 allviewmenus $curview delete
1461 set viewdata($curview) {}
1462 set viewperm($curview) 0
1466 proc addviewmenu {n} {
1467 global viewname viewhlmenu
1469 .bar.view add radiobutton -label $viewname($n) \
1470 -command [list showview $n] -variable selectedview -value $n
1471 $viewhlmenu add radiobutton -label $viewname($n) \
1472 -command [list addvhighlight $n] -variable selectedhlview
1475 proc flatten {var} {
1479 foreach i [array names $var] {
1480 lappend ret $i [set $var\($i\)]
1485 proc unflatten {var l} {
1495 global curview viewdata viewfiles
1496 global displayorder parentlist childlist rowidlist rowoffsets
1497 global colormap rowtextx commitrow nextcolor canvxmax
1498 global numcommits rowrangelist commitlisted idrowranges
1499 global selectedline currentid canv canvy0
1500 global matchinglines treediffs
1501 global pending_select phase
1502 global commitidx rowlaidout rowoptim linesegends
1503 global commfd nextupdate
1505 global vparentlist vchildlist vdisporder vcmitlisted
1506 global hlview selectedhlview
1508 if {$n == $curview} return
1510 if {[info exists selectedline]} {
1511 set selid $currentid
1512 set y [yc $selectedline]
1513 set ymax [lindex [$canv cget -scrollregion] 3]
1514 set span [$canv yview]
1515 set ytop [expr {[lindex $span 0] * $ymax}]
1516 set ybot [expr {[lindex $span 1] * $ymax}]
1517 if {$ytop < $y && $y < $ybot} {
1518 set yscreen [expr {$y - $ytop}]
1520 set yscreen [expr {($ybot - $ytop) / 2}]
1526 if {$curview >= 0} {
1527 set vparentlist($curview) $parentlist
1528 set vchildlist($curview) $childlist
1529 set vdisporder($curview) $displayorder
1530 set vcmitlisted($curview) $commitlisted
1532 set viewdata($curview) \
1533 [list $phase $rowidlist $rowoffsets $rowrangelist \
1534 [flatten idrowranges] [flatten idinlist] \
1535 $rowlaidout $rowoptim $numcommits $linesegends]
1536 } elseif {![info exists viewdata($curview)]
1537 || [lindex $viewdata($curview) 0] ne {}} {
1538 set viewdata($curview) \
1539 [list {} $rowidlist $rowoffsets $rowrangelist]
1542 catch {unset matchinglines}
1543 catch {unset treediffs}
1545 if {[info exists hlview] && $hlview == $n} {
1547 set selectedhlview None
1552 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1553 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1555 if {![info exists viewdata($n)]} {
1556 set pending_select $selid
1562 set phase [lindex $v 0]
1563 set displayorder $vdisporder($n)
1564 set parentlist $vparentlist($n)
1565 set childlist $vchildlist($n)
1566 set commitlisted $vcmitlisted($n)
1567 set rowidlist [lindex $v 1]
1568 set rowoffsets [lindex $v 2]
1569 set rowrangelist [lindex $v 3]
1571 set numcommits [llength $displayorder]
1572 catch {unset idrowranges}
1574 unflatten idrowranges [lindex $v 4]
1575 unflatten idinlist [lindex $v 5]
1576 set rowlaidout [lindex $v 6]
1577 set rowoptim [lindex $v 7]
1578 set numcommits [lindex $v 8]
1579 set linesegends [lindex $v 9]
1582 catch {unset colormap}
1583 catch {unset rowtextx}
1585 set canvxmax [$canv cget -width]
1591 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1592 set row $commitrow($n,$selid)
1593 # try to get the selected row in the same position on the screen
1594 set ymax [lindex [$canv cget -scrollregion] 3]
1595 set ytop [expr {[yc $row] - $yscreen}]
1599 set yf [expr {$ytop * 1.0 / $ymax}]
1601 allcanvs yview moveto $yf
1605 if {$phase eq "getcommits"} {
1606 show_status "Reading commits..."
1608 if {[info exists commfd($n)]} {
1613 } elseif {$numcommits == 0} {
1614 show_status "No commits selected"
1618 # Stuff relating to the highlighting facility
1620 proc ishighlighted {row} {
1621 global vhighlights fhighlights nhighlights
1623 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1624 return $nhighlights($row)
1626 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1627 return $vhighlights($row)
1629 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1630 return $fhighlights($row)
1635 proc bolden {row font} {
1636 global canv linehtag selectedline
1638 $canv itemconf $linehtag($row) -font $font
1639 if {$row == $selectedline} {
1641 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1642 -outline {{}} -tags secsel \
1643 -fill [$canv cget -selectbackground]]
1648 proc bolden_name {row font} {
1649 global canv2 linentag selectedline
1651 $canv2 itemconf $linentag($row) -font $font
1652 if {$row == $selectedline} {
1653 $canv2 delete secsel
1654 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1655 -outline {{}} -tags secsel \
1656 -fill [$canv2 cget -selectbackground]]
1661 proc unbolden {rows} {
1665 if {![ishighlighted $row]} {
1666 bolden $row $mainfont
1671 proc addvhighlight {n} {
1672 global hlview curview viewdata vhl_done vhighlights commitidx
1674 if {[info exists hlview]} {
1678 if {$n != $curview && ![info exists viewdata($n)]} {
1679 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1680 set vparentlist($n) {}
1681 set vchildlist($n) {}
1682 set vdisporder($n) {}
1683 set vcmitlisted($n) {}
1686 set vhl_done $commitidx($hlview)
1687 if {$vhl_done > 0} {
1692 proc delvhighlight {} {
1693 global hlview vhighlights
1696 if {![info exists hlview]} return
1698 set rows [array names vhighlights]
1705 proc vhighlightmore {} {
1706 global hlview vhl_done commitidx vhighlights
1707 global displayorder vdisporder curview mainfont
1709 set font [concat $mainfont bold]
1710 set max $commitidx($hlview)
1711 if {$hlview == $curview} {
1712 set disp $displayorder
1714 set disp $vdisporder($hlview)
1716 set vr [visiblerows]
1717 set r0 [lindex $vr 0]
1718 set r1 [lindex $vr 1]
1719 for {set i $vhl_done} {$i < $max} {incr i} {
1720 set id [lindex $disp $i]
1721 if {[info exists commitrow($curview,$id)]} {
1722 set row $commitrow($curview,$id)
1723 if {$r0 <= $row && $row <= $r1} {
1724 if {![highlighted $row]} {
1727 set vhighlights($row) 1
1734 proc askvhighlight {row id} {
1735 global hlview vhighlights commitrow iddrawn mainfont
1737 if {[info exists commitrow($hlview,$id)]} {
1738 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1739 bolden $row [concat $mainfont bold]
1741 set vhighlights($row) 1
1743 set vhighlights($row) 0
1747 proc hfiles_change {name ix op} {
1748 global highlight_files filehighlight fhighlights fh_serial
1749 global mainfont highlight_paths
1751 if {[info exists filehighlight]} {
1752 # delete previous highlights
1753 catch {close $filehighlight}
1755 set rows [array names fhighlights]
1760 unhighlight_filelist
1762 set highlight_paths {}
1763 after cancel do_file_hl $fh_serial
1765 if {$highlight_files ne {}} {
1766 after 300 do_file_hl $fh_serial
1770 proc makepatterns {l} {
1773 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1774 if {[string index $ee end] eq "/"} {
1784 proc do_file_hl {serial} {
1785 global highlight_files filehighlight highlight_paths
1787 if {[catch {set paths [shellsplit $highlight_files]}]} return
1788 set highlight_paths [makepatterns $paths]
1790 set cmd [concat | git-diff-tree -r -s --stdin -- $paths]
1791 set filehighlight [open $cmd r+]
1792 fconfigure $filehighlight -blocking 0
1793 fileevent $filehighlight readable readfhighlight
1798 proc flushhighlights {} {
1799 global filehighlight
1801 if {[info exists filehighlight]} {
1802 puts $filehighlight ""
1803 flush $filehighlight
1807 proc askfilehighlight {row id} {
1808 global filehighlight fhighlights
1810 set fhighlights($row) 0
1811 puts $filehighlight $id
1814 proc readfhighlight {} {
1815 global filehighlight fhighlights commitrow curview mainfont iddrawn
1817 set n [gets $filehighlight line]
1819 if {[eof $filehighlight]} {
1821 puts "oops, git-diff-tree died"
1822 catch {close $filehighlight}
1827 set line [string trim $line]
1828 if {$line eq {}} return
1829 if {![info exists commitrow($curview,$line)]} return
1830 set row $commitrow($curview,$line)
1831 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1832 bolden $row [concat $mainfont bold]
1834 set fhighlights($row) 1
1837 proc hnames_change {name ix op} {
1838 global highlight_names nhighlights nhl_names mainfont
1840 # delete previous highlights, if any
1841 set rows [array names nhighlights]
1844 if {$nhighlights($row) >= 2} {
1845 bolden_name $row $mainfont
1851 if {[catch {set nhl_names [shellsplit $highlight_names]}]} {
1858 proc asknamehighlight {row id} {
1859 global nhl_names nhighlights commitinfo iddrawn mainfont
1861 if {![info exists commitinfo($id)]} {
1865 set author [lindex $commitinfo($id) 1]
1866 set committer [lindex $commitinfo($id) 3]
1867 foreach name $nhl_names {
1868 set pattern "*$name*"
1869 if {[string match -nocase $pattern $author]} {
1873 if {!$isbold && [string match -nocase $pattern $committer]} {
1877 if {[info exists iddrawn($id)]} {
1878 if {$isbold && ![ishighlighted $row]} {
1879 bolden $row [concat $mainfont bold]
1882 bolden_name $row [concat $mainfont bold]
1885 set nhighlights($row) $isbold
1888 # Graph layout functions
1890 proc shortids {ids} {
1893 if {[llength $id] > 1} {
1894 lappend res [shortids $id]
1895 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1896 lappend res [string range $id 0 7]
1904 proc incrange {l x o} {
1907 set e [lindex $l $x]
1909 lset l $x [expr {$e + $o}]
1918 for {} {$n > 0} {incr n -1} {
1924 proc usedinrange {id l1 l2} {
1925 global children commitrow childlist curview
1927 if {[info exists commitrow($curview,$id)]} {
1928 set r $commitrow($curview,$id)
1929 if {$l1 <= $r && $r <= $l2} {
1930 return [expr {$r - $l1 + 1}]
1932 set kids [lindex $childlist $r]
1934 set kids $children($curview,$id)
1937 set r $commitrow($curview,$c)
1938 if {$l1 <= $r && $r <= $l2} {
1939 return [expr {$r - $l1 + 1}]
1945 proc sanity {row {full 0}} {
1946 global rowidlist rowoffsets
1949 set ids [lindex $rowidlist $row]
1952 if {$id eq {}} continue
1953 if {$col < [llength $ids] - 1 &&
1954 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1955 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1957 set o [lindex $rowoffsets $row $col]
1963 if {[lindex $rowidlist $y $x] != $id} {
1964 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1965 puts " id=[shortids $id] check started at row $row"
1966 for {set i $row} {$i >= $y} {incr i -1} {
1967 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1972 set o [lindex $rowoffsets $y $x]
1977 proc makeuparrow {oid x y z} {
1978 global rowidlist rowoffsets uparrowlen idrowranges
1980 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1983 set off0 [lindex $rowoffsets $y]
1984 for {set x0 $x} {1} {incr x0} {
1985 if {$x0 >= [llength $off0]} {
1986 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1989 set z [lindex $off0 $x0]
1995 set z [expr {$x0 - $x}]
1996 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1997 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1999 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2000 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2001 lappend idrowranges($oid) $y
2004 proc initlayout {} {
2005 global rowidlist rowoffsets displayorder commitlisted
2006 global rowlaidout rowoptim
2007 global idinlist rowchk rowrangelist idrowranges
2008 global numcommits canvxmax canv
2010 global parentlist childlist children
2011 global colormap rowtextx
2023 catch {unset idinlist}
2024 catch {unset rowchk}
2027 set canvxmax [$canv cget -width]
2028 catch {unset colormap}
2029 catch {unset rowtextx}
2030 catch {unset idrowranges}
2034 proc setcanvscroll {} {
2035 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2037 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2038 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2039 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2040 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2043 proc visiblerows {} {
2044 global canv numcommits linespc
2046 set ymax [lindex [$canv cget -scrollregion] 3]
2047 if {$ymax eq {} || $ymax == 0} return
2049 set y0 [expr {int([lindex $f 0] * $ymax)}]
2050 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2054 set y1 [expr {int([lindex $f 1] * $ymax)}]
2055 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2056 if {$r1 >= $numcommits} {
2057 set r1 [expr {$numcommits - 1}]
2059 return [list $r0 $r1]
2062 proc layoutmore {} {
2063 global rowlaidout rowoptim commitidx numcommits optim_delay
2064 global uparrowlen curview
2067 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2068 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2069 if {$orow > $rowoptim} {
2070 optimize_rows $rowoptim 0 $orow
2073 set canshow [expr {$rowoptim - $optim_delay}]
2074 if {$canshow > $numcommits} {
2079 proc showstuff {canshow} {
2080 global numcommits commitrow pending_select selectedline
2081 global linesegends idrowranges idrangedrawn curview
2083 if {$numcommits == 0} {
2085 set phase "incrdraw"
2089 set numcommits $canshow
2091 set rows [visiblerows]
2092 set r0 [lindex $rows 0]
2093 set r1 [lindex $rows 1]
2095 for {set r $row} {$r < $canshow} {incr r} {
2096 foreach id [lindex $linesegends [expr {$r+1}]] {
2098 foreach {s e} [rowranges $id] {
2100 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2101 && ![info exists idrangedrawn($id,$i)]} {
2103 set idrangedrawn($id,$i) 1
2108 if {$canshow > $r1} {
2111 while {$row < $canshow} {
2115 if {[info exists pending_select] &&
2116 [info exists commitrow($curview,$pending_select)] &&
2117 $commitrow($curview,$pending_select) < $numcommits} {
2118 selectline $commitrow($curview,$pending_select) 1
2120 if {![info exists selectedline] && ![info exists pending_select]} {
2125 proc layoutrows {row endrow last} {
2126 global rowidlist rowoffsets displayorder
2127 global uparrowlen downarrowlen maxwidth mingaplen
2128 global childlist parentlist
2129 global idrowranges linesegends
2130 global commitidx curview
2131 global idinlist rowchk rowrangelist
2133 set idlist [lindex $rowidlist $row]
2134 set offs [lindex $rowoffsets $row]
2135 while {$row < $endrow} {
2136 set id [lindex $displayorder $row]
2139 foreach p [lindex $parentlist $row] {
2140 if {![info exists idinlist($p)]} {
2142 } elseif {!$idinlist($p)} {
2147 set nev [expr {[llength $idlist] + [llength $newolds]
2148 + [llength $oldolds] - $maxwidth + 1}]
2151 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2152 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2153 set i [lindex $idlist $x]
2154 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2155 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2156 [expr {$row + $uparrowlen + $mingaplen}]]
2158 set idlist [lreplace $idlist $x $x]
2159 set offs [lreplace $offs $x $x]
2160 set offs [incrange $offs $x 1]
2162 set rm1 [expr {$row - 1}]
2164 lappend idrowranges($i) $rm1
2165 if {[incr nev -1] <= 0} break
2168 set rowchk($id) [expr {$row + $r}]
2171 lset rowidlist $row $idlist
2172 lset rowoffsets $row $offs
2174 lappend linesegends $lse
2175 set col [lsearch -exact $idlist $id]
2177 set col [llength $idlist]
2179 lset rowidlist $row $idlist
2181 if {[lindex $childlist $row] ne {}} {
2182 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2186 lset rowoffsets $row $offs
2188 makeuparrow $id $col $row $z
2194 if {[info exists idrowranges($id)]} {
2195 set ranges $idrowranges($id)
2197 unset idrowranges($id)
2199 lappend rowrangelist $ranges
2201 set offs [ntimes [llength $idlist] 0]
2202 set l [llength $newolds]
2203 set idlist [eval lreplace \$idlist $col $col $newolds]
2206 set offs [lrange $offs 0 [expr {$col - 1}]]
2207 foreach x $newolds {
2212 set tmp [expr {[llength $idlist] - [llength $offs]}]
2214 set offs [concat $offs [ntimes $tmp $o]]
2219 foreach i $newolds {
2221 set idrowranges($i) $row
2224 foreach oid $oldolds {
2225 set idinlist($oid) 1
2226 set idlist [linsert $idlist $col $oid]
2227 set offs [linsert $offs $col $o]
2228 makeuparrow $oid $col $row $o
2231 lappend rowidlist $idlist
2232 lappend rowoffsets $offs
2237 proc addextraid {id row} {
2238 global displayorder commitrow commitinfo
2239 global commitidx commitlisted
2240 global parentlist childlist children curview
2242 incr commitidx($curview)
2243 lappend displayorder $id
2244 lappend commitlisted 0
2245 lappend parentlist {}
2246 set commitrow($curview,$id) $row
2248 if {![info exists commitinfo($id)]} {
2249 set commitinfo($id) {"No commit information available"}
2251 if {![info exists children($curview,$id)]} {
2252 set children($curview,$id) {}
2254 lappend childlist $children($curview,$id)
2257 proc layouttail {} {
2258 global rowidlist rowoffsets idinlist commitidx curview
2259 global idrowranges rowrangelist
2261 set row $commitidx($curview)
2262 set idlist [lindex $rowidlist $row]
2263 while {$idlist ne {}} {
2264 set col [expr {[llength $idlist] - 1}]
2265 set id [lindex $idlist $col]
2268 lappend idrowranges($id) $row
2269 lappend rowrangelist $idrowranges($id)
2270 unset idrowranges($id)
2272 set offs [ntimes $col 0]
2273 set idlist [lreplace $idlist $col $col]
2274 lappend rowidlist $idlist
2275 lappend rowoffsets $offs
2278 foreach id [array names idinlist] {
2280 lset rowidlist $row [list $id]
2281 lset rowoffsets $row 0
2282 makeuparrow $id 0 $row 0
2283 lappend idrowranges($id) $row
2284 lappend rowrangelist $idrowranges($id)
2285 unset idrowranges($id)
2287 lappend rowidlist {}
2288 lappend rowoffsets {}
2292 proc insert_pad {row col npad} {
2293 global rowidlist rowoffsets
2295 set pad [ntimes $npad {}]
2296 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2297 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2298 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2301 proc optimize_rows {row col endrow} {
2302 global rowidlist rowoffsets idrowranges displayorder
2304 for {} {$row < $endrow} {incr row} {
2305 set idlist [lindex $rowidlist $row]
2306 set offs [lindex $rowoffsets $row]
2308 for {} {$col < [llength $offs]} {incr col} {
2309 if {[lindex $idlist $col] eq {}} {
2313 set z [lindex $offs $col]
2314 if {$z eq {}} continue
2316 set x0 [expr {$col + $z}]
2317 set y0 [expr {$row - 1}]
2318 set z0 [lindex $rowoffsets $y0 $x0]
2320 set id [lindex $idlist $col]
2321 set ranges [rowranges $id]
2322 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2326 if {$z < -1 || ($z < 0 && $isarrow)} {
2327 set npad [expr {-1 - $z + $isarrow}]
2328 set offs [incrange $offs $col $npad]
2329 insert_pad $y0 $x0 $npad
2331 optimize_rows $y0 $x0 $row
2333 set z [lindex $offs $col]
2334 set x0 [expr {$col + $z}]
2335 set z0 [lindex $rowoffsets $y0 $x0]
2336 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2337 set npad [expr {$z - 1 + $isarrow}]
2338 set y1 [expr {$row + 1}]
2339 set offs2 [lindex $rowoffsets $y1]
2343 if {$z eq {} || $x1 + $z < $col} continue
2344 if {$x1 + $z > $col} {
2347 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2350 set pad [ntimes $npad {}]
2351 set idlist [eval linsert \$idlist $col $pad]
2352 set tmp [eval linsert \$offs $col $pad]
2354 set offs [incrange $tmp $col [expr {-$npad}]]
2355 set z [lindex $offs $col]
2358 if {$z0 eq {} && !$isarrow} {
2359 # this line links to its first child on row $row-2
2360 set rm2 [expr {$row - 2}]
2361 set id [lindex $displayorder $rm2]
2362 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2364 set z0 [expr {$xc - $x0}]
2367 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2368 insert_pad $y0 $x0 1
2369 set offs [incrange $offs $col 1]
2370 optimize_rows $y0 [expr {$x0 + 1}] $row
2375 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2376 set o [lindex $offs $col]
2378 # check if this is the link to the first child
2379 set id [lindex $idlist $col]
2380 set ranges [rowranges $id]
2381 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2382 # it is, work out offset to child
2383 set y0 [expr {$row - 1}]
2384 set id [lindex $displayorder $y0]
2385 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2387 set o [expr {$x0 - $col}]
2391 if {$o eq {} || $o <= 0} break
2393 if {$o ne {} && [incr col] < [llength $idlist]} {
2394 set y1 [expr {$row + 1}]
2395 set offs2 [lindex $rowoffsets $y1]
2399 if {$z eq {} || $x1 + $z < $col} continue
2400 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2403 set idlist [linsert $idlist $col {}]
2404 set tmp [linsert $offs $col {}]
2406 set offs [incrange $tmp $col -1]
2409 lset rowidlist $row $idlist
2410 lset rowoffsets $row $offs
2416 global canvx0 linespc
2417 return [expr {$canvx0 + $col * $linespc}]
2421 global canvy0 linespc
2422 return [expr {$canvy0 + $row * $linespc}]
2425 proc linewidth {id} {
2426 global thickerline lthickness
2429 if {[info exists thickerline] && $id eq $thickerline} {
2430 set wid [expr {2 * $lthickness}]
2435 proc rowranges {id} {
2436 global phase idrowranges commitrow rowlaidout rowrangelist curview
2440 ([info exists commitrow($curview,$id)]
2441 && $commitrow($curview,$id) < $rowlaidout)} {
2442 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2443 } elseif {[info exists idrowranges($id)]} {
2444 set ranges $idrowranges($id)
2449 proc drawlineseg {id i} {
2450 global rowoffsets rowidlist
2452 global canv colormap linespc
2453 global numcommits commitrow curview
2455 set ranges [rowranges $id]
2457 if {[info exists commitrow($curview,$id)]
2458 && $commitrow($curview,$id) < $numcommits} {
2459 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2463 set startrow [lindex $ranges [expr {2 * $i}]]
2464 set row [lindex $ranges [expr {2 * $i + 1}]]
2465 if {$startrow == $row} return
2468 set col [lsearch -exact [lindex $rowidlist $row] $id]
2470 puts "oops: drawline: id $id not on row $row"
2476 set o [lindex $rowoffsets $row $col]
2479 # changing direction
2480 set x [xc $row $col]
2482 lappend coords $x $y
2488 set x [xc $row $col]
2490 lappend coords $x $y
2492 # draw the link to the first child as part of this line
2494 set child [lindex $displayorder $row]
2495 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2497 set x [xc $row $ccol]
2499 if {$ccol < $col - 1} {
2500 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2501 } elseif {$ccol > $col + 1} {
2502 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2504 lappend coords $x $y
2507 if {[llength $coords] < 4} return
2509 # This line has an arrow at the lower end: check if the arrow is
2510 # on a diagonal segment, and if so, work around the Tk 8.4
2511 # refusal to draw arrows on diagonal lines.
2512 set x0 [lindex $coords 0]
2513 set x1 [lindex $coords 2]
2515 set y0 [lindex $coords 1]
2516 set y1 [lindex $coords 3]
2517 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2518 # we have a nearby vertical segment, just trim off the diag bit
2519 set coords [lrange $coords 2 end]
2521 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2522 set xi [expr {$x0 - $slope * $linespc / 2}]
2523 set yi [expr {$y0 - $linespc / 2}]
2524 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2528 set arrow [expr {2 * ($i > 0) + $downarrow}]
2529 set arrow [lindex {none first last both} $arrow]
2530 set t [$canv create line $coords -width [linewidth $id] \
2531 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2536 proc drawparentlinks {id row col olds} {
2537 global rowidlist canv colormap
2539 set row2 [expr {$row + 1}]
2540 set x [xc $row $col]
2543 set ids [lindex $rowidlist $row2]
2544 # rmx = right-most X coord used
2547 set i [lsearch -exact $ids $p]
2549 puts "oops, parent $p of $id not in list"
2552 set x2 [xc $row2 $i]
2556 set ranges [rowranges $p]
2557 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2558 && $row2 < [lindex $ranges 1]} {
2559 # drawlineseg will do this one for us
2563 # should handle duplicated parents here...
2564 set coords [list $x $y]
2565 if {$i < $col - 1} {
2566 lappend coords [xc $row [expr {$i + 1}]] $y
2567 } elseif {$i > $col + 1} {
2568 lappend coords [xc $row [expr {$i - 1}]] $y
2570 lappend coords $x2 $y2
2571 set t [$canv create line $coords -width [linewidth $p] \
2572 -fill $colormap($p) -tags lines.$p]
2579 proc drawlines {id} {
2580 global colormap canv
2582 global children iddrawn commitrow rowidlist curview
2584 $canv delete lines.$id
2585 set nr [expr {[llength [rowranges $id]] / 2}]
2586 for {set i 0} {$i < $nr} {incr i} {
2587 if {[info exists idrangedrawn($id,$i)]} {
2591 foreach child $children($curview,$id) {
2592 if {[info exists iddrawn($child)]} {
2593 set row $commitrow($curview,$child)
2594 set col [lsearch -exact [lindex $rowidlist $row] $child]
2596 drawparentlinks $child $row $col [list $id]
2602 proc drawcmittext {id row col rmx} {
2603 global linespc canv canv2 canv3 canvy0
2604 global commitlisted commitinfo rowidlist
2605 global rowtextx idpos idtags idheads idotherrefs
2606 global linehtag linentag linedtag
2607 global mainfont canvxmax
2609 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2610 set x [xc $row $col]
2612 set orad [expr {$linespc / 3}]
2613 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2614 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2615 -fill $ofill -outline black -width 1]
2617 $canv bind $t <1> {selcanvline {} %x %y}
2618 set xt [xc $row [llength [lindex $rowidlist $row]]]
2622 set rowtextx($row) $xt
2623 set idpos($id) [list $x $xt $y]
2624 if {[info exists idtags($id)] || [info exists idheads($id)]
2625 || [info exists idotherrefs($id)]} {
2626 set xt [drawtags $id $x $xt $y]
2628 set headline [lindex $commitinfo($id) 0]
2629 set name [lindex $commitinfo($id) 1]
2630 set date [lindex $commitinfo($id) 2]
2631 set date [formatdate $date]
2634 set isbold [ishighlighted $row]
2641 set linehtag($row) [$canv create text $xt $y -anchor w \
2642 -text $headline -font $font]
2643 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2644 set linentag($row) [$canv2 create text 3 $y -anchor w \
2645 -text $name -font $nfont]
2646 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2647 -text $date -font $mainfont]
2648 set xr [expr {$xt + [font measure $mainfont $headline]}]
2649 if {$xr > $canvxmax} {
2655 proc drawcmitrow {row} {
2656 global displayorder rowidlist
2657 global idrangedrawn iddrawn
2658 global commitinfo parentlist numcommits
2659 global filehighlight fhighlights nhl_names nhighlights
2660 global hlview vhighlights
2662 if {$row >= $numcommits} return
2663 foreach id [lindex $rowidlist $row] {
2664 if {$id eq {}} continue
2666 foreach {s e} [rowranges $id] {
2668 if {$row < $s} continue
2671 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2673 set idrangedrawn($id,$i) 1
2680 set id [lindex $displayorder $row]
2681 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2682 askvhighlight $row $id
2684 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2685 askfilehighlight $row $id
2687 if {$nhl_names ne {} && ![info exists nhighlights($row)]} {
2688 asknamehighlight $row $id
2690 if {[info exists iddrawn($id)]} return
2691 set col [lsearch -exact [lindex $rowidlist $row] $id]
2693 puts "oops, row $row id $id not in list"
2696 if {![info exists commitinfo($id)]} {
2700 set olds [lindex $parentlist $row]
2702 set rmx [drawparentlinks $id $row $col $olds]
2706 drawcmittext $id $row $col $rmx
2710 proc drawfrac {f0 f1} {
2711 global numcommits canv
2714 set ymax [lindex [$canv cget -scrollregion] 3]
2715 if {$ymax eq {} || $ymax == 0} return
2716 set y0 [expr {int($f0 * $ymax)}]
2717 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2721 set y1 [expr {int($f1 * $ymax)}]
2722 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2723 if {$endrow >= $numcommits} {
2724 set endrow [expr {$numcommits - 1}]
2726 for {} {$row <= $endrow} {incr row} {
2731 proc drawvisible {} {
2733 eval drawfrac [$canv yview]
2736 proc clear_display {} {
2737 global iddrawn idrangedrawn
2738 global vhighlights fhighlights nhighlights
2741 catch {unset iddrawn}
2742 catch {unset idrangedrawn}
2743 catch {unset vhighlights}
2744 catch {unset fhighlights}
2745 catch {unset nhighlights}
2748 proc findcrossings {id} {
2749 global rowidlist parentlist numcommits rowoffsets displayorder
2753 foreach {s e} [rowranges $id] {
2754 if {$e >= $numcommits} {
2755 set e [expr {$numcommits - 1}]
2757 if {$e <= $s} continue
2758 set x [lsearch -exact [lindex $rowidlist $e] $id]
2760 puts "findcrossings: oops, no [shortids $id] in row $e"
2763 for {set row $e} {[incr row -1] >= $s} {} {
2764 set olds [lindex $parentlist $row]
2765 set kid [lindex $displayorder $row]
2766 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2767 if {$kidx < 0} continue
2768 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2770 set px [lsearch -exact $nextrow $p]
2771 if {$px < 0} continue
2772 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2773 if {[lsearch -exact $ccross $p] >= 0} continue
2774 if {$x == $px + ($kidx < $px? -1: 1)} {
2776 } elseif {[lsearch -exact $cross $p] < 0} {
2781 set inc [lindex $rowoffsets $row $x]
2782 if {$inc eq {}} break
2786 return [concat $ccross {{}} $cross]
2789 proc assigncolor {id} {
2790 global colormap colors nextcolor
2791 global commitrow parentlist children children curview
2793 if {[info exists colormap($id)]} return
2794 set ncolors [llength $colors]
2795 if {[info exists children($curview,$id)]} {
2796 set kids $children($curview,$id)
2800 if {[llength $kids] == 1} {
2801 set child [lindex $kids 0]
2802 if {[info exists colormap($child)]
2803 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2804 set colormap($id) $colormap($child)
2810 foreach x [findcrossings $id] {
2812 # delimiter between corner crossings and other crossings
2813 if {[llength $badcolors] >= $ncolors - 1} break
2814 set origbad $badcolors
2816 if {[info exists colormap($x)]
2817 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2818 lappend badcolors $colormap($x)
2821 if {[llength $badcolors] >= $ncolors} {
2822 set badcolors $origbad
2824 set origbad $badcolors
2825 if {[llength $badcolors] < $ncolors - 1} {
2826 foreach child $kids {
2827 if {[info exists colormap($child)]
2828 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2829 lappend badcolors $colormap($child)
2831 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2832 if {[info exists colormap($p)]
2833 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2834 lappend badcolors $colormap($p)
2838 if {[llength $badcolors] >= $ncolors} {
2839 set badcolors $origbad
2842 for {set i 0} {$i <= $ncolors} {incr i} {
2843 set c [lindex $colors $nextcolor]
2844 if {[incr nextcolor] >= $ncolors} {
2847 if {[lsearch -exact $badcolors $c]} break
2849 set colormap($id) $c
2852 proc bindline {t id} {
2855 $canv bind $t <Enter> "lineenter %x %y $id"
2856 $canv bind $t <Motion> "linemotion %x %y $id"
2857 $canv bind $t <Leave> "lineleave $id"
2858 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2861 proc drawtags {id x xt y1} {
2862 global idtags idheads idotherrefs
2863 global linespc lthickness
2864 global canv mainfont commitrow rowtextx curview
2869 if {[info exists idtags($id)]} {
2870 set marks $idtags($id)
2871 set ntags [llength $marks]
2873 if {[info exists idheads($id)]} {
2874 set marks [concat $marks $idheads($id)]
2875 set nheads [llength $idheads($id)]
2877 if {[info exists idotherrefs($id)]} {
2878 set marks [concat $marks $idotherrefs($id)]
2884 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2885 set yt [expr {$y1 - 0.5 * $linespc}]
2886 set yb [expr {$yt + $linespc - 1}]
2889 foreach tag $marks {
2890 set wid [font measure $mainfont $tag]
2893 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2895 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2896 -width $lthickness -fill black -tags tag.$id]
2898 foreach tag $marks x $xvals wid $wvals {
2899 set xl [expr {$x + $delta}]
2900 set xr [expr {$x + $delta + $wid + $lthickness}]
2901 if {[incr ntags -1] >= 0} {
2903 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2904 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2905 -width 1 -outline black -fill yellow -tags tag.$id]
2906 $canv bind $t <1> [list showtag $tag 1]
2907 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2909 # draw a head or other ref
2910 if {[incr nheads -1] >= 0} {
2915 set xl [expr {$xl - $delta/2}]
2916 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2917 -width 1 -outline black -fill $col -tags tag.$id
2918 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2919 set rwid [font measure $mainfont $remoteprefix]
2920 set xi [expr {$x + 1}]
2921 set yti [expr {$yt + 1}]
2922 set xri [expr {$x + $rwid}]
2923 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2924 -width 0 -fill "#ffddaa" -tags tag.$id
2927 set t [$canv create text $xl $y1 -anchor w -text $tag \
2928 -font $mainfont -tags tag.$id]
2930 $canv bind $t <1> [list showtag $tag 1]
2936 proc xcoord {i level ln} {
2937 global canvx0 xspc1 xspc2
2939 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2940 if {$i > 0 && $i == $level} {
2941 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2942 } elseif {$i > $level} {
2943 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2948 proc show_status {msg} {
2949 global canv mainfont
2952 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2955 proc finishcommits {} {
2956 global commitidx phase curview
2957 global canv mainfont ctext maincursor textcursor
2958 global findinprogress pending_select
2960 if {$commitidx($curview) > 0} {
2963 show_status "No commits selected"
2966 catch {unset pending_select}
2969 # Don't change the text pane cursor if it is currently the hand cursor,
2970 # showing that we are over a sha1 ID link.
2971 proc settextcursor {c} {
2972 global ctext curtextcursor
2974 if {[$ctext cget -cursor] == $curtextcursor} {
2975 $ctext config -cursor $c
2977 set curtextcursor $c
2980 proc nowbusy {what} {
2983 if {[array names isbusy] eq {}} {
2984 . config -cursor watch
2990 proc notbusy {what} {
2991 global isbusy maincursor textcursor
2993 catch {unset isbusy($what)}
2994 if {[array names isbusy] eq {}} {
2995 . config -cursor $maincursor
2996 settextcursor $textcursor
3003 global canvy0 numcommits linespc
3004 global rowlaidout commitidx curview
3005 global pending_select
3008 layoutrows $rowlaidout $commitidx($curview) 1
3010 optimize_rows $row 0 $commitidx($curview)
3011 showstuff $commitidx($curview)
3012 if {[info exists pending_select]} {
3016 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3017 #puts "overall $drawmsecs ms for $numcommits commits"
3020 proc findmatches {f} {
3021 global findtype foundstring foundstrlen
3022 if {$findtype == "Regexp"} {
3023 set matches [regexp -indices -all -inline $foundstring $f]
3025 if {$findtype == "IgnCase"} {
3026 set str [string tolower $f]
3032 while {[set j [string first $foundstring $str $i]] >= 0} {
3033 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3034 set i [expr {$j + $foundstrlen}]
3041 global findtype findloc findstring markedmatches commitinfo
3042 global numcommits displayorder linehtag linentag linedtag
3043 global mainfont canv canv2 canv3 selectedline
3044 global matchinglines foundstring foundstrlen matchstring
3050 set matchinglines {}
3051 if {$findloc == "Pickaxe"} {
3055 if {$findtype == "IgnCase"} {
3056 set foundstring [string tolower $findstring]
3058 set foundstring $findstring
3060 set foundstrlen [string length $findstring]
3061 if {$foundstrlen == 0} return
3062 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3063 set matchstring "*$matchstring*"
3064 if {$findloc == "Files"} {
3068 if {![info exists selectedline]} {
3071 set oldsel $selectedline
3074 set fldtypes {Headline Author Date Committer CDate Comment}
3076 foreach id $displayorder {
3077 set d $commitdata($id)
3079 if {$findtype == "Regexp"} {
3080 set doesmatch [regexp $foundstring $d]
3081 } elseif {$findtype == "IgnCase"} {
3082 set doesmatch [string match -nocase $matchstring $d]
3084 set doesmatch [string match $matchstring $d]
3086 if {!$doesmatch} continue
3087 if {![info exists commitinfo($id)]} {
3090 set info $commitinfo($id)
3092 foreach f $info ty $fldtypes {
3093 if {$findloc != "All fields" && $findloc != $ty} {
3096 set matches [findmatches $f]
3097 if {$matches == {}} continue
3099 if {$ty == "Headline"} {
3101 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3102 } elseif {$ty == "Author"} {
3104 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3105 } elseif {$ty == "Date"} {
3107 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3111 lappend matchinglines $l
3112 if {!$didsel && $l > $oldsel} {
3118 if {$matchinglines == {}} {
3120 } elseif {!$didsel} {
3121 findselectline [lindex $matchinglines 0]
3125 proc findselectline {l} {
3126 global findloc commentend ctext
3128 if {$findloc == "All fields" || $findloc == "Comments"} {
3129 # highlight the matches in the comments
3130 set f [$ctext get 1.0 $commentend]
3131 set matches [findmatches $f]
3132 foreach match $matches {
3133 set start [lindex $match 0]
3134 set end [expr {[lindex $match 1] + 1}]
3135 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3140 proc findnext {restart} {
3141 global matchinglines selectedline
3142 if {![info exists matchinglines]} {
3148 if {![info exists selectedline]} return
3149 foreach l $matchinglines {
3150 if {$l > $selectedline} {
3159 global matchinglines selectedline
3160 if {![info exists matchinglines]} {
3164 if {![info exists selectedline]} return
3166 foreach l $matchinglines {
3167 if {$l >= $selectedline} break
3171 findselectline $prev
3177 proc findlocchange {name ix op} {
3178 global findloc findtype findtypemenu
3179 if {$findloc == "Pickaxe"} {
3185 $findtypemenu entryconf 1 -state $state
3186 $findtypemenu entryconf 2 -state $state
3189 proc stopfindproc {{done 0}} {
3190 global findprocpid findprocfile findids
3191 global ctext findoldcursor phase maincursor textcursor
3192 global findinprogress
3194 catch {unset findids}
3195 if {[info exists findprocpid]} {
3197 catch {exec kill $findprocpid}
3199 catch {close $findprocfile}
3202 catch {unset findinprogress}
3206 proc findpatches {} {
3207 global findstring selectedline numcommits
3208 global findprocpid findprocfile
3209 global finddidsel ctext displayorder findinprogress
3210 global findinsertpos
3212 if {$numcommits == 0} return
3214 # make a list of all the ids to search, starting at the one
3215 # after the selected line (if any)
3216 if {[info exists selectedline]} {
3222 for {set i 0} {$i < $numcommits} {incr i} {
3223 if {[incr l] >= $numcommits} {
3226 append inputids [lindex $displayorder $l] "\n"
3230 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
3233 error_popup "Error starting search process: $err"
3237 set findinsertpos end
3239 set findprocpid [pid $f]
3240 fconfigure $f -blocking 0
3241 fileevent $f readable readfindproc
3244 set findinprogress 1
3247 proc readfindproc {} {
3248 global findprocfile finddidsel
3249 global commitrow matchinglines findinsertpos curview
3251 set n [gets $findprocfile line]
3253 if {[eof $findprocfile]} {
3261 if {![regexp {^[0-9a-f]{40}} $line id]} {
3262 error_popup "Can't parse git-diff-tree output: $line"
3266 if {![info exists commitrow($curview,$id)]} {
3267 puts stderr "spurious id: $id"
3270 set l $commitrow($curview,$id)
3274 proc insertmatch {l id} {
3275 global matchinglines findinsertpos finddidsel
3277 if {$findinsertpos == "end"} {
3278 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
3279 set matchinglines [linsert $matchinglines 0 $l]
3282 lappend matchinglines $l
3285 set matchinglines [linsert $matchinglines $findinsertpos $l]
3296 global selectedline numcommits displayorder ctext
3297 global ffileline finddidsel parentlist
3298 global findinprogress findstartline findinsertpos
3299 global treediffs fdiffid fdiffsneeded fdiffpos
3300 global findmergefiles
3302 if {$numcommits == 0} return
3304 if {[info exists selectedline]} {
3305 set l [expr {$selectedline + 1}]
3310 set findstartline $l
3314 set id [lindex $displayorder $l]
3315 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3316 if {![info exists treediffs($id)]} {
3317 append diffsneeded "$id\n"
3318 lappend fdiffsneeded $id
3321 if {[incr l] >= $numcommits} {
3324 if {$l == $findstartline} break
3327 # start off a git-diff-tree process if needed
3328 if {$diffsneeded ne {}} {
3330 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3332 error_popup "Error starting search process: $err"
3335 catch {unset fdiffid}
3337 fconfigure $df -blocking 0
3338 fileevent $df readable [list readfilediffs $df]
3342 set findinsertpos end
3343 set id [lindex $displayorder $l]
3345 set findinprogress 1
3350 proc readfilediffs {df} {
3351 global findid fdiffid fdiffs
3353 set n [gets $df line]
3357 if {[catch {close $df} err]} {
3360 error_popup "Error in git-diff-tree: $err"
3361 } elseif {[info exists findid]} {
3365 error_popup "Couldn't find diffs for $id"
3370 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3371 # start of a new string of diffs
3375 } elseif {[string match ":*" $line]} {
3376 lappend fdiffs [lindex $line 5]
3380 proc donefilediff {} {
3381 global fdiffid fdiffs treediffs findid
3382 global fdiffsneeded fdiffpos
3384 if {[info exists fdiffid]} {
3385 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3386 && $fdiffpos < [llength $fdiffsneeded]} {
3387 # git-diff-tree doesn't output anything for a commit
3388 # which doesn't change anything
3389 set nullid [lindex $fdiffsneeded $fdiffpos]
3390 set treediffs($nullid) {}
3391 if {[info exists findid] && $nullid eq $findid} {
3399 if {![info exists treediffs($fdiffid)]} {
3400 set treediffs($fdiffid) $fdiffs
3402 if {[info exists findid] && $fdiffid eq $findid} {
3410 global findid treediffs parentlist
3411 global ffileline findstartline finddidsel
3412 global displayorder numcommits matchinglines findinprogress
3413 global findmergefiles
3417 set id [lindex $displayorder $l]
3418 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3419 if {![info exists treediffs($id)]} {
3425 foreach f $treediffs($id) {
3426 set x [findmatches $f]
3436 if {[incr l] >= $numcommits} {
3439 if {$l == $findstartline} break
3447 # mark a commit as matching by putting a yellow background
3448 # behind the headline
3449 proc markheadline {l id} {
3450 global canv mainfont linehtag
3453 set bbox [$canv bbox $linehtag($l)]
3454 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3458 # mark the bits of a headline, author or date that match a find string
3459 proc markmatches {canv l str tag matches font} {
3460 set bbox [$canv bbox $tag]
3461 set x0 [lindex $bbox 0]
3462 set y0 [lindex $bbox 1]
3463 set y1 [lindex $bbox 3]
3464 foreach match $matches {
3465 set start [lindex $match 0]
3466 set end [lindex $match 1]
3467 if {$start > $end} continue
3468 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3469 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3470 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3471 [expr {$x0+$xlen+2}] $y1 \
3472 -outline {} -tags matches -fill yellow]
3477 proc unmarkmatches {} {
3478 global matchinglines findids
3479 allcanvs delete matches
3480 catch {unset matchinglines}
3481 catch {unset findids}
3484 proc selcanvline {w x y} {
3485 global canv canvy0 ctext linespc
3487 set ymax [lindex [$canv cget -scrollregion] 3]
3488 if {$ymax == {}} return
3489 set yfrac [lindex [$canv yview] 0]
3490 set y [expr {$y + $yfrac * $ymax}]
3491 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3496 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3502 proc commit_descriptor {p} {
3504 if {![info exists commitinfo($p)]} {
3508 if {[llength $commitinfo($p)] > 1} {
3509 set l [lindex $commitinfo($p) 0]
3514 # append some text to the ctext widget, and make any SHA1 ID
3515 # that we know about be a clickable link.
3516 proc appendwithlinks {text} {
3517 global ctext commitrow linknum curview
3519 set start [$ctext index "end - 1c"]
3520 $ctext insert end $text
3521 $ctext insert end "\n"
3522 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3526 set linkid [string range $text $s $e]
3527 if {![info exists commitrow($curview,$linkid)]} continue
3529 $ctext tag add link "$start + $s c" "$start + $e c"
3530 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3531 $ctext tag bind link$linknum <1> \
3532 [list selectline $commitrow($curview,$linkid) 1]
3535 $ctext tag conf link -foreground blue -underline 1
3536 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3537 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3540 proc viewnextline {dir} {
3544 set ymax [lindex [$canv cget -scrollregion] 3]
3545 set wnow [$canv yview]
3546 set wtop [expr {[lindex $wnow 0] * $ymax}]
3547 set newtop [expr {$wtop + $dir * $linespc}]
3550 } elseif {$newtop > $ymax} {
3553 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3556 proc selectline {l isnew} {
3557 global canv canv2 canv3 ctext commitinfo selectedline
3558 global displayorder linehtag linentag linedtag
3559 global canvy0 linespc parentlist childlist
3560 global currentid sha1entry
3561 global commentend idtags linknum
3562 global mergemax numcommits pending_select
3565 catch {unset pending_select}
3568 if {$l < 0 || $l >= $numcommits} return
3569 set y [expr {$canvy0 + $l * $linespc}]
3570 set ymax [lindex [$canv cget -scrollregion] 3]
3571 set ytop [expr {$y - $linespc - 1}]
3572 set ybot [expr {$y + $linespc + 1}]
3573 set wnow [$canv yview]
3574 set wtop [expr {[lindex $wnow 0] * $ymax}]
3575 set wbot [expr {[lindex $wnow 1] * $ymax}]
3576 set wh [expr {$wbot - $wtop}]
3578 if {$ytop < $wtop} {
3579 if {$ybot < $wtop} {
3580 set newtop [expr {$y - $wh / 2.0}]
3583 if {$newtop > $wtop - $linespc} {
3584 set newtop [expr {$wtop - $linespc}]
3587 } elseif {$ybot > $wbot} {
3588 if {$ytop > $wbot} {
3589 set newtop [expr {$y - $wh / 2.0}]
3591 set newtop [expr {$ybot - $wh}]
3592 if {$newtop < $wtop + $linespc} {
3593 set newtop [expr {$wtop + $linespc}]
3597 if {$newtop != $wtop} {
3601 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3605 if {![info exists linehtag($l)]} return
3607 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3608 -tags secsel -fill [$canv cget -selectbackground]]
3610 $canv2 delete secsel
3611 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3612 -tags secsel -fill [$canv2 cget -selectbackground]]
3614 $canv3 delete secsel
3615 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3616 -tags secsel -fill [$canv3 cget -selectbackground]]
3620 addtohistory [list selectline $l 0]
3625 set id [lindex $displayorder $l]
3627 $sha1entry delete 0 end
3628 $sha1entry insert 0 $id
3629 $sha1entry selection from 0
3630 $sha1entry selection to end
3632 $ctext conf -state normal
3633 $ctext delete 0.0 end
3635 set info $commitinfo($id)
3636 set date [formatdate [lindex $info 2]]
3637 $ctext insert end "Author: [lindex $info 1] $date\n"
3638 set date [formatdate [lindex $info 4]]
3639 $ctext insert end "Committer: [lindex $info 3] $date\n"
3640 if {[info exists idtags($id)]} {
3641 $ctext insert end "Tags:"
3642 foreach tag $idtags($id) {
3643 $ctext insert end " $tag"
3645 $ctext insert end "\n"
3649 set olds [lindex $parentlist $l]
3650 if {[llength $olds] > 1} {
3653 if {$np >= $mergemax} {
3658 $ctext insert end "Parent: " $tag
3659 appendwithlinks [commit_descriptor $p]
3664 append comment "Parent: [commit_descriptor $p]\n"
3668 foreach c [lindex $childlist $l] {
3669 append comment "Child: [commit_descriptor $c]\n"
3672 append comment [lindex $info 5]
3674 # make anything that looks like a SHA1 ID be a clickable link
3675 appendwithlinks $comment
3677 $ctext tag delete Comments
3678 $ctext tag remove found 1.0 end
3679 $ctext conf -state disabled
3680 set commentend [$ctext index "end - 1c"]
3682 init_flist "Comments"
3683 if {$cmitmode eq "tree"} {
3685 } elseif {[llength $olds] <= 1} {
3692 proc selfirstline {} {
3697 proc sellastline {} {
3700 set l [expr {$numcommits - 1}]
3704 proc selnextline {dir} {
3706 if {![info exists selectedline]} return
3707 set l [expr {$selectedline + $dir}]
3712 proc selnextpage {dir} {
3713 global canv linespc selectedline numcommits
3715 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3719 allcanvs yview scroll [expr {$dir * $lpp}] units
3721 if {![info exists selectedline]} return
3722 set l [expr {$selectedline + $dir * $lpp}]
3725 } elseif {$l >= $numcommits} {
3726 set l [expr $numcommits - 1]
3732 proc unselectline {} {
3733 global selectedline currentid
3735 catch {unset selectedline}
3736 catch {unset currentid}
3737 allcanvs delete secsel
3740 proc reselectline {} {
3743 if {[info exists selectedline]} {
3744 selectline $selectedline 0
3748 proc addtohistory {cmd} {
3749 global history historyindex curview
3751 set elt [list $curview $cmd]
3752 if {$historyindex > 0
3753 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3757 if {$historyindex < [llength $history]} {
3758 set history [lreplace $history $historyindex end $elt]
3760 lappend history $elt
3763 if {$historyindex > 1} {
3764 .ctop.top.bar.leftbut conf -state normal
3766 .ctop.top.bar.leftbut conf -state disabled
3768 .ctop.top.bar.rightbut conf -state disabled
3774 set view [lindex $elt 0]
3775 set cmd [lindex $elt 1]
3776 if {$curview != $view} {
3783 global history historyindex
3785 if {$historyindex > 1} {
3786 incr historyindex -1
3787 godo [lindex $history [expr {$historyindex - 1}]]
3788 .ctop.top.bar.rightbut conf -state normal
3790 if {$historyindex <= 1} {
3791 .ctop.top.bar.leftbut conf -state disabled
3796 global history historyindex
3798 if {$historyindex < [llength $history]} {
3799 set cmd [lindex $history $historyindex]
3802 .ctop.top.bar.leftbut conf -state normal
3804 if {$historyindex >= [llength $history]} {
3805 .ctop.top.bar.rightbut conf -state disabled
3810 global treefilelist treeidlist diffids diffmergeid treepending
3813 catch {unset diffmergeid}
3814 if {![info exists treefilelist($id)]} {
3815 if {![info exists treepending]} {
3816 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3820 set treefilelist($id) {}
3821 set treeidlist($id) {}
3822 fconfigure $gtf -blocking 0
3823 fileevent $gtf readable [list gettreeline $gtf $id]
3830 proc gettreeline {gtf id} {
3831 global treefilelist treeidlist treepending cmitmode diffids
3833 while {[gets $gtf line] >= 0} {
3834 if {[lindex $line 1] ne "blob"} continue
3835 set sha1 [lindex $line 2]
3836 set fname [lindex $line 3]
3837 lappend treefilelist($id) $fname
3838 lappend treeidlist($id) $sha1
3840 if {![eof $gtf]} return
3843 if {$cmitmode ne "tree"} {
3844 if {![info exists diffmergeid]} {
3845 gettreediffs $diffids
3847 } elseif {$id ne $diffids} {
3855 global treefilelist treeidlist diffids
3856 global ctext commentend
3858 set i [lsearch -exact $treefilelist($diffids) $f]
3860 puts "oops, $f not in list for id $diffids"
3863 set blob [lindex $treeidlist($diffids) $i]
3864 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3865 puts "oops, error reading blob $blob: $err"
3868 fconfigure $bf -blocking 0
3869 fileevent $bf readable [list getblobline $bf $diffids]
3870 $ctext config -state normal
3871 $ctext delete $commentend end
3872 $ctext insert end "\n"
3873 $ctext insert end "$f\n" filesep
3874 $ctext config -state disabled
3875 $ctext yview $commentend
3878 proc getblobline {bf id} {
3879 global diffids cmitmode ctext
3881 if {$id ne $diffids || $cmitmode ne "tree"} {
3885 $ctext config -state normal
3886 while {[gets $bf line] >= 0} {
3887 $ctext insert end "$line\n"
3890 # delete last newline
3891 $ctext delete "end - 2c" "end - 1c"
3894 $ctext config -state disabled
3897 proc mergediff {id l} {
3898 global diffmergeid diffopts mdifffd
3904 # this doesn't seem to actually affect anything...
3905 set env(GIT_DIFF_OPTS) $diffopts
3906 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3907 if {[catch {set mdf [open $cmd r]} err]} {
3908 error_popup "Error getting merge diffs: $err"
3911 fconfigure $mdf -blocking 0
3912 set mdifffd($id) $mdf
3913 set np [llength [lindex $parentlist $l]]
3914 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3915 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3918 proc getmergediffline {mdf id np} {
3919 global diffmergeid ctext cflist nextupdate mergemax
3920 global difffilestart mdifffd
3922 set n [gets $mdf line]
3929 if {![info exists diffmergeid] || $id != $diffmergeid
3930 || $mdf != $mdifffd($id)} {
3933 $ctext conf -state normal
3934 if {[regexp {^diff --cc (.*)} $line match fname]} {
3935 # start of a new file
3936 $ctext insert end "\n"
3937 set here [$ctext index "end - 1c"]
3938 lappend difffilestart $here
3939 add_flist [list $fname]
3940 set l [expr {(78 - [string length $fname]) / 2}]
3941 set pad [string range "----------------------------------------" 1 $l]
3942 $ctext insert end "$pad $fname $pad\n" filesep
3943 } elseif {[regexp {^@@} $line]} {
3944 $ctext insert end "$line\n" hunksep
3945 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3948 # parse the prefix - one ' ', '-' or '+' for each parent
3953 for {set j 0} {$j < $np} {incr j} {
3954 set c [string range $line $j $j]
3957 } elseif {$c == "-"} {
3959 } elseif {$c == "+"} {
3968 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3969 # line doesn't appear in result, parents in $minuses have the line
3970 set num [lindex $minuses 0]
3971 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3972 # line appears in result, parents in $pluses don't have the line
3973 lappend tags mresult
3974 set num [lindex $spaces 0]
3977 if {$num >= $mergemax} {
3982 $ctext insert end "$line\n" $tags
3984 $ctext conf -state disabled
3985 if {[clock clicks -milliseconds] >= $nextupdate} {
3987 fileevent $mdf readable {}
3989 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3993 proc startdiff {ids} {
3994 global treediffs diffids treepending diffmergeid
3997 catch {unset diffmergeid}
3998 if {![info exists treediffs($ids)]} {
3999 if {![info exists treepending]} {
4007 proc addtocflist {ids} {
4008 global treediffs cflist
4009 add_flist $treediffs($ids)
4013 proc gettreediffs {ids} {
4014 global treediff treepending
4015 set treepending $ids
4018 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4020 fconfigure $gdtf -blocking 0
4021 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4024 proc gettreediffline {gdtf ids} {
4025 global treediff treediffs treepending diffids diffmergeid
4028 set n [gets $gdtf line]
4030 if {![eof $gdtf]} return
4032 set treediffs($ids) $treediff
4034 if {$cmitmode eq "tree"} {
4036 } elseif {$ids != $diffids} {
4037 if {![info exists diffmergeid]} {
4038 gettreediffs $diffids
4045 set file [lindex $line 5]
4046 lappend treediff $file
4049 proc getblobdiffs {ids} {
4050 global diffopts blobdifffd diffids env curdifftag curtagstart
4051 global nextupdate diffinhdr treediffs
4053 set env(GIT_DIFF_OPTS) $diffopts
4054 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4055 if {[catch {set bdf [open $cmd r]} err]} {
4056 puts "error getting diffs: $err"
4060 fconfigure $bdf -blocking 0
4061 set blobdifffd($ids) $bdf
4062 set curdifftag Comments
4064 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4065 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4068 proc setinlist {var i val} {
4071 while {[llength [set $var]] < $i} {
4074 if {[llength [set $var]] == $i} {
4081 proc getblobdiffline {bdf ids} {
4082 global diffids blobdifffd ctext curdifftag curtagstart
4083 global diffnexthead diffnextnote difffilestart
4084 global nextupdate diffinhdr treediffs
4086 set n [gets $bdf line]
4090 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4091 $ctext tag add $curdifftag $curtagstart end
4096 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4099 $ctext conf -state normal
4100 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4101 # start of a new file
4102 $ctext insert end "\n"
4103 $ctext tag add $curdifftag $curtagstart end
4104 set here [$ctext index "end - 1c"]
4105 set curtagstart $here
4107 set i [lsearch -exact $treediffs($ids) $fname]
4109 setinlist difffilestart $i $here
4111 if {$newname ne $fname} {
4112 set i [lsearch -exact $treediffs($ids) $newname]
4114 setinlist difffilestart $i $here
4117 set curdifftag "f:$fname"
4118 $ctext tag delete $curdifftag
4119 set l [expr {(78 - [string length $header]) / 2}]
4120 set pad [string range "----------------------------------------" 1 $l]
4121 $ctext insert end "$pad $header $pad\n" filesep
4123 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4125 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4127 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4128 $line match f1l f1c f2l f2c rest]} {
4129 $ctext insert end "$line\n" hunksep
4132 set x [string range $line 0 0]
4133 if {$x == "-" || $x == "+"} {
4134 set tag [expr {$x == "+"}]
4135 $ctext insert end "$line\n" d$tag
4136 } elseif {$x == " "} {
4137 $ctext insert end "$line\n"
4138 } elseif {$diffinhdr || $x == "\\"} {
4139 # e.g. "\ No newline at end of file"
4140 $ctext insert end "$line\n" filesep
4142 # Something else we don't recognize
4143 if {$curdifftag != "Comments"} {
4144 $ctext insert end "\n"
4145 $ctext tag add $curdifftag $curtagstart end
4146 set curtagstart [$ctext index "end - 1c"]
4147 set curdifftag Comments
4149 $ctext insert end "$line\n" filesep
4152 $ctext conf -state disabled
4153 if {[clock clicks -milliseconds] >= $nextupdate} {
4155 fileevent $bdf readable {}
4157 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4162 global difffilestart ctext
4163 set here [$ctext index @0,0]
4164 foreach loc $difffilestart {
4165 if {[$ctext compare $loc > $here]} {
4172 global linespc charspc canvx0 canvy0 mainfont
4173 global xspc1 xspc2 lthickness
4175 set linespc [font metrics $mainfont -linespace]
4176 set charspc [font measure $mainfont "m"]
4177 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4178 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4179 set lthickness [expr {int($linespc / 9) + 1}]
4180 set xspc1(0) $linespc
4188 set ymax [lindex [$canv cget -scrollregion] 3]
4189 if {$ymax eq {} || $ymax == 0} return
4190 set span [$canv yview]
4193 allcanvs yview moveto [lindex $span 0]
4195 if {[info exists selectedline]} {
4196 selectline $selectedline 0
4200 proc incrfont {inc} {
4201 global mainfont textfont ctext canv phase
4202 global stopped entries
4204 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4205 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4207 $ctext conf -font $textfont
4208 $ctext tag conf filesep -font [concat $textfont bold]
4209 foreach e $entries {
4210 $e conf -font $mainfont
4212 if {$phase eq "getcommits"} {
4213 $canv itemconf textitems -font $mainfont
4219 global sha1entry sha1string
4220 if {[string length $sha1string] == 40} {
4221 $sha1entry delete 0 end
4225 proc sha1change {n1 n2 op} {
4226 global sha1string currentid sha1but
4227 if {$sha1string == {}
4228 || ([info exists currentid] && $sha1string == $currentid)} {
4233 if {[$sha1but cget -state] == $state} return
4234 if {$state == "normal"} {
4235 $sha1but conf -state normal -relief raised -text "Goto: "
4237 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4241 proc gotocommit {} {
4242 global sha1string currentid commitrow tagids headids
4243 global displayorder numcommits curview
4245 if {$sha1string == {}
4246 || ([info exists currentid] && $sha1string == $currentid)} return
4247 if {[info exists tagids($sha1string)]} {
4248 set id $tagids($sha1string)
4249 } elseif {[info exists headids($sha1string)]} {
4250 set id $headids($sha1string)
4252 set id [string tolower $sha1string]
4253 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4255 foreach i $displayorder {
4256 if {[string match $id* $i]} {
4260 if {$matches ne {}} {
4261 if {[llength $matches] > 1} {
4262 error_popup "Short SHA1 id $id is ambiguous"
4265 set id [lindex $matches 0]
4269 if {[info exists commitrow($curview,$id)]} {
4270 selectline $commitrow($curview,$id) 1
4273 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4278 error_popup "$type $sha1string is not known"
4281 proc lineenter {x y id} {
4282 global hoverx hovery hoverid hovertimer
4283 global commitinfo canv
4285 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4289 if {[info exists hovertimer]} {
4290 after cancel $hovertimer
4292 set hovertimer [after 500 linehover]
4296 proc linemotion {x y id} {
4297 global hoverx hovery hoverid hovertimer
4299 if {[info exists hoverid] && $id == $hoverid} {
4302 if {[info exists hovertimer]} {
4303 after cancel $hovertimer
4305 set hovertimer [after 500 linehover]
4309 proc lineleave {id} {
4310 global hoverid hovertimer canv
4312 if {[info exists hoverid] && $id == $hoverid} {
4314 if {[info exists hovertimer]} {
4315 after cancel $hovertimer
4323 global hoverx hovery hoverid hovertimer
4324 global canv linespc lthickness
4325 global commitinfo mainfont
4327 set text [lindex $commitinfo($hoverid) 0]
4328 set ymax [lindex [$canv cget -scrollregion] 3]
4329 if {$ymax == {}} return
4330 set yfrac [lindex [$canv yview] 0]
4331 set x [expr {$hoverx + 2 * $linespc}]
4332 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4333 set x0 [expr {$x - 2 * $lthickness}]
4334 set y0 [expr {$y - 2 * $lthickness}]
4335 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4336 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4337 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4338 -fill \#ffff80 -outline black -width 1 -tags hover]
4340 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4344 proc clickisonarrow {id y} {
4347 set ranges [rowranges $id]
4348 set thresh [expr {2 * $lthickness + 6}]
4349 set n [expr {[llength $ranges] - 1}]
4350 for {set i 1} {$i < $n} {incr i} {
4351 set row [lindex $ranges $i]
4352 if {abs([yc $row] - $y) < $thresh} {
4359 proc arrowjump {id n y} {
4362 # 1 <-> 2, 3 <-> 4, etc...
4363 set n [expr {(($n - 1) ^ 1) + 1}]
4364 set row [lindex [rowranges $id] $n]
4366 set ymax [lindex [$canv cget -scrollregion] 3]
4367 if {$ymax eq {} || $ymax <= 0} return
4368 set view [$canv yview]
4369 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4370 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4374 allcanvs yview moveto $yfrac
4377 proc lineclick {x y id isnew} {
4378 global ctext commitinfo children canv thickerline curview
4380 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4385 # draw this line thicker than normal
4389 set ymax [lindex [$canv cget -scrollregion] 3]
4390 if {$ymax eq {}} return
4391 set yfrac [lindex [$canv yview] 0]
4392 set y [expr {$y + $yfrac * $ymax}]
4394 set dirn [clickisonarrow $id $y]
4396 arrowjump $id $dirn $y
4401 addtohistory [list lineclick $x $y $id 0]
4403 # fill the details pane with info about this line
4404 $ctext conf -state normal
4405 $ctext delete 0.0 end
4406 $ctext tag conf link -foreground blue -underline 1
4407 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4408 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4409 $ctext insert end "Parent:\t"
4410 $ctext insert end $id [list link link0]
4411 $ctext tag bind link0 <1> [list selbyid $id]
4412 set info $commitinfo($id)
4413 $ctext insert end "\n\t[lindex $info 0]\n"
4414 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4415 set date [formatdate [lindex $info 2]]
4416 $ctext insert end "\tDate:\t$date\n"
4417 set kids $children($curview,$id)
4419 $ctext insert end "\nChildren:"
4421 foreach child $kids {
4423 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4424 set info $commitinfo($child)
4425 $ctext insert end "\n\t"
4426 $ctext insert end $child [list link link$i]
4427 $ctext tag bind link$i <1> [list selbyid $child]
4428 $ctext insert end "\n\t[lindex $info 0]"
4429 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4430 set date [formatdate [lindex $info 2]]
4431 $ctext insert end "\n\tDate:\t$date\n"
4434 $ctext conf -state disabled
4438 proc normalline {} {
4440 if {[info exists thickerline]} {
4448 global commitrow curview
4449 if {[info exists commitrow($curview,$id)]} {
4450 selectline $commitrow($curview,$id) 1
4456 if {![info exists startmstime]} {
4457 set startmstime [clock clicks -milliseconds]
4459 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4462 proc rowmenu {x y id} {
4463 global rowctxmenu commitrow selectedline rowmenuid curview
4465 if {![info exists selectedline]
4466 || $commitrow($curview,$id) eq $selectedline} {
4471 $rowctxmenu entryconfigure 0 -state $state
4472 $rowctxmenu entryconfigure 1 -state $state
4473 $rowctxmenu entryconfigure 2 -state $state
4475 tk_popup $rowctxmenu $x $y
4478 proc diffvssel {dirn} {
4479 global rowmenuid selectedline displayorder
4481 if {![info exists selectedline]} return
4483 set oldid [lindex $displayorder $selectedline]
4484 set newid $rowmenuid
4486 set oldid $rowmenuid
4487 set newid [lindex $displayorder $selectedline]
4489 addtohistory [list doseldiff $oldid $newid]
4490 doseldiff $oldid $newid
4493 proc doseldiff {oldid newid} {
4497 $ctext conf -state normal
4498 $ctext delete 0.0 end
4500 $ctext insert end "From "
4501 $ctext tag conf link -foreground blue -underline 1
4502 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4503 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4504 $ctext tag bind link0 <1> [list selbyid $oldid]
4505 $ctext insert end $oldid [list link link0]
4506 $ctext insert end "\n "
4507 $ctext insert end [lindex $commitinfo($oldid) 0]
4508 $ctext insert end "\n\nTo "
4509 $ctext tag bind link1 <1> [list selbyid $newid]
4510 $ctext insert end $newid [list link link1]
4511 $ctext insert end "\n "
4512 $ctext insert end [lindex $commitinfo($newid) 0]
4513 $ctext insert end "\n"
4514 $ctext conf -state disabled
4515 $ctext tag delete Comments
4516 $ctext tag remove found 1.0 end
4517 startdiff [list $oldid $newid]
4521 global rowmenuid currentid commitinfo patchtop patchnum
4523 if {![info exists currentid]} return
4524 set oldid $currentid
4525 set oldhead [lindex $commitinfo($oldid) 0]
4526 set newid $rowmenuid
4527 set newhead [lindex $commitinfo($newid) 0]
4530 catch {destroy $top}
4532 label $top.title -text "Generate patch"
4533 grid $top.title - -pady 10
4534 label $top.from -text "From:"
4535 entry $top.fromsha1 -width 40 -relief flat
4536 $top.fromsha1 insert 0 $oldid
4537 $top.fromsha1 conf -state readonly
4538 grid $top.from $top.fromsha1 -sticky w
4539 entry $top.fromhead -width 60 -relief flat
4540 $top.fromhead insert 0 $oldhead
4541 $top.fromhead conf -state readonly
4542 grid x $top.fromhead -sticky w
4543 label $top.to -text "To:"
4544 entry $top.tosha1 -width 40 -relief flat
4545 $top.tosha1 insert 0 $newid
4546 $top.tosha1 conf -state readonly
4547 grid $top.to $top.tosha1 -sticky w
4548 entry $top.tohead -width 60 -relief flat
4549 $top.tohead insert 0 $newhead
4550 $top.tohead conf -state readonly
4551 grid x $top.tohead -sticky w
4552 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4553 grid $top.rev x -pady 10
4554 label $top.flab -text "Output file:"
4555 entry $top.fname -width 60
4556 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4558 grid $top.flab $top.fname -sticky w
4560 button $top.buts.gen -text "Generate" -command mkpatchgo
4561 button $top.buts.can -text "Cancel" -command mkpatchcan
4562 grid $top.buts.gen $top.buts.can
4563 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4564 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4565 grid $top.buts - -pady 10 -sticky ew
4569 proc mkpatchrev {} {
4572 set oldid [$patchtop.fromsha1 get]
4573 set oldhead [$patchtop.fromhead get]
4574 set newid [$patchtop.tosha1 get]
4575 set newhead [$patchtop.tohead get]
4576 foreach e [list fromsha1 fromhead tosha1 tohead] \
4577 v [list $newid $newhead $oldid $oldhead] {
4578 $patchtop.$e conf -state normal
4579 $patchtop.$e delete 0 end
4580 $patchtop.$e insert 0 $v
4581 $patchtop.$e conf -state readonly
4588 set oldid [$patchtop.fromsha1 get]
4589 set newid [$patchtop.tosha1 get]
4590 set fname [$patchtop.fname get]
4591 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4592 error_popup "Error creating patch: $err"
4594 catch {destroy $patchtop}
4598 proc mkpatchcan {} {
4601 catch {destroy $patchtop}
4606 global rowmenuid mktagtop commitinfo
4610 catch {destroy $top}
4612 label $top.title -text "Create tag"
4613 grid $top.title - -pady 10
4614 label $top.id -text "ID:"
4615 entry $top.sha1 -width 40 -relief flat
4616 $top.sha1 insert 0 $rowmenuid
4617 $top.sha1 conf -state readonly
4618 grid $top.id $top.sha1 -sticky w
4619 entry $top.head -width 60 -relief flat
4620 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4621 $top.head conf -state readonly
4622 grid x $top.head -sticky w
4623 label $top.tlab -text "Tag name:"
4624 entry $top.tag -width 60
4625 grid $top.tlab $top.tag -sticky w
4627 button $top.buts.gen -text "Create" -command mktaggo
4628 button $top.buts.can -text "Cancel" -command mktagcan
4629 grid $top.buts.gen $top.buts.can
4630 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4631 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4632 grid $top.buts - -pady 10 -sticky ew
4637 global mktagtop env tagids idtags
4639 set id [$mktagtop.sha1 get]
4640 set tag [$mktagtop.tag get]
4642 error_popup "No tag name specified"
4645 if {[info exists tagids($tag)]} {
4646 error_popup "Tag \"$tag\" already exists"
4651 set fname [file join $dir "refs/tags" $tag]
4652 set f [open $fname w]
4656 error_popup "Error creating tag: $err"
4660 set tagids($tag) $id
4661 lappend idtags($id) $tag
4665 proc redrawtags {id} {
4666 global canv linehtag commitrow idpos selectedline curview
4668 if {![info exists commitrow($curview,$id)]} return
4669 drawcmitrow $commitrow($curview,$id)
4670 $canv delete tag.$id
4671 set xt [eval drawtags $id $idpos($id)]
4672 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4673 if {[info exists selectedline]
4674 && $selectedline == $commitrow($curview,$id)} {
4675 selectline $selectedline 0
4682 catch {destroy $mktagtop}
4691 proc writecommit {} {
4692 global rowmenuid wrcomtop commitinfo wrcomcmd
4694 set top .writecommit
4696 catch {destroy $top}
4698 label $top.title -text "Write commit to file"
4699 grid $top.title - -pady 10
4700 label $top.id -text "ID:"
4701 entry $top.sha1 -width 40 -relief flat
4702 $top.sha1 insert 0 $rowmenuid
4703 $top.sha1 conf -state readonly
4704 grid $top.id $top.sha1 -sticky w
4705 entry $top.head -width 60 -relief flat
4706 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4707 $top.head conf -state readonly
4708 grid x $top.head -sticky w
4709 label $top.clab -text "Command:"
4710 entry $top.cmd -width 60 -textvariable wrcomcmd
4711 grid $top.clab $top.cmd -sticky w -pady 10
4712 label $top.flab -text "Output file:"
4713 entry $top.fname -width 60
4714 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4715 grid $top.flab $top.fname -sticky w
4717 button $top.buts.gen -text "Write" -command wrcomgo
4718 button $top.buts.can -text "Cancel" -command wrcomcan
4719 grid $top.buts.gen $top.buts.can
4720 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4721 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4722 grid $top.buts - -pady 10 -sticky ew
4729 set id [$wrcomtop.sha1 get]
4730 set cmd "echo $id | [$wrcomtop.cmd get]"
4731 set fname [$wrcomtop.fname get]
4732 if {[catch {exec sh -c $cmd >$fname &} err]} {
4733 error_popup "Error writing commit: $err"
4735 catch {destroy $wrcomtop}
4742 catch {destroy $wrcomtop}
4746 proc listrefs {id} {
4747 global idtags idheads idotherrefs
4750 if {[info exists idtags($id)]} {
4754 if {[info exists idheads($id)]} {
4758 if {[info exists idotherrefs($id)]} {
4759 set z $idotherrefs($id)
4761 return [list $x $y $z]
4764 proc rereadrefs {} {
4765 global idtags idheads idotherrefs
4767 set refids [concat [array names idtags] \
4768 [array names idheads] [array names idotherrefs]]
4769 foreach id $refids {
4770 if {![info exists ref($id)]} {
4771 set ref($id) [listrefs $id]
4775 set refids [lsort -unique [concat $refids [array names idtags] \
4776 [array names idheads] [array names idotherrefs]]]
4777 foreach id $refids {
4778 set v [listrefs $id]
4779 if {![info exists ref($id)] || $ref($id) != $v} {
4785 proc showtag {tag isnew} {
4786 global ctext tagcontents tagids linknum
4789 addtohistory [list showtag $tag 0]
4791 $ctext conf -state normal
4792 $ctext delete 0.0 end
4794 if {[info exists tagcontents($tag)]} {
4795 set text $tagcontents($tag)
4797 set text "Tag: $tag\nId: $tagids($tag)"
4799 appendwithlinks $text
4800 $ctext conf -state disabled
4811 global maxwidth maxgraphpct diffopts findmergefiles
4812 global oldprefs prefstop
4816 if {[winfo exists $top]} {
4820 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4821 set oldprefs($v) [set $v]
4824 wm title $top "Gitk preferences"
4825 label $top.ldisp -text "Commit list display options"
4826 grid $top.ldisp - -sticky w -pady 10
4827 label $top.spacer -text " "
4828 label $top.maxwidthl -text "Maximum graph width (lines)" \
4830 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4831 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4832 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4834 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4835 grid x $top.maxpctl $top.maxpct -sticky w
4836 checkbutton $top.findm -variable findmergefiles
4837 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4839 grid $top.findm $top.findml - -sticky w
4840 label $top.ddisp -text "Diff display options"
4841 grid $top.ddisp - -sticky w -pady 10
4842 label $top.diffoptl -text "Options for diff program" \
4844 entry $top.diffopt -width 20 -textvariable diffopts
4845 grid x $top.diffoptl $top.diffopt -sticky w
4847 button $top.buts.ok -text "OK" -command prefsok
4848 button $top.buts.can -text "Cancel" -command prefscan
4849 grid $top.buts.ok $top.buts.can
4850 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4851 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4852 grid $top.buts - - -pady 10 -sticky ew
4856 global maxwidth maxgraphpct diffopts findmergefiles
4857 global oldprefs prefstop
4859 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4860 set $v $oldprefs($v)
4862 catch {destroy $prefstop}
4867 global maxwidth maxgraphpct
4868 global oldprefs prefstop
4870 catch {destroy $prefstop}
4872 if {$maxwidth != $oldprefs(maxwidth)
4873 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4878 proc formatdate {d} {
4879 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4882 # This list of encoding names and aliases is distilled from
4883 # http://www.iana.org/assignments/character-sets.
4884 # Not all of them are supported by Tcl.
4885 set encoding_aliases {
4886 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4887 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4888 { ISO-10646-UTF-1 csISO10646UTF1 }
4889 { ISO_646.basic:1983 ref csISO646basic1983 }
4890 { INVARIANT csINVARIANT }
4891 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4892 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4893 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4894 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4895 { NATS-DANO iso-ir-9-1 csNATSDANO }
4896 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4897 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4898 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4899 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4900 { ISO-2022-KR csISO2022KR }
4902 { ISO-2022-JP csISO2022JP }
4903 { ISO-2022-JP-2 csISO2022JP2 }
4904 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4906 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4907 { IT iso-ir-15 ISO646-IT csISO15Italian }
4908 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4909 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4910 { greek7-old iso-ir-18 csISO18Greek7Old }
4911 { latin-greek iso-ir-19 csISO19LatinGreek }
4912 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4913 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4914 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4915 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4916 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4917 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4918 { INIS iso-ir-49 csISO49INIS }
4919 { INIS-8 iso-ir-50 csISO50INIS8 }
4920 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4921 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4922 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4923 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4924 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4925 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4927 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4928 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4929 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4930 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4931 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4932 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4933 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4934 { greek7 iso-ir-88 csISO88Greek7 }
4935 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4936 { iso-ir-90 csISO90 }
4937 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4938 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4939 csISO92JISC62991984b }
4940 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4941 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4942 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4943 csISO95JIS62291984handadd }
4944 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4945 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4946 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4947 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4949 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4950 { T.61-7bit iso-ir-102 csISO102T617bit }
4951 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4952 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4953 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4954 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4955 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4956 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4957 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4958 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4959 arabic csISOLatinArabic }
4960 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4961 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4962 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4963 greek greek8 csISOLatinGreek }
4964 { T.101-G2 iso-ir-128 csISO128T101G2 }
4965 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4967 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4968 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4969 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4970 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4971 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4972 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4973 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4974 csISOLatinCyrillic }
4975 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4976 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4977 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4978 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4979 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4980 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4981 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4982 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4983 { ISO_10367-box iso-ir-155 csISO10367Box }
4984 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4985 { latin-lap lap iso-ir-158 csISO158Lap }
4986 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4987 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4990 { JIS_X0201 X0201 csHalfWidthKatakana }
4991 { KSC5636 ISO646-KR csKSC5636 }
4992 { ISO-10646-UCS-2 csUnicode }
4993 { ISO-10646-UCS-4 csUCS4 }
4994 { DEC-MCS dec csDECMCS }
4995 { hp-roman8 roman8 r8 csHPRoman8 }
4996 { macintosh mac csMacintosh }
4997 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4999 { IBM038 EBCDIC-INT cp038 csIBM038 }
5000 { IBM273 CP273 csIBM273 }
5001 { IBM274 EBCDIC-BE CP274 csIBM274 }
5002 { IBM275 EBCDIC-BR cp275 csIBM275 }
5003 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5004 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5005 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5006 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5007 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5008 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5009 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5010 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5011 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5012 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5013 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5014 { IBM437 cp437 437 csPC8CodePage437 }
5015 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5016 { IBM775 cp775 csPC775Baltic }
5017 { IBM850 cp850 850 csPC850Multilingual }
5018 { IBM851 cp851 851 csIBM851 }
5019 { IBM852 cp852 852 csPCp852 }
5020 { IBM855 cp855 855 csIBM855 }
5021 { IBM857 cp857 857 csIBM857 }
5022 { IBM860 cp860 860 csIBM860 }
5023 { IBM861 cp861 861 cp-is csIBM861 }
5024 { IBM862 cp862 862 csPC862LatinHebrew }
5025 { IBM863 cp863 863 csIBM863 }
5026 { IBM864 cp864 csIBM864 }
5027 { IBM865 cp865 865 csIBM865 }
5028 { IBM866 cp866 866 csIBM866 }
5029 { IBM868 CP868 cp-ar csIBM868 }
5030 { IBM869 cp869 869 cp-gr csIBM869 }
5031 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5032 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5033 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5034 { IBM891 cp891 csIBM891 }
5035 { IBM903 cp903 csIBM903 }
5036 { IBM904 cp904 904 csIBBM904 }
5037 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5038 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5039 { IBM1026 CP1026 csIBM1026 }
5040 { EBCDIC-AT-DE csIBMEBCDICATDE }
5041 { EBCDIC-AT-DE-A csEBCDICATDEA }
5042 { EBCDIC-CA-FR csEBCDICCAFR }
5043 { EBCDIC-DK-NO csEBCDICDKNO }
5044 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5045 { EBCDIC-FI-SE csEBCDICFISE }
5046 { EBCDIC-FI-SE-A csEBCDICFISEA }
5047 { EBCDIC-FR csEBCDICFR }
5048 { EBCDIC-IT csEBCDICIT }
5049 { EBCDIC-PT csEBCDICPT }
5050 { EBCDIC-ES csEBCDICES }
5051 { EBCDIC-ES-A csEBCDICESA }
5052 { EBCDIC-ES-S csEBCDICESS }
5053 { EBCDIC-UK csEBCDICUK }
5054 { EBCDIC-US csEBCDICUS }
5055 { UNKNOWN-8BIT csUnknown8BiT }
5056 { MNEMONIC csMnemonic }
5061 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5062 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5063 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5064 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5065 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5066 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5067 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5068 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5069 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5070 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5071 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5072 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5073 { IBM1047 IBM-1047 }
5074 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5075 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5076 { UNICODE-1-1 csUnicode11 }
5079 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5080 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5082 { ISO-8859-15 ISO_8859-15 Latin-9 }
5083 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5084 { GBK CP936 MS936 windows-936 }
5085 { JIS_Encoding csJISEncoding }
5086 { Shift_JIS MS_Kanji csShiftJIS }
5087 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5089 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5090 { ISO-10646-UCS-Basic csUnicodeASCII }
5091 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5092 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5093 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5094 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5095 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5096 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5097 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5098 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5099 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5100 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5101 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5102 { Ventura-US csVenturaUS }
5103 { Ventura-International csVenturaInternational }
5104 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5105 { PC8-Turkish csPC8Turkish }
5106 { IBM-Symbols csIBMSymbols }
5107 { IBM-Thai csIBMThai }
5108 { HP-Legal csHPLegal }
5109 { HP-Pi-font csHPPiFont }
5110 { HP-Math8 csHPMath8 }
5111 { Adobe-Symbol-Encoding csHPPSMath }
5112 { HP-DeskTop csHPDesktop }
5113 { Ventura-Math csVenturaMath }
5114 { Microsoft-Publishing csMicrosoftPublishing }
5115 { Windows-31J csWindows31J }
5120 proc tcl_encoding {enc} {
5121 global encoding_aliases
5122 set names [encoding names]
5123 set lcnames [string tolower $names]
5124 set enc [string tolower $enc]
5125 set i [lsearch -exact $lcnames $enc]
5127 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5128 if {[regsub {^iso[-_]} $enc iso encx]} {
5129 set i [lsearch -exact $lcnames $encx]
5133 foreach l $encoding_aliases {
5134 set ll [string tolower $l]
5135 if {[lsearch -exact $ll $enc] < 0} continue
5136 # look through the aliases for one that tcl knows about
5138 set i [lsearch -exact $lcnames $e]
5140 if {[regsub {^iso[-_]} $e iso ex]} {
5141 set i [lsearch -exact $lcnames $ex]
5150 return [lindex $names $i]
5157 set diffopts "-U 5 -p"
5158 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5162 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5164 if {$gitencoding == ""} {
5165 set gitencoding "utf-8"
5167 set tclencoding [tcl_encoding $gitencoding]
5168 if {$tclencoding == {}} {
5169 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5172 set mainfont {Helvetica 9}
5173 set textfont {Courier 9}
5174 set uifont {Helvetica 9 bold}
5175 set findmergefiles 0
5183 set flistmode "flat"
5184 set cmitmode "patch"
5186 set colors {green red blue magenta darkgrey brown orange}
5188 catch {source ~/.gitk}
5190 font create optionfont -family sans-serif -size -12
5194 switch -regexp -- $arg {
5196 "^-d" { set datemode 1 }
5198 lappend revtreeargs $arg
5203 # check that we can find a .git directory somewhere...
5205 if {![file isdirectory $gitdir]} {
5206 show_error . "Cannot find the git directory \"$gitdir\"."
5210 set cmdline_files {}
5211 set i [lsearch -exact $revtreeargs "--"]
5213 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5214 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5215 } elseif {$revtreeargs ne {}} {
5217 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5218 set cmdline_files [split $f "\n"]
5219 set n [llength $cmdline_files]
5220 set revtreeargs [lrange $revtreeargs 0 end-$n]
5222 # unfortunately we get both stdout and stderr in $err,
5223 # so look for "fatal:".
5224 set i [string first "fatal:" $err]
5226 set err [string range [expr {$i + 6}] end]
5228 show_error . "Bad arguments to gitk:\n$err"
5236 set highlight_names {}
5238 set highlight_paths {}
5245 set selectedhlview None
5258 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5259 # create a view for the files/dirs specified on the command line
5263 set viewname(1) "Command line"
5264 set viewfiles(1) $cmdline_files
5265 set viewargs(1) $revtreeargs
5268 .bar.view entryconf 2 -state normal
5269 .bar.view entryconf 3 -state normal
5272 if {[info exists permviews]} {
5273 foreach v $permviews {
5276 set viewname($n) [lindex $v 0]
5277 set viewfiles($n) [lindex $v 1]
5278 set viewargs($n) [lindex $v 2]