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 \
953 $w insert end $d [highlight_tag $prefix]
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"}
965 $w insert end $tail [highlight_tag $f]
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 highlight_tree {y prefix} {
1003 global treeheight treecontents cflist
1005 foreach e $treecontents($prefix) {
1007 if {[highlight_tag $path] ne {}} {
1008 $cflist tag add bold $y.0 "$y.0 lineend"
1011 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1012 set y [highlight_tree $y $path]
1018 proc treeclosedir {w dir} {
1019 global treediropen treeheight treeparent treeindex
1021 set ix $treeindex($dir)
1022 $w conf -state normal
1023 $w delete s:$ix e:$ix
1024 set treediropen($dir) 0
1025 $w image configure a:$ix -image tri-rt
1026 $w conf -state disabled
1027 set n [expr {1 - $treeheight($dir)}]
1028 while {$dir ne {}} {
1029 incr treeheight($dir) $n
1030 set dir $treeparent($dir)
1034 proc treeopendir {w dir} {
1035 global treediropen treeheight treeparent treecontents treeindex
1037 set ix $treeindex($dir)
1038 $w conf -state normal
1039 $w image configure a:$ix -image tri-dn
1040 $w mark set e:$ix s:$ix
1041 $w mark gravity e:$ix right
1044 set n [llength $treecontents($dir)]
1045 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1048 incr treeheight($x) $n
1050 foreach e $treecontents($dir) {
1052 if {[string index $e end] eq "/"} {
1053 set iy $treeindex($de)
1054 $w mark set d:$iy e:$ix
1055 $w mark gravity d:$iy left
1056 $w insert e:$ix $str
1057 set treediropen($de) 0
1058 $w image create e:$ix -align center -image tri-rt -padx 1 \
1060 $w insert e:$ix $e [highlight_tag $de]
1061 $w mark set s:$iy e:$ix
1062 $w mark gravity s:$iy left
1063 set treeheight($de) 1
1065 $w insert e:$ix $str
1066 $w insert e:$ix $e [highlight_tag $de]
1069 $w mark gravity e:$ix left
1070 $w conf -state disabled
1071 set treediropen($dir) 1
1072 set top [lindex [split [$w index @0,0] .] 0]
1073 set ht [$w cget -height]
1074 set l [lindex [split [$w index s:$ix] .] 0]
1077 } elseif {$l + $n + 1 > $top + $ht} {
1078 set top [expr {$l + $n + 2 - $ht}]
1086 proc treeclick {w x y} {
1087 global treediropen cmitmode ctext cflist cflist_top
1089 if {$cmitmode ne "tree"} return
1090 if {![info exists cflist_top]} return
1091 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1092 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1093 $cflist tag add highlight $l.0 "$l.0 lineend"
1099 set e [linetoelt $l]
1100 if {[string index $e end] ne "/"} {
1102 } elseif {$treediropen($e)} {
1109 proc setfilelist {id} {
1110 global treefilelist cflist
1112 treeview $cflist $treefilelist($id) 0
1115 image create bitmap tri-rt -background black -foreground blue -data {
1116 #define tri-rt_width 13
1117 #define tri-rt_height 13
1118 static unsigned char tri-rt_bits[] = {
1119 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1120 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1123 #define tri-rt-mask_width 13
1124 #define tri-rt-mask_height 13
1125 static unsigned char tri-rt-mask_bits[] = {
1126 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1127 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1130 image create bitmap tri-dn -background black -foreground blue -data {
1131 #define tri-dn_width 13
1132 #define tri-dn_height 13
1133 static unsigned char tri-dn_bits[] = {
1134 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1135 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1138 #define tri-dn-mask_width 13
1139 #define tri-dn-mask_height 13
1140 static unsigned char tri-dn-mask_bits[] = {
1141 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1142 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1146 proc init_flist {first} {
1147 global cflist cflist_top selectedline difffilestart
1149 $cflist conf -state normal
1150 $cflist delete 0.0 end
1152 $cflist insert end $first
1154 $cflist tag add highlight 1.0 "1.0 lineend"
1156 catch {unset cflist_top}
1158 $cflist conf -state disabled
1159 set difffilestart {}
1162 proc highlight_tag {f} {
1163 global highlight_paths
1165 foreach p $highlight_paths {
1166 if {[string match $p $f]} {
1173 proc highlight_filelist {} {
1174 global cmitmode cflist
1176 $cflist conf -state normal
1177 if {$cmitmode ne "tree"} {
1178 set end [lindex [split [$cflist index end] .] 0]
1179 for {set l 2} {$l < $end} {incr l} {
1180 set line [$cflist get $l.0 "$l.0 lineend"]
1181 if {[highlight_tag $line] ne {}} {
1182 $cflist tag add bold $l.0 "$l.0 lineend"
1188 $cflist conf -state disabled
1191 proc unhighlight_filelist {} {
1194 $cflist conf -state normal
1195 $cflist tag remove bold 1.0 end
1196 $cflist conf -state disabled
1199 proc add_flist {fl} {
1202 $cflist conf -state normal
1204 $cflist insert end "\n"
1205 $cflist insert end $f [highlight_tag $f]
1207 $cflist conf -state disabled
1210 proc sel_flist {w x y} {
1211 global ctext difffilestart cflist cflist_top cmitmode
1213 if {$cmitmode eq "tree"} return
1214 if {![info exists cflist_top]} return
1215 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1216 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1217 $cflist tag add highlight $l.0 "$l.0 lineend"
1222 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1226 # Functions for adding and removing shell-type quoting
1228 proc shellquote {str} {
1229 if {![string match "*\['\"\\ \t]*" $str]} {
1232 if {![string match "*\['\"\\]*" $str]} {
1235 if {![string match "*'*" $str]} {
1238 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1241 proc shellarglist {l} {
1247 append str [shellquote $a]
1252 proc shelldequote {str} {
1257 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1258 append ret [string range $str $used end]
1259 set used [string length $str]
1262 set first [lindex $first 0]
1263 set ch [string index $str $first]
1264 if {$first > $used} {
1265 append ret [string range $str $used [expr {$first - 1}]]
1268 if {$ch eq " " || $ch eq "\t"} break
1271 set first [string first "'" $str $used]
1273 error "unmatched single-quote"
1275 append ret [string range $str $used [expr {$first - 1}]]
1280 if {$used >= [string length $str]} {
1281 error "trailing backslash"
1283 append ret [string index $str $used]
1288 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1289 error "unmatched double-quote"
1291 set first [lindex $first 0]
1292 set ch [string index $str $first]
1293 if {$first > $used} {
1294 append ret [string range $str $used [expr {$first - 1}]]
1297 if {$ch eq "\""} break
1299 append ret [string index $str $used]
1303 return [list $used $ret]
1306 proc shellsplit {str} {
1309 set str [string trimleft $str]
1310 if {$str eq {}} break
1311 set dq [shelldequote $str]
1312 set n [lindex $dq 0]
1313 set word [lindex $dq 1]
1314 set str [string range $str $n end]
1320 # Code to implement multiple views
1322 proc newview {ishighlight} {
1323 global nextviewnum newviewname newviewperm uifont newishighlight
1324 global newviewargs revtreeargs
1326 set newishighlight $ishighlight
1328 if {[winfo exists $top]} {
1332 set newviewname($nextviewnum) "View $nextviewnum"
1333 set newviewperm($nextviewnum) 0
1334 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1335 vieweditor $top $nextviewnum "Gitk view definition"
1340 global viewname viewperm newviewname newviewperm
1341 global viewargs newviewargs
1343 set top .gitkvedit-$curview
1344 if {[winfo exists $top]} {
1348 set newviewname($curview) $viewname($curview)
1349 set newviewperm($curview) $viewperm($curview)
1350 set newviewargs($curview) [shellarglist $viewargs($curview)]
1351 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1354 proc vieweditor {top n title} {
1355 global newviewname newviewperm viewfiles
1359 wm title $top $title
1360 label $top.nl -text "Name" -font $uifont
1361 entry $top.name -width 20 -textvariable newviewname($n)
1362 grid $top.nl $top.name -sticky w -pady 5
1363 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1364 grid $top.perm - -pady 5 -sticky w
1365 message $top.al -aspect 1000 -font $uifont \
1366 -text "Commits to include (arguments to git-rev-list):"
1367 grid $top.al - -sticky w -pady 5
1368 entry $top.args -width 50 -textvariable newviewargs($n) \
1370 grid $top.args - -sticky ew -padx 5
1371 message $top.l -aspect 1000 -font $uifont \
1372 -text "Enter files and directories to include, one per line:"
1373 grid $top.l - -sticky w
1374 text $top.t -width 40 -height 10 -background white
1375 if {[info exists viewfiles($n)]} {
1376 foreach f $viewfiles($n) {
1377 $top.t insert end $f
1378 $top.t insert end "\n"
1380 $top.t delete {end - 1c} end
1381 $top.t mark set insert 0.0
1383 grid $top.t - -sticky ew -padx 5
1385 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1386 button $top.buts.can -text "Cancel" -command [list destroy $top]
1387 grid $top.buts.ok $top.buts.can
1388 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1389 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1390 grid $top.buts - -pady 10 -sticky ew
1394 proc doviewmenu {m first cmd op argv} {
1395 set nmenu [$m index end]
1396 for {set i $first} {$i <= $nmenu} {incr i} {
1397 if {[$m entrycget $i -command] eq $cmd} {
1398 eval $m $op $i $argv
1404 proc allviewmenus {n op args} {
1407 doviewmenu .bar.view 7 [list showview $n] $op $args
1408 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1411 proc newviewok {top n} {
1412 global nextviewnum newviewperm newviewname newishighlight
1413 global viewname viewfiles viewperm selectedview curview
1414 global viewargs newviewargs viewhlmenu
1417 set newargs [shellsplit $newviewargs($n)]
1419 error_popup "Error in commit selection arguments: $err"
1425 foreach f [split [$top.t get 0.0 end] "\n"] {
1426 set ft [string trim $f]
1431 if {![info exists viewfiles($n)]} {
1432 # creating a new view
1434 set viewname($n) $newviewname($n)
1435 set viewperm($n) $newviewperm($n)
1436 set viewfiles($n) $files
1437 set viewargs($n) $newargs
1439 if {!$newishighlight} {
1440 after idle showview $n
1442 after idle addvhighlight $n
1445 # editing an existing view
1446 set viewperm($n) $newviewperm($n)
1447 if {$newviewname($n) ne $viewname($n)} {
1448 set viewname($n) $newviewname($n)
1449 doviewmenu .bar.view 7 [list showview $n] \
1450 entryconf [list -label $viewname($n)]
1451 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1452 entryconf [list -label $viewname($n) -value $viewname($n)]
1454 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1455 set viewfiles($n) $files
1456 set viewargs($n) $newargs
1457 if {$curview == $n} {
1458 after idle updatecommits
1462 catch {destroy $top}
1466 global curview viewdata viewperm hlview selectedhlview
1468 if {$curview == 0} return
1469 if {[info exists hlview] && $hlview == $curview} {
1470 set selectedhlview None
1473 allviewmenus $curview delete
1474 set viewdata($curview) {}
1475 set viewperm($curview) 0
1479 proc addviewmenu {n} {
1480 global viewname viewhlmenu
1482 .bar.view add radiobutton -label $viewname($n) \
1483 -command [list showview $n] -variable selectedview -value $n
1484 $viewhlmenu add radiobutton -label $viewname($n) \
1485 -command [list addvhighlight $n] -variable selectedhlview
1488 proc flatten {var} {
1492 foreach i [array names $var] {
1493 lappend ret $i [set $var\($i\)]
1498 proc unflatten {var l} {
1508 global curview viewdata viewfiles
1509 global displayorder parentlist childlist rowidlist rowoffsets
1510 global colormap rowtextx commitrow nextcolor canvxmax
1511 global numcommits rowrangelist commitlisted idrowranges
1512 global selectedline currentid canv canvy0
1513 global matchinglines treediffs
1514 global pending_select phase
1515 global commitidx rowlaidout rowoptim linesegends
1516 global commfd nextupdate
1518 global vparentlist vchildlist vdisporder vcmitlisted
1519 global hlview selectedhlview
1521 if {$n == $curview} return
1523 if {[info exists selectedline]} {
1524 set selid $currentid
1525 set y [yc $selectedline]
1526 set ymax [lindex [$canv cget -scrollregion] 3]
1527 set span [$canv yview]
1528 set ytop [expr {[lindex $span 0] * $ymax}]
1529 set ybot [expr {[lindex $span 1] * $ymax}]
1530 if {$ytop < $y && $y < $ybot} {
1531 set yscreen [expr {$y - $ytop}]
1533 set yscreen [expr {($ybot - $ytop) / 2}]
1539 if {$curview >= 0} {
1540 set vparentlist($curview) $parentlist
1541 set vchildlist($curview) $childlist
1542 set vdisporder($curview) $displayorder
1543 set vcmitlisted($curview) $commitlisted
1545 set viewdata($curview) \
1546 [list $phase $rowidlist $rowoffsets $rowrangelist \
1547 [flatten idrowranges] [flatten idinlist] \
1548 $rowlaidout $rowoptim $numcommits $linesegends]
1549 } elseif {![info exists viewdata($curview)]
1550 || [lindex $viewdata($curview) 0] ne {}} {
1551 set viewdata($curview) \
1552 [list {} $rowidlist $rowoffsets $rowrangelist]
1555 catch {unset matchinglines}
1556 catch {unset treediffs}
1558 if {[info exists hlview] && $hlview == $n} {
1560 set selectedhlview None
1565 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1566 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1568 if {![info exists viewdata($n)]} {
1569 set pending_select $selid
1575 set phase [lindex $v 0]
1576 set displayorder $vdisporder($n)
1577 set parentlist $vparentlist($n)
1578 set childlist $vchildlist($n)
1579 set commitlisted $vcmitlisted($n)
1580 set rowidlist [lindex $v 1]
1581 set rowoffsets [lindex $v 2]
1582 set rowrangelist [lindex $v 3]
1584 set numcommits [llength $displayorder]
1585 catch {unset idrowranges}
1587 unflatten idrowranges [lindex $v 4]
1588 unflatten idinlist [lindex $v 5]
1589 set rowlaidout [lindex $v 6]
1590 set rowoptim [lindex $v 7]
1591 set numcommits [lindex $v 8]
1592 set linesegends [lindex $v 9]
1595 catch {unset colormap}
1596 catch {unset rowtextx}
1598 set canvxmax [$canv cget -width]
1604 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1605 set row $commitrow($n,$selid)
1606 # try to get the selected row in the same position on the screen
1607 set ymax [lindex [$canv cget -scrollregion] 3]
1608 set ytop [expr {[yc $row] - $yscreen}]
1612 set yf [expr {$ytop * 1.0 / $ymax}]
1614 allcanvs yview moveto $yf
1618 if {$phase eq "getcommits"} {
1619 show_status "Reading commits..."
1621 if {[info exists commfd($n)]} {
1626 } elseif {$numcommits == 0} {
1627 show_status "No commits selected"
1631 # Stuff relating to the highlighting facility
1633 proc ishighlighted {row} {
1634 global vhighlights fhighlights nhighlights
1636 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1637 return $nhighlights($row)
1639 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1640 return $vhighlights($row)
1642 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1643 return $fhighlights($row)
1648 proc bolden {row font} {
1649 global canv linehtag selectedline
1651 $canv itemconf $linehtag($row) -font $font
1652 if {$row == $selectedline} {
1654 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1655 -outline {{}} -tags secsel \
1656 -fill [$canv cget -selectbackground]]
1661 proc bolden_name {row font} {
1662 global canv2 linentag selectedline
1664 $canv2 itemconf $linentag($row) -font $font
1665 if {$row == $selectedline} {
1666 $canv2 delete secsel
1667 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1668 -outline {{}} -tags secsel \
1669 -fill [$canv2 cget -selectbackground]]
1674 proc unbolden {rows} {
1678 if {![ishighlighted $row]} {
1679 bolden $row $mainfont
1684 proc addvhighlight {n} {
1685 global hlview curview viewdata vhl_done vhighlights commitidx
1687 if {[info exists hlview]} {
1691 if {$n != $curview && ![info exists viewdata($n)]} {
1692 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1693 set vparentlist($n) {}
1694 set vchildlist($n) {}
1695 set vdisporder($n) {}
1696 set vcmitlisted($n) {}
1699 set vhl_done $commitidx($hlview)
1700 if {$vhl_done > 0} {
1705 proc delvhighlight {} {
1706 global hlview vhighlights
1709 if {![info exists hlview]} return
1711 set rows [array names vhighlights]
1718 proc vhighlightmore {} {
1719 global hlview vhl_done commitidx vhighlights
1720 global displayorder vdisporder curview mainfont
1722 set font [concat $mainfont bold]
1723 set max $commitidx($hlview)
1724 if {$hlview == $curview} {
1725 set disp $displayorder
1727 set disp $vdisporder($hlview)
1729 set vr [visiblerows]
1730 set r0 [lindex $vr 0]
1731 set r1 [lindex $vr 1]
1732 for {set i $vhl_done} {$i < $max} {incr i} {
1733 set id [lindex $disp $i]
1734 if {[info exists commitrow($curview,$id)]} {
1735 set row $commitrow($curview,$id)
1736 if {$r0 <= $row && $row <= $r1} {
1737 if {![highlighted $row]} {
1740 set vhighlights($row) 1
1747 proc askvhighlight {row id} {
1748 global hlview vhighlights commitrow iddrawn mainfont
1750 if {[info exists commitrow($hlview,$id)]} {
1751 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1752 bolden $row [concat $mainfont bold]
1754 set vhighlights($row) 1
1756 set vhighlights($row) 0
1760 proc hfiles_change {name ix op} {
1761 global highlight_files filehighlight fhighlights fh_serial
1762 global mainfont highlight_paths
1764 if {[info exists filehighlight]} {
1765 # delete previous highlights
1766 catch {close $filehighlight}
1768 set rows [array names fhighlights]
1773 unhighlight_filelist
1775 set highlight_paths {}
1776 after cancel do_file_hl $fh_serial
1778 if {$highlight_files ne {}} {
1779 after 300 do_file_hl $fh_serial
1783 proc makepatterns {l} {
1786 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1787 if {[string index $ee end] eq "/"} {
1797 proc do_file_hl {serial} {
1798 global highlight_files filehighlight highlight_paths
1800 if {[catch {set paths [shellsplit $highlight_files]}]} return
1801 set highlight_paths [makepatterns $paths]
1803 set cmd [concat | git-diff-tree -r -s --stdin -- $paths]
1804 set filehighlight [open $cmd r+]
1805 fconfigure $filehighlight -blocking 0
1806 fileevent $filehighlight readable readfhighlight
1811 proc flushhighlights {} {
1812 global filehighlight
1814 if {[info exists filehighlight]} {
1815 puts $filehighlight ""
1816 flush $filehighlight
1820 proc askfilehighlight {row id} {
1821 global filehighlight fhighlights
1823 set fhighlights($row) 0
1824 puts $filehighlight $id
1827 proc readfhighlight {} {
1828 global filehighlight fhighlights commitrow curview mainfont iddrawn
1830 set n [gets $filehighlight line]
1832 if {[eof $filehighlight]} {
1834 puts "oops, git-diff-tree died"
1835 catch {close $filehighlight}
1840 set line [string trim $line]
1841 if {$line eq {}} return
1842 if {![info exists commitrow($curview,$line)]} return
1843 set row $commitrow($curview,$line)
1844 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1845 bolden $row [concat $mainfont bold]
1847 set fhighlights($row) 1
1850 proc hnames_change {name ix op} {
1851 global highlight_names nhighlights nhl_names mainfont
1853 # delete previous highlights, if any
1854 set rows [array names nhighlights]
1857 if {$nhighlights($row) >= 2} {
1858 bolden_name $row $mainfont
1864 if {[catch {set nhl_names [shellsplit $highlight_names]}]} {
1871 proc asknamehighlight {row id} {
1872 global nhl_names nhighlights commitinfo iddrawn mainfont
1874 if {![info exists commitinfo($id)]} {
1878 set author [lindex $commitinfo($id) 1]
1879 set committer [lindex $commitinfo($id) 3]
1880 foreach name $nhl_names {
1881 set pattern "*$name*"
1882 if {[string match -nocase $pattern $author]} {
1886 if {!$isbold && [string match -nocase $pattern $committer]} {
1890 if {[info exists iddrawn($id)]} {
1891 if {$isbold && ![ishighlighted $row]} {
1892 bolden $row [concat $mainfont bold]
1895 bolden_name $row [concat $mainfont bold]
1898 set nhighlights($row) $isbold
1901 # Graph layout functions
1903 proc shortids {ids} {
1906 if {[llength $id] > 1} {
1907 lappend res [shortids $id]
1908 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1909 lappend res [string range $id 0 7]
1917 proc incrange {l x o} {
1920 set e [lindex $l $x]
1922 lset l $x [expr {$e + $o}]
1931 for {} {$n > 0} {incr n -1} {
1937 proc usedinrange {id l1 l2} {
1938 global children commitrow childlist curview
1940 if {[info exists commitrow($curview,$id)]} {
1941 set r $commitrow($curview,$id)
1942 if {$l1 <= $r && $r <= $l2} {
1943 return [expr {$r - $l1 + 1}]
1945 set kids [lindex $childlist $r]
1947 set kids $children($curview,$id)
1950 set r $commitrow($curview,$c)
1951 if {$l1 <= $r && $r <= $l2} {
1952 return [expr {$r - $l1 + 1}]
1958 proc sanity {row {full 0}} {
1959 global rowidlist rowoffsets
1962 set ids [lindex $rowidlist $row]
1965 if {$id eq {}} continue
1966 if {$col < [llength $ids] - 1 &&
1967 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1968 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1970 set o [lindex $rowoffsets $row $col]
1976 if {[lindex $rowidlist $y $x] != $id} {
1977 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1978 puts " id=[shortids $id] check started at row $row"
1979 for {set i $row} {$i >= $y} {incr i -1} {
1980 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1985 set o [lindex $rowoffsets $y $x]
1990 proc makeuparrow {oid x y z} {
1991 global rowidlist rowoffsets uparrowlen idrowranges
1993 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1996 set off0 [lindex $rowoffsets $y]
1997 for {set x0 $x} {1} {incr x0} {
1998 if {$x0 >= [llength $off0]} {
1999 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2002 set z [lindex $off0 $x0]
2008 set z [expr {$x0 - $x}]
2009 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2010 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2012 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2013 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2014 lappend idrowranges($oid) $y
2017 proc initlayout {} {
2018 global rowidlist rowoffsets displayorder commitlisted
2019 global rowlaidout rowoptim
2020 global idinlist rowchk rowrangelist idrowranges
2021 global numcommits canvxmax canv
2023 global parentlist childlist children
2024 global colormap rowtextx
2036 catch {unset idinlist}
2037 catch {unset rowchk}
2040 set canvxmax [$canv cget -width]
2041 catch {unset colormap}
2042 catch {unset rowtextx}
2043 catch {unset idrowranges}
2047 proc setcanvscroll {} {
2048 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2050 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2051 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2052 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2053 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2056 proc visiblerows {} {
2057 global canv numcommits linespc
2059 set ymax [lindex [$canv cget -scrollregion] 3]
2060 if {$ymax eq {} || $ymax == 0} return
2062 set y0 [expr {int([lindex $f 0] * $ymax)}]
2063 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2067 set y1 [expr {int([lindex $f 1] * $ymax)}]
2068 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2069 if {$r1 >= $numcommits} {
2070 set r1 [expr {$numcommits - 1}]
2072 return [list $r0 $r1]
2075 proc layoutmore {} {
2076 global rowlaidout rowoptim commitidx numcommits optim_delay
2077 global uparrowlen curview
2080 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2081 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2082 if {$orow > $rowoptim} {
2083 optimize_rows $rowoptim 0 $orow
2086 set canshow [expr {$rowoptim - $optim_delay}]
2087 if {$canshow > $numcommits} {
2092 proc showstuff {canshow} {
2093 global numcommits commitrow pending_select selectedline
2094 global linesegends idrowranges idrangedrawn curview
2096 if {$numcommits == 0} {
2098 set phase "incrdraw"
2102 set numcommits $canshow
2104 set rows [visiblerows]
2105 set r0 [lindex $rows 0]
2106 set r1 [lindex $rows 1]
2108 for {set r $row} {$r < $canshow} {incr r} {
2109 foreach id [lindex $linesegends [expr {$r+1}]] {
2111 foreach {s e} [rowranges $id] {
2113 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2114 && ![info exists idrangedrawn($id,$i)]} {
2116 set idrangedrawn($id,$i) 1
2121 if {$canshow > $r1} {
2124 while {$row < $canshow} {
2128 if {[info exists pending_select] &&
2129 [info exists commitrow($curview,$pending_select)] &&
2130 $commitrow($curview,$pending_select) < $numcommits} {
2131 selectline $commitrow($curview,$pending_select) 1
2133 if {![info exists selectedline] && ![info exists pending_select]} {
2138 proc layoutrows {row endrow last} {
2139 global rowidlist rowoffsets displayorder
2140 global uparrowlen downarrowlen maxwidth mingaplen
2141 global childlist parentlist
2142 global idrowranges linesegends
2143 global commitidx curview
2144 global idinlist rowchk rowrangelist
2146 set idlist [lindex $rowidlist $row]
2147 set offs [lindex $rowoffsets $row]
2148 while {$row < $endrow} {
2149 set id [lindex $displayorder $row]
2152 foreach p [lindex $parentlist $row] {
2153 if {![info exists idinlist($p)]} {
2155 } elseif {!$idinlist($p)} {
2160 set nev [expr {[llength $idlist] + [llength $newolds]
2161 + [llength $oldolds] - $maxwidth + 1}]
2164 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2165 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2166 set i [lindex $idlist $x]
2167 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2168 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2169 [expr {$row + $uparrowlen + $mingaplen}]]
2171 set idlist [lreplace $idlist $x $x]
2172 set offs [lreplace $offs $x $x]
2173 set offs [incrange $offs $x 1]
2175 set rm1 [expr {$row - 1}]
2177 lappend idrowranges($i) $rm1
2178 if {[incr nev -1] <= 0} break
2181 set rowchk($id) [expr {$row + $r}]
2184 lset rowidlist $row $idlist
2185 lset rowoffsets $row $offs
2187 lappend linesegends $lse
2188 set col [lsearch -exact $idlist $id]
2190 set col [llength $idlist]
2192 lset rowidlist $row $idlist
2194 if {[lindex $childlist $row] ne {}} {
2195 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2199 lset rowoffsets $row $offs
2201 makeuparrow $id $col $row $z
2207 if {[info exists idrowranges($id)]} {
2208 set ranges $idrowranges($id)
2210 unset idrowranges($id)
2212 lappend rowrangelist $ranges
2214 set offs [ntimes [llength $idlist] 0]
2215 set l [llength $newolds]
2216 set idlist [eval lreplace \$idlist $col $col $newolds]
2219 set offs [lrange $offs 0 [expr {$col - 1}]]
2220 foreach x $newolds {
2225 set tmp [expr {[llength $idlist] - [llength $offs]}]
2227 set offs [concat $offs [ntimes $tmp $o]]
2232 foreach i $newolds {
2234 set idrowranges($i) $row
2237 foreach oid $oldolds {
2238 set idinlist($oid) 1
2239 set idlist [linsert $idlist $col $oid]
2240 set offs [linsert $offs $col $o]
2241 makeuparrow $oid $col $row $o
2244 lappend rowidlist $idlist
2245 lappend rowoffsets $offs
2250 proc addextraid {id row} {
2251 global displayorder commitrow commitinfo
2252 global commitidx commitlisted
2253 global parentlist childlist children curview
2255 incr commitidx($curview)
2256 lappend displayorder $id
2257 lappend commitlisted 0
2258 lappend parentlist {}
2259 set commitrow($curview,$id) $row
2261 if {![info exists commitinfo($id)]} {
2262 set commitinfo($id) {"No commit information available"}
2264 if {![info exists children($curview,$id)]} {
2265 set children($curview,$id) {}
2267 lappend childlist $children($curview,$id)
2270 proc layouttail {} {
2271 global rowidlist rowoffsets idinlist commitidx curview
2272 global idrowranges rowrangelist
2274 set row $commitidx($curview)
2275 set idlist [lindex $rowidlist $row]
2276 while {$idlist ne {}} {
2277 set col [expr {[llength $idlist] - 1}]
2278 set id [lindex $idlist $col]
2281 lappend idrowranges($id) $row
2282 lappend rowrangelist $idrowranges($id)
2283 unset idrowranges($id)
2285 set offs [ntimes $col 0]
2286 set idlist [lreplace $idlist $col $col]
2287 lappend rowidlist $idlist
2288 lappend rowoffsets $offs
2291 foreach id [array names idinlist] {
2293 lset rowidlist $row [list $id]
2294 lset rowoffsets $row 0
2295 makeuparrow $id 0 $row 0
2296 lappend idrowranges($id) $row
2297 lappend rowrangelist $idrowranges($id)
2298 unset idrowranges($id)
2300 lappend rowidlist {}
2301 lappend rowoffsets {}
2305 proc insert_pad {row col npad} {
2306 global rowidlist rowoffsets
2308 set pad [ntimes $npad {}]
2309 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2310 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2311 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2314 proc optimize_rows {row col endrow} {
2315 global rowidlist rowoffsets idrowranges displayorder
2317 for {} {$row < $endrow} {incr row} {
2318 set idlist [lindex $rowidlist $row]
2319 set offs [lindex $rowoffsets $row]
2321 for {} {$col < [llength $offs]} {incr col} {
2322 if {[lindex $idlist $col] eq {}} {
2326 set z [lindex $offs $col]
2327 if {$z eq {}} continue
2329 set x0 [expr {$col + $z}]
2330 set y0 [expr {$row - 1}]
2331 set z0 [lindex $rowoffsets $y0 $x0]
2333 set id [lindex $idlist $col]
2334 set ranges [rowranges $id]
2335 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2339 if {$z < -1 || ($z < 0 && $isarrow)} {
2340 set npad [expr {-1 - $z + $isarrow}]
2341 set offs [incrange $offs $col $npad]
2342 insert_pad $y0 $x0 $npad
2344 optimize_rows $y0 $x0 $row
2346 set z [lindex $offs $col]
2347 set x0 [expr {$col + $z}]
2348 set z0 [lindex $rowoffsets $y0 $x0]
2349 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2350 set npad [expr {$z - 1 + $isarrow}]
2351 set y1 [expr {$row + 1}]
2352 set offs2 [lindex $rowoffsets $y1]
2356 if {$z eq {} || $x1 + $z < $col} continue
2357 if {$x1 + $z > $col} {
2360 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2363 set pad [ntimes $npad {}]
2364 set idlist [eval linsert \$idlist $col $pad]
2365 set tmp [eval linsert \$offs $col $pad]
2367 set offs [incrange $tmp $col [expr {-$npad}]]
2368 set z [lindex $offs $col]
2371 if {$z0 eq {} && !$isarrow} {
2372 # this line links to its first child on row $row-2
2373 set rm2 [expr {$row - 2}]
2374 set id [lindex $displayorder $rm2]
2375 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2377 set z0 [expr {$xc - $x0}]
2380 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2381 insert_pad $y0 $x0 1
2382 set offs [incrange $offs $col 1]
2383 optimize_rows $y0 [expr {$x0 + 1}] $row
2388 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2389 set o [lindex $offs $col]
2391 # check if this is the link to the first child
2392 set id [lindex $idlist $col]
2393 set ranges [rowranges $id]
2394 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2395 # it is, work out offset to child
2396 set y0 [expr {$row - 1}]
2397 set id [lindex $displayorder $y0]
2398 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2400 set o [expr {$x0 - $col}]
2404 if {$o eq {} || $o <= 0} break
2406 if {$o ne {} && [incr col] < [llength $idlist]} {
2407 set y1 [expr {$row + 1}]
2408 set offs2 [lindex $rowoffsets $y1]
2412 if {$z eq {} || $x1 + $z < $col} continue
2413 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2416 set idlist [linsert $idlist $col {}]
2417 set tmp [linsert $offs $col {}]
2419 set offs [incrange $tmp $col -1]
2422 lset rowidlist $row $idlist
2423 lset rowoffsets $row $offs
2429 global canvx0 linespc
2430 return [expr {$canvx0 + $col * $linespc}]
2434 global canvy0 linespc
2435 return [expr {$canvy0 + $row * $linespc}]
2438 proc linewidth {id} {
2439 global thickerline lthickness
2442 if {[info exists thickerline] && $id eq $thickerline} {
2443 set wid [expr {2 * $lthickness}]
2448 proc rowranges {id} {
2449 global phase idrowranges commitrow rowlaidout rowrangelist curview
2453 ([info exists commitrow($curview,$id)]
2454 && $commitrow($curview,$id) < $rowlaidout)} {
2455 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2456 } elseif {[info exists idrowranges($id)]} {
2457 set ranges $idrowranges($id)
2462 proc drawlineseg {id i} {
2463 global rowoffsets rowidlist
2465 global canv colormap linespc
2466 global numcommits commitrow curview
2468 set ranges [rowranges $id]
2470 if {[info exists commitrow($curview,$id)]
2471 && $commitrow($curview,$id) < $numcommits} {
2472 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2476 set startrow [lindex $ranges [expr {2 * $i}]]
2477 set row [lindex $ranges [expr {2 * $i + 1}]]
2478 if {$startrow == $row} return
2481 set col [lsearch -exact [lindex $rowidlist $row] $id]
2483 puts "oops: drawline: id $id not on row $row"
2489 set o [lindex $rowoffsets $row $col]
2492 # changing direction
2493 set x [xc $row $col]
2495 lappend coords $x $y
2501 set x [xc $row $col]
2503 lappend coords $x $y
2505 # draw the link to the first child as part of this line
2507 set child [lindex $displayorder $row]
2508 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2510 set x [xc $row $ccol]
2512 if {$ccol < $col - 1} {
2513 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2514 } elseif {$ccol > $col + 1} {
2515 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2517 lappend coords $x $y
2520 if {[llength $coords] < 4} return
2522 # This line has an arrow at the lower end: check if the arrow is
2523 # on a diagonal segment, and if so, work around the Tk 8.4
2524 # refusal to draw arrows on diagonal lines.
2525 set x0 [lindex $coords 0]
2526 set x1 [lindex $coords 2]
2528 set y0 [lindex $coords 1]
2529 set y1 [lindex $coords 3]
2530 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2531 # we have a nearby vertical segment, just trim off the diag bit
2532 set coords [lrange $coords 2 end]
2534 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2535 set xi [expr {$x0 - $slope * $linespc / 2}]
2536 set yi [expr {$y0 - $linespc / 2}]
2537 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2541 set arrow [expr {2 * ($i > 0) + $downarrow}]
2542 set arrow [lindex {none first last both} $arrow]
2543 set t [$canv create line $coords -width [linewidth $id] \
2544 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2549 proc drawparentlinks {id row col olds} {
2550 global rowidlist canv colormap
2552 set row2 [expr {$row + 1}]
2553 set x [xc $row $col]
2556 set ids [lindex $rowidlist $row2]
2557 # rmx = right-most X coord used
2560 set i [lsearch -exact $ids $p]
2562 puts "oops, parent $p of $id not in list"
2565 set x2 [xc $row2 $i]
2569 set ranges [rowranges $p]
2570 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2571 && $row2 < [lindex $ranges 1]} {
2572 # drawlineseg will do this one for us
2576 # should handle duplicated parents here...
2577 set coords [list $x $y]
2578 if {$i < $col - 1} {
2579 lappend coords [xc $row [expr {$i + 1}]] $y
2580 } elseif {$i > $col + 1} {
2581 lappend coords [xc $row [expr {$i - 1}]] $y
2583 lappend coords $x2 $y2
2584 set t [$canv create line $coords -width [linewidth $p] \
2585 -fill $colormap($p) -tags lines.$p]
2592 proc drawlines {id} {
2593 global colormap canv
2595 global children iddrawn commitrow rowidlist curview
2597 $canv delete lines.$id
2598 set nr [expr {[llength [rowranges $id]] / 2}]
2599 for {set i 0} {$i < $nr} {incr i} {
2600 if {[info exists idrangedrawn($id,$i)]} {
2604 foreach child $children($curview,$id) {
2605 if {[info exists iddrawn($child)]} {
2606 set row $commitrow($curview,$child)
2607 set col [lsearch -exact [lindex $rowidlist $row] $child]
2609 drawparentlinks $child $row $col [list $id]
2615 proc drawcmittext {id row col rmx} {
2616 global linespc canv canv2 canv3 canvy0
2617 global commitlisted commitinfo rowidlist
2618 global rowtextx idpos idtags idheads idotherrefs
2619 global linehtag linentag linedtag
2620 global mainfont canvxmax
2622 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2623 set x [xc $row $col]
2625 set orad [expr {$linespc / 3}]
2626 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2627 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2628 -fill $ofill -outline black -width 1]
2630 $canv bind $t <1> {selcanvline {} %x %y}
2631 set xt [xc $row [llength [lindex $rowidlist $row]]]
2635 set rowtextx($row) $xt
2636 set idpos($id) [list $x $xt $y]
2637 if {[info exists idtags($id)] || [info exists idheads($id)]
2638 || [info exists idotherrefs($id)]} {
2639 set xt [drawtags $id $x $xt $y]
2641 set headline [lindex $commitinfo($id) 0]
2642 set name [lindex $commitinfo($id) 1]
2643 set date [lindex $commitinfo($id) 2]
2644 set date [formatdate $date]
2647 set isbold [ishighlighted $row]
2654 set linehtag($row) [$canv create text $xt $y -anchor w \
2655 -text $headline -font $font]
2656 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2657 set linentag($row) [$canv2 create text 3 $y -anchor w \
2658 -text $name -font $nfont]
2659 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2660 -text $date -font $mainfont]
2661 set xr [expr {$xt + [font measure $mainfont $headline]}]
2662 if {$xr > $canvxmax} {
2668 proc drawcmitrow {row} {
2669 global displayorder rowidlist
2670 global idrangedrawn iddrawn
2671 global commitinfo parentlist numcommits
2672 global filehighlight fhighlights nhl_names nhighlights
2673 global hlview vhighlights
2675 if {$row >= $numcommits} return
2676 foreach id [lindex $rowidlist $row] {
2677 if {$id eq {}} continue
2679 foreach {s e} [rowranges $id] {
2681 if {$row < $s} continue
2684 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2686 set idrangedrawn($id,$i) 1
2693 set id [lindex $displayorder $row]
2694 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2695 askvhighlight $row $id
2697 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2698 askfilehighlight $row $id
2700 if {$nhl_names ne {} && ![info exists nhighlights($row)]} {
2701 asknamehighlight $row $id
2703 if {[info exists iddrawn($id)]} return
2704 set col [lsearch -exact [lindex $rowidlist $row] $id]
2706 puts "oops, row $row id $id not in list"
2709 if {![info exists commitinfo($id)]} {
2713 set olds [lindex $parentlist $row]
2715 set rmx [drawparentlinks $id $row $col $olds]
2719 drawcmittext $id $row $col $rmx
2723 proc drawfrac {f0 f1} {
2724 global numcommits canv
2727 set ymax [lindex [$canv cget -scrollregion] 3]
2728 if {$ymax eq {} || $ymax == 0} return
2729 set y0 [expr {int($f0 * $ymax)}]
2730 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2734 set y1 [expr {int($f1 * $ymax)}]
2735 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2736 if {$endrow >= $numcommits} {
2737 set endrow [expr {$numcommits - 1}]
2739 for {} {$row <= $endrow} {incr row} {
2744 proc drawvisible {} {
2746 eval drawfrac [$canv yview]
2749 proc clear_display {} {
2750 global iddrawn idrangedrawn
2751 global vhighlights fhighlights nhighlights
2754 catch {unset iddrawn}
2755 catch {unset idrangedrawn}
2756 catch {unset vhighlights}
2757 catch {unset fhighlights}
2758 catch {unset nhighlights}
2761 proc findcrossings {id} {
2762 global rowidlist parentlist numcommits rowoffsets displayorder
2766 foreach {s e} [rowranges $id] {
2767 if {$e >= $numcommits} {
2768 set e [expr {$numcommits - 1}]
2770 if {$e <= $s} continue
2771 set x [lsearch -exact [lindex $rowidlist $e] $id]
2773 puts "findcrossings: oops, no [shortids $id] in row $e"
2776 for {set row $e} {[incr row -1] >= $s} {} {
2777 set olds [lindex $parentlist $row]
2778 set kid [lindex $displayorder $row]
2779 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2780 if {$kidx < 0} continue
2781 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2783 set px [lsearch -exact $nextrow $p]
2784 if {$px < 0} continue
2785 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2786 if {[lsearch -exact $ccross $p] >= 0} continue
2787 if {$x == $px + ($kidx < $px? -1: 1)} {
2789 } elseif {[lsearch -exact $cross $p] < 0} {
2794 set inc [lindex $rowoffsets $row $x]
2795 if {$inc eq {}} break
2799 return [concat $ccross {{}} $cross]
2802 proc assigncolor {id} {
2803 global colormap colors nextcolor
2804 global commitrow parentlist children children curview
2806 if {[info exists colormap($id)]} return
2807 set ncolors [llength $colors]
2808 if {[info exists children($curview,$id)]} {
2809 set kids $children($curview,$id)
2813 if {[llength $kids] == 1} {
2814 set child [lindex $kids 0]
2815 if {[info exists colormap($child)]
2816 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2817 set colormap($id) $colormap($child)
2823 foreach x [findcrossings $id] {
2825 # delimiter between corner crossings and other crossings
2826 if {[llength $badcolors] >= $ncolors - 1} break
2827 set origbad $badcolors
2829 if {[info exists colormap($x)]
2830 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2831 lappend badcolors $colormap($x)
2834 if {[llength $badcolors] >= $ncolors} {
2835 set badcolors $origbad
2837 set origbad $badcolors
2838 if {[llength $badcolors] < $ncolors - 1} {
2839 foreach child $kids {
2840 if {[info exists colormap($child)]
2841 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2842 lappend badcolors $colormap($child)
2844 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2845 if {[info exists colormap($p)]
2846 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2847 lappend badcolors $colormap($p)
2851 if {[llength $badcolors] >= $ncolors} {
2852 set badcolors $origbad
2855 for {set i 0} {$i <= $ncolors} {incr i} {
2856 set c [lindex $colors $nextcolor]
2857 if {[incr nextcolor] >= $ncolors} {
2860 if {[lsearch -exact $badcolors $c]} break
2862 set colormap($id) $c
2865 proc bindline {t id} {
2868 $canv bind $t <Enter> "lineenter %x %y $id"
2869 $canv bind $t <Motion> "linemotion %x %y $id"
2870 $canv bind $t <Leave> "lineleave $id"
2871 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2874 proc drawtags {id x xt y1} {
2875 global idtags idheads idotherrefs
2876 global linespc lthickness
2877 global canv mainfont commitrow rowtextx curview
2882 if {[info exists idtags($id)]} {
2883 set marks $idtags($id)
2884 set ntags [llength $marks]
2886 if {[info exists idheads($id)]} {
2887 set marks [concat $marks $idheads($id)]
2888 set nheads [llength $idheads($id)]
2890 if {[info exists idotherrefs($id)]} {
2891 set marks [concat $marks $idotherrefs($id)]
2897 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2898 set yt [expr {$y1 - 0.5 * $linespc}]
2899 set yb [expr {$yt + $linespc - 1}]
2902 foreach tag $marks {
2903 set wid [font measure $mainfont $tag]
2906 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2908 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2909 -width $lthickness -fill black -tags tag.$id]
2911 foreach tag $marks x $xvals wid $wvals {
2912 set xl [expr {$x + $delta}]
2913 set xr [expr {$x + $delta + $wid + $lthickness}]
2914 if {[incr ntags -1] >= 0} {
2916 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2917 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2918 -width 1 -outline black -fill yellow -tags tag.$id]
2919 $canv bind $t <1> [list showtag $tag 1]
2920 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2922 # draw a head or other ref
2923 if {[incr nheads -1] >= 0} {
2928 set xl [expr {$xl - $delta/2}]
2929 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2930 -width 1 -outline black -fill $col -tags tag.$id
2931 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2932 set rwid [font measure $mainfont $remoteprefix]
2933 set xi [expr {$x + 1}]
2934 set yti [expr {$yt + 1}]
2935 set xri [expr {$x + $rwid}]
2936 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2937 -width 0 -fill "#ffddaa" -tags tag.$id
2940 set t [$canv create text $xl $y1 -anchor w -text $tag \
2941 -font $mainfont -tags tag.$id]
2943 $canv bind $t <1> [list showtag $tag 1]
2949 proc xcoord {i level ln} {
2950 global canvx0 xspc1 xspc2
2952 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2953 if {$i > 0 && $i == $level} {
2954 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2955 } elseif {$i > $level} {
2956 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2961 proc show_status {msg} {
2962 global canv mainfont
2965 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2968 proc finishcommits {} {
2969 global commitidx phase curview
2970 global canv mainfont ctext maincursor textcursor
2971 global findinprogress pending_select
2973 if {$commitidx($curview) > 0} {
2976 show_status "No commits selected"
2979 catch {unset pending_select}
2982 # Don't change the text pane cursor if it is currently the hand cursor,
2983 # showing that we are over a sha1 ID link.
2984 proc settextcursor {c} {
2985 global ctext curtextcursor
2987 if {[$ctext cget -cursor] == $curtextcursor} {
2988 $ctext config -cursor $c
2990 set curtextcursor $c
2993 proc nowbusy {what} {
2996 if {[array names isbusy] eq {}} {
2997 . config -cursor watch
3003 proc notbusy {what} {
3004 global isbusy maincursor textcursor
3006 catch {unset isbusy($what)}
3007 if {[array names isbusy] eq {}} {
3008 . config -cursor $maincursor
3009 settextcursor $textcursor
3016 global canvy0 numcommits linespc
3017 global rowlaidout commitidx curview
3018 global pending_select
3021 layoutrows $rowlaidout $commitidx($curview) 1
3023 optimize_rows $row 0 $commitidx($curview)
3024 showstuff $commitidx($curview)
3025 if {[info exists pending_select]} {
3029 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3030 #puts "overall $drawmsecs ms for $numcommits commits"
3033 proc findmatches {f} {
3034 global findtype foundstring foundstrlen
3035 if {$findtype == "Regexp"} {
3036 set matches [regexp -indices -all -inline $foundstring $f]
3038 if {$findtype == "IgnCase"} {
3039 set str [string tolower $f]
3045 while {[set j [string first $foundstring $str $i]] >= 0} {
3046 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3047 set i [expr {$j + $foundstrlen}]
3054 global findtype findloc findstring markedmatches commitinfo
3055 global numcommits displayorder linehtag linentag linedtag
3056 global mainfont canv canv2 canv3 selectedline
3057 global matchinglines foundstring foundstrlen matchstring
3063 set matchinglines {}
3064 if {$findloc == "Pickaxe"} {
3068 if {$findtype == "IgnCase"} {
3069 set foundstring [string tolower $findstring]
3071 set foundstring $findstring
3073 set foundstrlen [string length $findstring]
3074 if {$foundstrlen == 0} return
3075 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3076 set matchstring "*$matchstring*"
3077 if {$findloc == "Files"} {
3081 if {![info exists selectedline]} {
3084 set oldsel $selectedline
3087 set fldtypes {Headline Author Date Committer CDate Comment}
3089 foreach id $displayorder {
3090 set d $commitdata($id)
3092 if {$findtype == "Regexp"} {
3093 set doesmatch [regexp $foundstring $d]
3094 } elseif {$findtype == "IgnCase"} {
3095 set doesmatch [string match -nocase $matchstring $d]
3097 set doesmatch [string match $matchstring $d]
3099 if {!$doesmatch} continue
3100 if {![info exists commitinfo($id)]} {
3103 set info $commitinfo($id)
3105 foreach f $info ty $fldtypes {
3106 if {$findloc != "All fields" && $findloc != $ty} {
3109 set matches [findmatches $f]
3110 if {$matches == {}} continue
3112 if {$ty == "Headline"} {
3114 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3115 } elseif {$ty == "Author"} {
3117 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3118 } elseif {$ty == "Date"} {
3120 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3124 lappend matchinglines $l
3125 if {!$didsel && $l > $oldsel} {
3131 if {$matchinglines == {}} {
3133 } elseif {!$didsel} {
3134 findselectline [lindex $matchinglines 0]
3138 proc findselectline {l} {
3139 global findloc commentend ctext
3141 if {$findloc == "All fields" || $findloc == "Comments"} {
3142 # highlight the matches in the comments
3143 set f [$ctext get 1.0 $commentend]
3144 set matches [findmatches $f]
3145 foreach match $matches {
3146 set start [lindex $match 0]
3147 set end [expr {[lindex $match 1] + 1}]
3148 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3153 proc findnext {restart} {
3154 global matchinglines selectedline
3155 if {![info exists matchinglines]} {
3161 if {![info exists selectedline]} return
3162 foreach l $matchinglines {
3163 if {$l > $selectedline} {
3172 global matchinglines selectedline
3173 if {![info exists matchinglines]} {
3177 if {![info exists selectedline]} return
3179 foreach l $matchinglines {
3180 if {$l >= $selectedline} break
3184 findselectline $prev
3190 proc findlocchange {name ix op} {
3191 global findloc findtype findtypemenu
3192 if {$findloc == "Pickaxe"} {
3198 $findtypemenu entryconf 1 -state $state
3199 $findtypemenu entryconf 2 -state $state
3202 proc stopfindproc {{done 0}} {
3203 global findprocpid findprocfile findids
3204 global ctext findoldcursor phase maincursor textcursor
3205 global findinprogress
3207 catch {unset findids}
3208 if {[info exists findprocpid]} {
3210 catch {exec kill $findprocpid}
3212 catch {close $findprocfile}
3215 catch {unset findinprogress}
3219 proc findpatches {} {
3220 global findstring selectedline numcommits
3221 global findprocpid findprocfile
3222 global finddidsel ctext displayorder findinprogress
3223 global findinsertpos
3225 if {$numcommits == 0} return
3227 # make a list of all the ids to search, starting at the one
3228 # after the selected line (if any)
3229 if {[info exists selectedline]} {
3235 for {set i 0} {$i < $numcommits} {incr i} {
3236 if {[incr l] >= $numcommits} {
3239 append inputids [lindex $displayorder $l] "\n"
3243 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
3246 error_popup "Error starting search process: $err"
3250 set findinsertpos end
3252 set findprocpid [pid $f]
3253 fconfigure $f -blocking 0
3254 fileevent $f readable readfindproc
3257 set findinprogress 1
3260 proc readfindproc {} {
3261 global findprocfile finddidsel
3262 global commitrow matchinglines findinsertpos curview
3264 set n [gets $findprocfile line]
3266 if {[eof $findprocfile]} {
3274 if {![regexp {^[0-9a-f]{40}} $line id]} {
3275 error_popup "Can't parse git-diff-tree output: $line"
3279 if {![info exists commitrow($curview,$id)]} {
3280 puts stderr "spurious id: $id"
3283 set l $commitrow($curview,$id)
3287 proc insertmatch {l id} {
3288 global matchinglines findinsertpos finddidsel
3290 if {$findinsertpos == "end"} {
3291 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
3292 set matchinglines [linsert $matchinglines 0 $l]
3295 lappend matchinglines $l
3298 set matchinglines [linsert $matchinglines $findinsertpos $l]
3309 global selectedline numcommits displayorder ctext
3310 global ffileline finddidsel parentlist
3311 global findinprogress findstartline findinsertpos
3312 global treediffs fdiffid fdiffsneeded fdiffpos
3313 global findmergefiles
3315 if {$numcommits == 0} return
3317 if {[info exists selectedline]} {
3318 set l [expr {$selectedline + 1}]
3323 set findstartline $l
3327 set id [lindex $displayorder $l]
3328 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3329 if {![info exists treediffs($id)]} {
3330 append diffsneeded "$id\n"
3331 lappend fdiffsneeded $id
3334 if {[incr l] >= $numcommits} {
3337 if {$l == $findstartline} break
3340 # start off a git-diff-tree process if needed
3341 if {$diffsneeded ne {}} {
3343 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3345 error_popup "Error starting search process: $err"
3348 catch {unset fdiffid}
3350 fconfigure $df -blocking 0
3351 fileevent $df readable [list readfilediffs $df]
3355 set findinsertpos end
3356 set id [lindex $displayorder $l]
3358 set findinprogress 1
3363 proc readfilediffs {df} {
3364 global findid fdiffid fdiffs
3366 set n [gets $df line]
3370 if {[catch {close $df} err]} {
3373 error_popup "Error in git-diff-tree: $err"
3374 } elseif {[info exists findid]} {
3378 error_popup "Couldn't find diffs for $id"
3383 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3384 # start of a new string of diffs
3388 } elseif {[string match ":*" $line]} {
3389 lappend fdiffs [lindex $line 5]
3393 proc donefilediff {} {
3394 global fdiffid fdiffs treediffs findid
3395 global fdiffsneeded fdiffpos
3397 if {[info exists fdiffid]} {
3398 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3399 && $fdiffpos < [llength $fdiffsneeded]} {
3400 # git-diff-tree doesn't output anything for a commit
3401 # which doesn't change anything
3402 set nullid [lindex $fdiffsneeded $fdiffpos]
3403 set treediffs($nullid) {}
3404 if {[info exists findid] && $nullid eq $findid} {
3412 if {![info exists treediffs($fdiffid)]} {
3413 set treediffs($fdiffid) $fdiffs
3415 if {[info exists findid] && $fdiffid eq $findid} {
3423 global findid treediffs parentlist
3424 global ffileline findstartline finddidsel
3425 global displayorder numcommits matchinglines findinprogress
3426 global findmergefiles
3430 set id [lindex $displayorder $l]
3431 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3432 if {![info exists treediffs($id)]} {
3438 foreach f $treediffs($id) {
3439 set x [findmatches $f]
3449 if {[incr l] >= $numcommits} {
3452 if {$l == $findstartline} break
3460 # mark a commit as matching by putting a yellow background
3461 # behind the headline
3462 proc markheadline {l id} {
3463 global canv mainfont linehtag
3466 set bbox [$canv bbox $linehtag($l)]
3467 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3471 # mark the bits of a headline, author or date that match a find string
3472 proc markmatches {canv l str tag matches font} {
3473 set bbox [$canv bbox $tag]
3474 set x0 [lindex $bbox 0]
3475 set y0 [lindex $bbox 1]
3476 set y1 [lindex $bbox 3]
3477 foreach match $matches {
3478 set start [lindex $match 0]
3479 set end [lindex $match 1]
3480 if {$start > $end} continue
3481 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3482 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3483 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3484 [expr {$x0+$xlen+2}] $y1 \
3485 -outline {} -tags matches -fill yellow]
3490 proc unmarkmatches {} {
3491 global matchinglines findids
3492 allcanvs delete matches
3493 catch {unset matchinglines}
3494 catch {unset findids}
3497 proc selcanvline {w x y} {
3498 global canv canvy0 ctext linespc
3500 set ymax [lindex [$canv cget -scrollregion] 3]
3501 if {$ymax == {}} return
3502 set yfrac [lindex [$canv yview] 0]
3503 set y [expr {$y + $yfrac * $ymax}]
3504 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3509 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3515 proc commit_descriptor {p} {
3517 if {![info exists commitinfo($p)]} {
3521 if {[llength $commitinfo($p)] > 1} {
3522 set l [lindex $commitinfo($p) 0]
3527 # append some text to the ctext widget, and make any SHA1 ID
3528 # that we know about be a clickable link.
3529 proc appendwithlinks {text} {
3530 global ctext commitrow linknum curview
3532 set start [$ctext index "end - 1c"]
3533 $ctext insert end $text
3534 $ctext insert end "\n"
3535 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3539 set linkid [string range $text $s $e]
3540 if {![info exists commitrow($curview,$linkid)]} continue
3542 $ctext tag add link "$start + $s c" "$start + $e c"
3543 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3544 $ctext tag bind link$linknum <1> \
3545 [list selectline $commitrow($curview,$linkid) 1]
3548 $ctext tag conf link -foreground blue -underline 1
3549 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3550 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3553 proc viewnextline {dir} {
3557 set ymax [lindex [$canv cget -scrollregion] 3]
3558 set wnow [$canv yview]
3559 set wtop [expr {[lindex $wnow 0] * $ymax}]
3560 set newtop [expr {$wtop + $dir * $linespc}]
3563 } elseif {$newtop > $ymax} {
3566 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3569 proc selectline {l isnew} {
3570 global canv canv2 canv3 ctext commitinfo selectedline
3571 global displayorder linehtag linentag linedtag
3572 global canvy0 linespc parentlist childlist
3573 global currentid sha1entry
3574 global commentend idtags linknum
3575 global mergemax numcommits pending_select
3578 catch {unset pending_select}
3581 if {$l < 0 || $l >= $numcommits} return
3582 set y [expr {$canvy0 + $l * $linespc}]
3583 set ymax [lindex [$canv cget -scrollregion] 3]
3584 set ytop [expr {$y - $linespc - 1}]
3585 set ybot [expr {$y + $linespc + 1}]
3586 set wnow [$canv yview]
3587 set wtop [expr {[lindex $wnow 0] * $ymax}]
3588 set wbot [expr {[lindex $wnow 1] * $ymax}]
3589 set wh [expr {$wbot - $wtop}]
3591 if {$ytop < $wtop} {
3592 if {$ybot < $wtop} {
3593 set newtop [expr {$y - $wh / 2.0}]
3596 if {$newtop > $wtop - $linespc} {
3597 set newtop [expr {$wtop - $linespc}]
3600 } elseif {$ybot > $wbot} {
3601 if {$ytop > $wbot} {
3602 set newtop [expr {$y - $wh / 2.0}]
3604 set newtop [expr {$ybot - $wh}]
3605 if {$newtop < $wtop + $linespc} {
3606 set newtop [expr {$wtop + $linespc}]
3610 if {$newtop != $wtop} {
3614 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3618 if {![info exists linehtag($l)]} return
3620 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3621 -tags secsel -fill [$canv cget -selectbackground]]
3623 $canv2 delete secsel
3624 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3625 -tags secsel -fill [$canv2 cget -selectbackground]]
3627 $canv3 delete secsel
3628 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3629 -tags secsel -fill [$canv3 cget -selectbackground]]
3633 addtohistory [list selectline $l 0]
3638 set id [lindex $displayorder $l]
3640 $sha1entry delete 0 end
3641 $sha1entry insert 0 $id
3642 $sha1entry selection from 0
3643 $sha1entry selection to end
3645 $ctext conf -state normal
3646 $ctext delete 0.0 end
3648 set info $commitinfo($id)
3649 set date [formatdate [lindex $info 2]]
3650 $ctext insert end "Author: [lindex $info 1] $date\n"
3651 set date [formatdate [lindex $info 4]]
3652 $ctext insert end "Committer: [lindex $info 3] $date\n"
3653 if {[info exists idtags($id)]} {
3654 $ctext insert end "Tags:"
3655 foreach tag $idtags($id) {
3656 $ctext insert end " $tag"
3658 $ctext insert end "\n"
3662 set olds [lindex $parentlist $l]
3663 if {[llength $olds] > 1} {
3666 if {$np >= $mergemax} {
3671 $ctext insert end "Parent: " $tag
3672 appendwithlinks [commit_descriptor $p]
3677 append comment "Parent: [commit_descriptor $p]\n"
3681 foreach c [lindex $childlist $l] {
3682 append comment "Child: [commit_descriptor $c]\n"
3685 append comment [lindex $info 5]
3687 # make anything that looks like a SHA1 ID be a clickable link
3688 appendwithlinks $comment
3690 $ctext tag delete Comments
3691 $ctext tag remove found 1.0 end
3692 $ctext conf -state disabled
3693 set commentend [$ctext index "end - 1c"]
3695 init_flist "Comments"
3696 if {$cmitmode eq "tree"} {
3698 } elseif {[llength $olds] <= 1} {
3705 proc selfirstline {} {
3710 proc sellastline {} {
3713 set l [expr {$numcommits - 1}]
3717 proc selnextline {dir} {
3719 if {![info exists selectedline]} return
3720 set l [expr {$selectedline + $dir}]
3725 proc selnextpage {dir} {
3726 global canv linespc selectedline numcommits
3728 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3732 allcanvs yview scroll [expr {$dir * $lpp}] units
3734 if {![info exists selectedline]} return
3735 set l [expr {$selectedline + $dir * $lpp}]
3738 } elseif {$l >= $numcommits} {
3739 set l [expr $numcommits - 1]
3745 proc unselectline {} {
3746 global selectedline currentid
3748 catch {unset selectedline}
3749 catch {unset currentid}
3750 allcanvs delete secsel
3753 proc reselectline {} {
3756 if {[info exists selectedline]} {
3757 selectline $selectedline 0
3761 proc addtohistory {cmd} {
3762 global history historyindex curview
3764 set elt [list $curview $cmd]
3765 if {$historyindex > 0
3766 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3770 if {$historyindex < [llength $history]} {
3771 set history [lreplace $history $historyindex end $elt]
3773 lappend history $elt
3776 if {$historyindex > 1} {
3777 .ctop.top.bar.leftbut conf -state normal
3779 .ctop.top.bar.leftbut conf -state disabled
3781 .ctop.top.bar.rightbut conf -state disabled
3787 set view [lindex $elt 0]
3788 set cmd [lindex $elt 1]
3789 if {$curview != $view} {
3796 global history historyindex
3798 if {$historyindex > 1} {
3799 incr historyindex -1
3800 godo [lindex $history [expr {$historyindex - 1}]]
3801 .ctop.top.bar.rightbut conf -state normal
3803 if {$historyindex <= 1} {
3804 .ctop.top.bar.leftbut conf -state disabled
3809 global history historyindex
3811 if {$historyindex < [llength $history]} {
3812 set cmd [lindex $history $historyindex]
3815 .ctop.top.bar.leftbut conf -state normal
3817 if {$historyindex >= [llength $history]} {
3818 .ctop.top.bar.rightbut conf -state disabled
3823 global treefilelist treeidlist diffids diffmergeid treepending
3826 catch {unset diffmergeid}
3827 if {![info exists treefilelist($id)]} {
3828 if {![info exists treepending]} {
3829 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3833 set treefilelist($id) {}
3834 set treeidlist($id) {}
3835 fconfigure $gtf -blocking 0
3836 fileevent $gtf readable [list gettreeline $gtf $id]
3843 proc gettreeline {gtf id} {
3844 global treefilelist treeidlist treepending cmitmode diffids
3846 while {[gets $gtf line] >= 0} {
3847 if {[lindex $line 1] ne "blob"} continue
3848 set sha1 [lindex $line 2]
3849 set fname [lindex $line 3]
3850 lappend treefilelist($id) $fname
3851 lappend treeidlist($id) $sha1
3853 if {![eof $gtf]} return
3856 if {$cmitmode ne "tree"} {
3857 if {![info exists diffmergeid]} {
3858 gettreediffs $diffids
3860 } elseif {$id ne $diffids} {
3868 global treefilelist treeidlist diffids
3869 global ctext commentend
3871 set i [lsearch -exact $treefilelist($diffids) $f]
3873 puts "oops, $f not in list for id $diffids"
3876 set blob [lindex $treeidlist($diffids) $i]
3877 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3878 puts "oops, error reading blob $blob: $err"
3881 fconfigure $bf -blocking 0
3882 fileevent $bf readable [list getblobline $bf $diffids]
3883 $ctext config -state normal
3884 $ctext delete $commentend end
3885 $ctext insert end "\n"
3886 $ctext insert end "$f\n" filesep
3887 $ctext config -state disabled
3888 $ctext yview $commentend
3891 proc getblobline {bf id} {
3892 global diffids cmitmode ctext
3894 if {$id ne $diffids || $cmitmode ne "tree"} {
3898 $ctext config -state normal
3899 while {[gets $bf line] >= 0} {
3900 $ctext insert end "$line\n"
3903 # delete last newline
3904 $ctext delete "end - 2c" "end - 1c"
3907 $ctext config -state disabled
3910 proc mergediff {id l} {
3911 global diffmergeid diffopts mdifffd
3917 # this doesn't seem to actually affect anything...
3918 set env(GIT_DIFF_OPTS) $diffopts
3919 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3920 if {[catch {set mdf [open $cmd r]} err]} {
3921 error_popup "Error getting merge diffs: $err"
3924 fconfigure $mdf -blocking 0
3925 set mdifffd($id) $mdf
3926 set np [llength [lindex $parentlist $l]]
3927 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3928 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3931 proc getmergediffline {mdf id np} {
3932 global diffmergeid ctext cflist nextupdate mergemax
3933 global difffilestart mdifffd
3935 set n [gets $mdf line]
3942 if {![info exists diffmergeid] || $id != $diffmergeid
3943 || $mdf != $mdifffd($id)} {
3946 $ctext conf -state normal
3947 if {[regexp {^diff --cc (.*)} $line match fname]} {
3948 # start of a new file
3949 $ctext insert end "\n"
3950 set here [$ctext index "end - 1c"]
3951 lappend difffilestart $here
3952 add_flist [list $fname]
3953 set l [expr {(78 - [string length $fname]) / 2}]
3954 set pad [string range "----------------------------------------" 1 $l]
3955 $ctext insert end "$pad $fname $pad\n" filesep
3956 } elseif {[regexp {^@@} $line]} {
3957 $ctext insert end "$line\n" hunksep
3958 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3961 # parse the prefix - one ' ', '-' or '+' for each parent
3966 for {set j 0} {$j < $np} {incr j} {
3967 set c [string range $line $j $j]
3970 } elseif {$c == "-"} {
3972 } elseif {$c == "+"} {
3981 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3982 # line doesn't appear in result, parents in $minuses have the line
3983 set num [lindex $minuses 0]
3984 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3985 # line appears in result, parents in $pluses don't have the line
3986 lappend tags mresult
3987 set num [lindex $spaces 0]
3990 if {$num >= $mergemax} {
3995 $ctext insert end "$line\n" $tags
3997 $ctext conf -state disabled
3998 if {[clock clicks -milliseconds] >= $nextupdate} {
4000 fileevent $mdf readable {}
4002 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4006 proc startdiff {ids} {
4007 global treediffs diffids treepending diffmergeid
4010 catch {unset diffmergeid}
4011 if {![info exists treediffs($ids)]} {
4012 if {![info exists treepending]} {
4020 proc addtocflist {ids} {
4021 global treediffs cflist
4022 add_flist $treediffs($ids)
4026 proc gettreediffs {ids} {
4027 global treediff treepending
4028 set treepending $ids
4031 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4033 fconfigure $gdtf -blocking 0
4034 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4037 proc gettreediffline {gdtf ids} {
4038 global treediff treediffs treepending diffids diffmergeid
4041 set n [gets $gdtf line]
4043 if {![eof $gdtf]} return
4045 set treediffs($ids) $treediff
4047 if {$cmitmode eq "tree"} {
4049 } elseif {$ids != $diffids} {
4050 if {![info exists diffmergeid]} {
4051 gettreediffs $diffids
4058 set file [lindex $line 5]
4059 lappend treediff $file
4062 proc getblobdiffs {ids} {
4063 global diffopts blobdifffd diffids env curdifftag curtagstart
4064 global nextupdate diffinhdr treediffs
4066 set env(GIT_DIFF_OPTS) $diffopts
4067 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4068 if {[catch {set bdf [open $cmd r]} err]} {
4069 puts "error getting diffs: $err"
4073 fconfigure $bdf -blocking 0
4074 set blobdifffd($ids) $bdf
4075 set curdifftag Comments
4077 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4078 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4081 proc setinlist {var i val} {
4084 while {[llength [set $var]] < $i} {
4087 if {[llength [set $var]] == $i} {
4094 proc getblobdiffline {bdf ids} {
4095 global diffids blobdifffd ctext curdifftag curtagstart
4096 global diffnexthead diffnextnote difffilestart
4097 global nextupdate diffinhdr treediffs
4099 set n [gets $bdf line]
4103 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4104 $ctext tag add $curdifftag $curtagstart end
4109 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4112 $ctext conf -state normal
4113 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4114 # start of a new file
4115 $ctext insert end "\n"
4116 $ctext tag add $curdifftag $curtagstart end
4117 set here [$ctext index "end - 1c"]
4118 set curtagstart $here
4120 set i [lsearch -exact $treediffs($ids) $fname]
4122 setinlist difffilestart $i $here
4124 if {$newname ne $fname} {
4125 set i [lsearch -exact $treediffs($ids) $newname]
4127 setinlist difffilestart $i $here
4130 set curdifftag "f:$fname"
4131 $ctext tag delete $curdifftag
4132 set l [expr {(78 - [string length $header]) / 2}]
4133 set pad [string range "----------------------------------------" 1 $l]
4134 $ctext insert end "$pad $header $pad\n" filesep
4136 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4138 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4140 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4141 $line match f1l f1c f2l f2c rest]} {
4142 $ctext insert end "$line\n" hunksep
4145 set x [string range $line 0 0]
4146 if {$x == "-" || $x == "+"} {
4147 set tag [expr {$x == "+"}]
4148 $ctext insert end "$line\n" d$tag
4149 } elseif {$x == " "} {
4150 $ctext insert end "$line\n"
4151 } elseif {$diffinhdr || $x == "\\"} {
4152 # e.g. "\ No newline at end of file"
4153 $ctext insert end "$line\n" filesep
4155 # Something else we don't recognize
4156 if {$curdifftag != "Comments"} {
4157 $ctext insert end "\n"
4158 $ctext tag add $curdifftag $curtagstart end
4159 set curtagstart [$ctext index "end - 1c"]
4160 set curdifftag Comments
4162 $ctext insert end "$line\n" filesep
4165 $ctext conf -state disabled
4166 if {[clock clicks -milliseconds] >= $nextupdate} {
4168 fileevent $bdf readable {}
4170 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4175 global difffilestart ctext
4176 set here [$ctext index @0,0]
4177 foreach loc $difffilestart {
4178 if {[$ctext compare $loc > $here]} {
4185 global linespc charspc canvx0 canvy0 mainfont
4186 global xspc1 xspc2 lthickness
4188 set linespc [font metrics $mainfont -linespace]
4189 set charspc [font measure $mainfont "m"]
4190 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4191 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4192 set lthickness [expr {int($linespc / 9) + 1}]
4193 set xspc1(0) $linespc
4201 set ymax [lindex [$canv cget -scrollregion] 3]
4202 if {$ymax eq {} || $ymax == 0} return
4203 set span [$canv yview]
4206 allcanvs yview moveto [lindex $span 0]
4208 if {[info exists selectedline]} {
4209 selectline $selectedline 0
4213 proc incrfont {inc} {
4214 global mainfont textfont ctext canv phase
4215 global stopped entries
4217 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4218 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4220 $ctext conf -font $textfont
4221 $ctext tag conf filesep -font [concat $textfont bold]
4222 foreach e $entries {
4223 $e conf -font $mainfont
4225 if {$phase eq "getcommits"} {
4226 $canv itemconf textitems -font $mainfont
4232 global sha1entry sha1string
4233 if {[string length $sha1string] == 40} {
4234 $sha1entry delete 0 end
4238 proc sha1change {n1 n2 op} {
4239 global sha1string currentid sha1but
4240 if {$sha1string == {}
4241 || ([info exists currentid] && $sha1string == $currentid)} {
4246 if {[$sha1but cget -state] == $state} return
4247 if {$state == "normal"} {
4248 $sha1but conf -state normal -relief raised -text "Goto: "
4250 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4254 proc gotocommit {} {
4255 global sha1string currentid commitrow tagids headids
4256 global displayorder numcommits curview
4258 if {$sha1string == {}
4259 || ([info exists currentid] && $sha1string == $currentid)} return
4260 if {[info exists tagids($sha1string)]} {
4261 set id $tagids($sha1string)
4262 } elseif {[info exists headids($sha1string)]} {
4263 set id $headids($sha1string)
4265 set id [string tolower $sha1string]
4266 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4268 foreach i $displayorder {
4269 if {[string match $id* $i]} {
4273 if {$matches ne {}} {
4274 if {[llength $matches] > 1} {
4275 error_popup "Short SHA1 id $id is ambiguous"
4278 set id [lindex $matches 0]
4282 if {[info exists commitrow($curview,$id)]} {
4283 selectline $commitrow($curview,$id) 1
4286 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4291 error_popup "$type $sha1string is not known"
4294 proc lineenter {x y id} {
4295 global hoverx hovery hoverid hovertimer
4296 global commitinfo canv
4298 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4302 if {[info exists hovertimer]} {
4303 after cancel $hovertimer
4305 set hovertimer [after 500 linehover]
4309 proc linemotion {x y id} {
4310 global hoverx hovery hoverid hovertimer
4312 if {[info exists hoverid] && $id == $hoverid} {
4315 if {[info exists hovertimer]} {
4316 after cancel $hovertimer
4318 set hovertimer [after 500 linehover]
4322 proc lineleave {id} {
4323 global hoverid hovertimer canv
4325 if {[info exists hoverid] && $id == $hoverid} {
4327 if {[info exists hovertimer]} {
4328 after cancel $hovertimer
4336 global hoverx hovery hoverid hovertimer
4337 global canv linespc lthickness
4338 global commitinfo mainfont
4340 set text [lindex $commitinfo($hoverid) 0]
4341 set ymax [lindex [$canv cget -scrollregion] 3]
4342 if {$ymax == {}} return
4343 set yfrac [lindex [$canv yview] 0]
4344 set x [expr {$hoverx + 2 * $linespc}]
4345 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4346 set x0 [expr {$x - 2 * $lthickness}]
4347 set y0 [expr {$y - 2 * $lthickness}]
4348 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4349 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4350 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4351 -fill \#ffff80 -outline black -width 1 -tags hover]
4353 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4357 proc clickisonarrow {id y} {
4360 set ranges [rowranges $id]
4361 set thresh [expr {2 * $lthickness + 6}]
4362 set n [expr {[llength $ranges] - 1}]
4363 for {set i 1} {$i < $n} {incr i} {
4364 set row [lindex $ranges $i]
4365 if {abs([yc $row] - $y) < $thresh} {
4372 proc arrowjump {id n y} {
4375 # 1 <-> 2, 3 <-> 4, etc...
4376 set n [expr {(($n - 1) ^ 1) + 1}]
4377 set row [lindex [rowranges $id] $n]
4379 set ymax [lindex [$canv cget -scrollregion] 3]
4380 if {$ymax eq {} || $ymax <= 0} return
4381 set view [$canv yview]
4382 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4383 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4387 allcanvs yview moveto $yfrac
4390 proc lineclick {x y id isnew} {
4391 global ctext commitinfo children canv thickerline curview
4393 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4398 # draw this line thicker than normal
4402 set ymax [lindex [$canv cget -scrollregion] 3]
4403 if {$ymax eq {}} return
4404 set yfrac [lindex [$canv yview] 0]
4405 set y [expr {$y + $yfrac * $ymax}]
4407 set dirn [clickisonarrow $id $y]
4409 arrowjump $id $dirn $y
4414 addtohistory [list lineclick $x $y $id 0]
4416 # fill the details pane with info about this line
4417 $ctext conf -state normal
4418 $ctext delete 0.0 end
4419 $ctext tag conf link -foreground blue -underline 1
4420 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4421 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4422 $ctext insert end "Parent:\t"
4423 $ctext insert end $id [list link link0]
4424 $ctext tag bind link0 <1> [list selbyid $id]
4425 set info $commitinfo($id)
4426 $ctext insert end "\n\t[lindex $info 0]\n"
4427 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4428 set date [formatdate [lindex $info 2]]
4429 $ctext insert end "\tDate:\t$date\n"
4430 set kids $children($curview,$id)
4432 $ctext insert end "\nChildren:"
4434 foreach child $kids {
4436 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4437 set info $commitinfo($child)
4438 $ctext insert end "\n\t"
4439 $ctext insert end $child [list link link$i]
4440 $ctext tag bind link$i <1> [list selbyid $child]
4441 $ctext insert end "\n\t[lindex $info 0]"
4442 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4443 set date [formatdate [lindex $info 2]]
4444 $ctext insert end "\n\tDate:\t$date\n"
4447 $ctext conf -state disabled
4451 proc normalline {} {
4453 if {[info exists thickerline]} {
4461 global commitrow curview
4462 if {[info exists commitrow($curview,$id)]} {
4463 selectline $commitrow($curview,$id) 1
4469 if {![info exists startmstime]} {
4470 set startmstime [clock clicks -milliseconds]
4472 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4475 proc rowmenu {x y id} {
4476 global rowctxmenu commitrow selectedline rowmenuid curview
4478 if {![info exists selectedline]
4479 || $commitrow($curview,$id) eq $selectedline} {
4484 $rowctxmenu entryconfigure 0 -state $state
4485 $rowctxmenu entryconfigure 1 -state $state
4486 $rowctxmenu entryconfigure 2 -state $state
4488 tk_popup $rowctxmenu $x $y
4491 proc diffvssel {dirn} {
4492 global rowmenuid selectedline displayorder
4494 if {![info exists selectedline]} return
4496 set oldid [lindex $displayorder $selectedline]
4497 set newid $rowmenuid
4499 set oldid $rowmenuid
4500 set newid [lindex $displayorder $selectedline]
4502 addtohistory [list doseldiff $oldid $newid]
4503 doseldiff $oldid $newid
4506 proc doseldiff {oldid newid} {
4510 $ctext conf -state normal
4511 $ctext delete 0.0 end
4513 $ctext insert end "From "
4514 $ctext tag conf link -foreground blue -underline 1
4515 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4516 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4517 $ctext tag bind link0 <1> [list selbyid $oldid]
4518 $ctext insert end $oldid [list link link0]
4519 $ctext insert end "\n "
4520 $ctext insert end [lindex $commitinfo($oldid) 0]
4521 $ctext insert end "\n\nTo "
4522 $ctext tag bind link1 <1> [list selbyid $newid]
4523 $ctext insert end $newid [list link link1]
4524 $ctext insert end "\n "
4525 $ctext insert end [lindex $commitinfo($newid) 0]
4526 $ctext insert end "\n"
4527 $ctext conf -state disabled
4528 $ctext tag delete Comments
4529 $ctext tag remove found 1.0 end
4530 startdiff [list $oldid $newid]
4534 global rowmenuid currentid commitinfo patchtop patchnum
4536 if {![info exists currentid]} return
4537 set oldid $currentid
4538 set oldhead [lindex $commitinfo($oldid) 0]
4539 set newid $rowmenuid
4540 set newhead [lindex $commitinfo($newid) 0]
4543 catch {destroy $top}
4545 label $top.title -text "Generate patch"
4546 grid $top.title - -pady 10
4547 label $top.from -text "From:"
4548 entry $top.fromsha1 -width 40 -relief flat
4549 $top.fromsha1 insert 0 $oldid
4550 $top.fromsha1 conf -state readonly
4551 grid $top.from $top.fromsha1 -sticky w
4552 entry $top.fromhead -width 60 -relief flat
4553 $top.fromhead insert 0 $oldhead
4554 $top.fromhead conf -state readonly
4555 grid x $top.fromhead -sticky w
4556 label $top.to -text "To:"
4557 entry $top.tosha1 -width 40 -relief flat
4558 $top.tosha1 insert 0 $newid
4559 $top.tosha1 conf -state readonly
4560 grid $top.to $top.tosha1 -sticky w
4561 entry $top.tohead -width 60 -relief flat
4562 $top.tohead insert 0 $newhead
4563 $top.tohead conf -state readonly
4564 grid x $top.tohead -sticky w
4565 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4566 grid $top.rev x -pady 10
4567 label $top.flab -text "Output file:"
4568 entry $top.fname -width 60
4569 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4571 grid $top.flab $top.fname -sticky w
4573 button $top.buts.gen -text "Generate" -command mkpatchgo
4574 button $top.buts.can -text "Cancel" -command mkpatchcan
4575 grid $top.buts.gen $top.buts.can
4576 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4577 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4578 grid $top.buts - -pady 10 -sticky ew
4582 proc mkpatchrev {} {
4585 set oldid [$patchtop.fromsha1 get]
4586 set oldhead [$patchtop.fromhead get]
4587 set newid [$patchtop.tosha1 get]
4588 set newhead [$patchtop.tohead get]
4589 foreach e [list fromsha1 fromhead tosha1 tohead] \
4590 v [list $newid $newhead $oldid $oldhead] {
4591 $patchtop.$e conf -state normal
4592 $patchtop.$e delete 0 end
4593 $patchtop.$e insert 0 $v
4594 $patchtop.$e conf -state readonly
4601 set oldid [$patchtop.fromsha1 get]
4602 set newid [$patchtop.tosha1 get]
4603 set fname [$patchtop.fname get]
4604 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4605 error_popup "Error creating patch: $err"
4607 catch {destroy $patchtop}
4611 proc mkpatchcan {} {
4614 catch {destroy $patchtop}
4619 global rowmenuid mktagtop commitinfo
4623 catch {destroy $top}
4625 label $top.title -text "Create tag"
4626 grid $top.title - -pady 10
4627 label $top.id -text "ID:"
4628 entry $top.sha1 -width 40 -relief flat
4629 $top.sha1 insert 0 $rowmenuid
4630 $top.sha1 conf -state readonly
4631 grid $top.id $top.sha1 -sticky w
4632 entry $top.head -width 60 -relief flat
4633 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4634 $top.head conf -state readonly
4635 grid x $top.head -sticky w
4636 label $top.tlab -text "Tag name:"
4637 entry $top.tag -width 60
4638 grid $top.tlab $top.tag -sticky w
4640 button $top.buts.gen -text "Create" -command mktaggo
4641 button $top.buts.can -text "Cancel" -command mktagcan
4642 grid $top.buts.gen $top.buts.can
4643 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4644 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4645 grid $top.buts - -pady 10 -sticky ew
4650 global mktagtop env tagids idtags
4652 set id [$mktagtop.sha1 get]
4653 set tag [$mktagtop.tag get]
4655 error_popup "No tag name specified"
4658 if {[info exists tagids($tag)]} {
4659 error_popup "Tag \"$tag\" already exists"
4664 set fname [file join $dir "refs/tags" $tag]
4665 set f [open $fname w]
4669 error_popup "Error creating tag: $err"
4673 set tagids($tag) $id
4674 lappend idtags($id) $tag
4678 proc redrawtags {id} {
4679 global canv linehtag commitrow idpos selectedline curview
4681 if {![info exists commitrow($curview,$id)]} return
4682 drawcmitrow $commitrow($curview,$id)
4683 $canv delete tag.$id
4684 set xt [eval drawtags $id $idpos($id)]
4685 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4686 if {[info exists selectedline]
4687 && $selectedline == $commitrow($curview,$id)} {
4688 selectline $selectedline 0
4695 catch {destroy $mktagtop}
4704 proc writecommit {} {
4705 global rowmenuid wrcomtop commitinfo wrcomcmd
4707 set top .writecommit
4709 catch {destroy $top}
4711 label $top.title -text "Write commit to file"
4712 grid $top.title - -pady 10
4713 label $top.id -text "ID:"
4714 entry $top.sha1 -width 40 -relief flat
4715 $top.sha1 insert 0 $rowmenuid
4716 $top.sha1 conf -state readonly
4717 grid $top.id $top.sha1 -sticky w
4718 entry $top.head -width 60 -relief flat
4719 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4720 $top.head conf -state readonly
4721 grid x $top.head -sticky w
4722 label $top.clab -text "Command:"
4723 entry $top.cmd -width 60 -textvariable wrcomcmd
4724 grid $top.clab $top.cmd -sticky w -pady 10
4725 label $top.flab -text "Output file:"
4726 entry $top.fname -width 60
4727 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4728 grid $top.flab $top.fname -sticky w
4730 button $top.buts.gen -text "Write" -command wrcomgo
4731 button $top.buts.can -text "Cancel" -command wrcomcan
4732 grid $top.buts.gen $top.buts.can
4733 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4734 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4735 grid $top.buts - -pady 10 -sticky ew
4742 set id [$wrcomtop.sha1 get]
4743 set cmd "echo $id | [$wrcomtop.cmd get]"
4744 set fname [$wrcomtop.fname get]
4745 if {[catch {exec sh -c $cmd >$fname &} err]} {
4746 error_popup "Error writing commit: $err"
4748 catch {destroy $wrcomtop}
4755 catch {destroy $wrcomtop}
4759 proc listrefs {id} {
4760 global idtags idheads idotherrefs
4763 if {[info exists idtags($id)]} {
4767 if {[info exists idheads($id)]} {
4771 if {[info exists idotherrefs($id)]} {
4772 set z $idotherrefs($id)
4774 return [list $x $y $z]
4777 proc rereadrefs {} {
4778 global idtags idheads idotherrefs
4780 set refids [concat [array names idtags] \
4781 [array names idheads] [array names idotherrefs]]
4782 foreach id $refids {
4783 if {![info exists ref($id)]} {
4784 set ref($id) [listrefs $id]
4788 set refids [lsort -unique [concat $refids [array names idtags] \
4789 [array names idheads] [array names idotherrefs]]]
4790 foreach id $refids {
4791 set v [listrefs $id]
4792 if {![info exists ref($id)] || $ref($id) != $v} {
4798 proc showtag {tag isnew} {
4799 global ctext tagcontents tagids linknum
4802 addtohistory [list showtag $tag 0]
4804 $ctext conf -state normal
4805 $ctext delete 0.0 end
4807 if {[info exists tagcontents($tag)]} {
4808 set text $tagcontents($tag)
4810 set text "Tag: $tag\nId: $tagids($tag)"
4812 appendwithlinks $text
4813 $ctext conf -state disabled
4824 global maxwidth maxgraphpct diffopts findmergefiles
4825 global oldprefs prefstop
4829 if {[winfo exists $top]} {
4833 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4834 set oldprefs($v) [set $v]
4837 wm title $top "Gitk preferences"
4838 label $top.ldisp -text "Commit list display options"
4839 grid $top.ldisp - -sticky w -pady 10
4840 label $top.spacer -text " "
4841 label $top.maxwidthl -text "Maximum graph width (lines)" \
4843 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4844 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4845 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4847 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4848 grid x $top.maxpctl $top.maxpct -sticky w
4849 checkbutton $top.findm -variable findmergefiles
4850 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4852 grid $top.findm $top.findml - -sticky w
4853 label $top.ddisp -text "Diff display options"
4854 grid $top.ddisp - -sticky w -pady 10
4855 label $top.diffoptl -text "Options for diff program" \
4857 entry $top.diffopt -width 20 -textvariable diffopts
4858 grid x $top.diffoptl $top.diffopt -sticky w
4860 button $top.buts.ok -text "OK" -command prefsok
4861 button $top.buts.can -text "Cancel" -command prefscan
4862 grid $top.buts.ok $top.buts.can
4863 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4864 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4865 grid $top.buts - - -pady 10 -sticky ew
4869 global maxwidth maxgraphpct diffopts findmergefiles
4870 global oldprefs prefstop
4872 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4873 set $v $oldprefs($v)
4875 catch {destroy $prefstop}
4880 global maxwidth maxgraphpct
4881 global oldprefs prefstop
4883 catch {destroy $prefstop}
4885 if {$maxwidth != $oldprefs(maxwidth)
4886 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4891 proc formatdate {d} {
4892 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4895 # This list of encoding names and aliases is distilled from
4896 # http://www.iana.org/assignments/character-sets.
4897 # Not all of them are supported by Tcl.
4898 set encoding_aliases {
4899 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4900 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4901 { ISO-10646-UTF-1 csISO10646UTF1 }
4902 { ISO_646.basic:1983 ref csISO646basic1983 }
4903 { INVARIANT csINVARIANT }
4904 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4905 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4906 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4907 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4908 { NATS-DANO iso-ir-9-1 csNATSDANO }
4909 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4910 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4911 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4912 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4913 { ISO-2022-KR csISO2022KR }
4915 { ISO-2022-JP csISO2022JP }
4916 { ISO-2022-JP-2 csISO2022JP2 }
4917 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4919 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4920 { IT iso-ir-15 ISO646-IT csISO15Italian }
4921 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4922 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4923 { greek7-old iso-ir-18 csISO18Greek7Old }
4924 { latin-greek iso-ir-19 csISO19LatinGreek }
4925 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4926 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4927 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4928 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4929 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4930 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4931 { INIS iso-ir-49 csISO49INIS }
4932 { INIS-8 iso-ir-50 csISO50INIS8 }
4933 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4934 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4935 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4936 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4937 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4938 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4940 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4941 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4942 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4943 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4944 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4945 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4946 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4947 { greek7 iso-ir-88 csISO88Greek7 }
4948 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4949 { iso-ir-90 csISO90 }
4950 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4951 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4952 csISO92JISC62991984b }
4953 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4954 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4955 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4956 csISO95JIS62291984handadd }
4957 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4958 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4959 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4960 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4962 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4963 { T.61-7bit iso-ir-102 csISO102T617bit }
4964 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4965 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4966 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4967 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4968 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4969 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4970 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4971 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4972 arabic csISOLatinArabic }
4973 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4974 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4975 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4976 greek greek8 csISOLatinGreek }
4977 { T.101-G2 iso-ir-128 csISO128T101G2 }
4978 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4980 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4981 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4982 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4983 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4984 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4985 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4986 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4987 csISOLatinCyrillic }
4988 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4989 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4990 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4991 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4992 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4993 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4994 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4995 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4996 { ISO_10367-box iso-ir-155 csISO10367Box }
4997 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4998 { latin-lap lap iso-ir-158 csISO158Lap }
4999 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5000 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5003 { JIS_X0201 X0201 csHalfWidthKatakana }
5004 { KSC5636 ISO646-KR csKSC5636 }
5005 { ISO-10646-UCS-2 csUnicode }
5006 { ISO-10646-UCS-4 csUCS4 }
5007 { DEC-MCS dec csDECMCS }
5008 { hp-roman8 roman8 r8 csHPRoman8 }
5009 { macintosh mac csMacintosh }
5010 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5012 { IBM038 EBCDIC-INT cp038 csIBM038 }
5013 { IBM273 CP273 csIBM273 }
5014 { IBM274 EBCDIC-BE CP274 csIBM274 }
5015 { IBM275 EBCDIC-BR cp275 csIBM275 }
5016 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5017 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5018 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5019 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5020 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5021 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5022 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5023 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5024 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5025 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5026 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5027 { IBM437 cp437 437 csPC8CodePage437 }
5028 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5029 { IBM775 cp775 csPC775Baltic }
5030 { IBM850 cp850 850 csPC850Multilingual }
5031 { IBM851 cp851 851 csIBM851 }
5032 { IBM852 cp852 852 csPCp852 }
5033 { IBM855 cp855 855 csIBM855 }
5034 { IBM857 cp857 857 csIBM857 }
5035 { IBM860 cp860 860 csIBM860 }
5036 { IBM861 cp861 861 cp-is csIBM861 }
5037 { IBM862 cp862 862 csPC862LatinHebrew }
5038 { IBM863 cp863 863 csIBM863 }
5039 { IBM864 cp864 csIBM864 }
5040 { IBM865 cp865 865 csIBM865 }
5041 { IBM866 cp866 866 csIBM866 }
5042 { IBM868 CP868 cp-ar csIBM868 }
5043 { IBM869 cp869 869 cp-gr csIBM869 }
5044 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5045 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5046 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5047 { IBM891 cp891 csIBM891 }
5048 { IBM903 cp903 csIBM903 }
5049 { IBM904 cp904 904 csIBBM904 }
5050 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5051 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5052 { IBM1026 CP1026 csIBM1026 }
5053 { EBCDIC-AT-DE csIBMEBCDICATDE }
5054 { EBCDIC-AT-DE-A csEBCDICATDEA }
5055 { EBCDIC-CA-FR csEBCDICCAFR }
5056 { EBCDIC-DK-NO csEBCDICDKNO }
5057 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5058 { EBCDIC-FI-SE csEBCDICFISE }
5059 { EBCDIC-FI-SE-A csEBCDICFISEA }
5060 { EBCDIC-FR csEBCDICFR }
5061 { EBCDIC-IT csEBCDICIT }
5062 { EBCDIC-PT csEBCDICPT }
5063 { EBCDIC-ES csEBCDICES }
5064 { EBCDIC-ES-A csEBCDICESA }
5065 { EBCDIC-ES-S csEBCDICESS }
5066 { EBCDIC-UK csEBCDICUK }
5067 { EBCDIC-US csEBCDICUS }
5068 { UNKNOWN-8BIT csUnknown8BiT }
5069 { MNEMONIC csMnemonic }
5074 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5075 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5076 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5077 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5078 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5079 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5080 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5081 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5082 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5083 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5084 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5085 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5086 { IBM1047 IBM-1047 }
5087 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5088 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5089 { UNICODE-1-1 csUnicode11 }
5092 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5093 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5095 { ISO-8859-15 ISO_8859-15 Latin-9 }
5096 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5097 { GBK CP936 MS936 windows-936 }
5098 { JIS_Encoding csJISEncoding }
5099 { Shift_JIS MS_Kanji csShiftJIS }
5100 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5102 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5103 { ISO-10646-UCS-Basic csUnicodeASCII }
5104 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5105 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5106 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5107 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5108 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5109 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5110 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5111 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5112 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5113 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5114 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5115 { Ventura-US csVenturaUS }
5116 { Ventura-International csVenturaInternational }
5117 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5118 { PC8-Turkish csPC8Turkish }
5119 { IBM-Symbols csIBMSymbols }
5120 { IBM-Thai csIBMThai }
5121 { HP-Legal csHPLegal }
5122 { HP-Pi-font csHPPiFont }
5123 { HP-Math8 csHPMath8 }
5124 { Adobe-Symbol-Encoding csHPPSMath }
5125 { HP-DeskTop csHPDesktop }
5126 { Ventura-Math csVenturaMath }
5127 { Microsoft-Publishing csMicrosoftPublishing }
5128 { Windows-31J csWindows31J }
5133 proc tcl_encoding {enc} {
5134 global encoding_aliases
5135 set names [encoding names]
5136 set lcnames [string tolower $names]
5137 set enc [string tolower $enc]
5138 set i [lsearch -exact $lcnames $enc]
5140 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5141 if {[regsub {^iso[-_]} $enc iso encx]} {
5142 set i [lsearch -exact $lcnames $encx]
5146 foreach l $encoding_aliases {
5147 set ll [string tolower $l]
5148 if {[lsearch -exact $ll $enc] < 0} continue
5149 # look through the aliases for one that tcl knows about
5151 set i [lsearch -exact $lcnames $e]
5153 if {[regsub {^iso[-_]} $e iso ex]} {
5154 set i [lsearch -exact $lcnames $ex]
5163 return [lindex $names $i]
5170 set diffopts "-U 5 -p"
5171 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5175 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5177 if {$gitencoding == ""} {
5178 set gitencoding "utf-8"
5180 set tclencoding [tcl_encoding $gitencoding]
5181 if {$tclencoding == {}} {
5182 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5185 set mainfont {Helvetica 9}
5186 set textfont {Courier 9}
5187 set uifont {Helvetica 9 bold}
5188 set findmergefiles 0
5196 set cmitmode "patch"
5198 set colors {green red blue magenta darkgrey brown orange}
5200 catch {source ~/.gitk}
5202 font create optionfont -family sans-serif -size -12
5206 switch -regexp -- $arg {
5208 "^-d" { set datemode 1 }
5210 lappend revtreeargs $arg
5215 # check that we can find a .git directory somewhere...
5217 if {![file isdirectory $gitdir]} {
5218 show_error . "Cannot find the git directory \"$gitdir\"."
5222 set cmdline_files {}
5223 set i [lsearch -exact $revtreeargs "--"]
5225 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5226 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5227 } elseif {$revtreeargs ne {}} {
5229 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5230 set cmdline_files [split $f "\n"]
5231 set n [llength $cmdline_files]
5232 set revtreeargs [lrange $revtreeargs 0 end-$n]
5234 # unfortunately we get both stdout and stderr in $err,
5235 # so look for "fatal:".
5236 set i [string first "fatal:" $err]
5238 set err [string range [expr {$i + 6}] end]
5240 show_error . "Bad arguments to gitk:\n$err"
5248 set highlight_names {}
5250 set highlight_paths {}
5257 set selectedhlview None
5270 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5271 # create a view for the files/dirs specified on the command line
5275 set viewname(1) "Command line"
5276 set viewfiles(1) $cmdline_files
5277 set viewargs(1) $revtreeargs
5280 .bar.view entryconf 2 -state normal
5281 .bar.view entryconf 3 -state normal
5284 if {[info exists permviews]} {
5285 foreach v $permviews {
5288 set viewname($n) [lindex $v 0]
5289 set viewfiles($n) [lindex $v 1]
5290 set viewargs($n) [lindex $v 2]