2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
27 set commitidx
($view) 0
28 set args
$viewargs($view)
29 if {$viewfiles($view) ne
{}} {
30 set args
[concat
$args "--" $viewfiles($view)]
32 set order
"--topo-order"
34 set order
"--date-order"
37 set fd
[open
[concat | git rev-list
--header $order \
38 --parents --boundary --default HEAD
$args] r
]
40 puts stderr
"Error executing git rev-list: $err"
44 set leftover
($view) {}
45 fconfigure
$fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure
$fd -encoding $tclencoding
49 fileevent
$fd readable
[list getcommitlines
$fd $view]
53 proc stop_rev_list
{} {
56 if {![info exists commfd
($curview)]} return
57 set fd
$commfd($curview)
63 unset commfd
($curview)
67 global phase canv mainfont curview
71 start_rev_list
$curview
72 show_status
"Reading commits..."
75 proc getcommitlines
{fd view
} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof
$fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure
$fd -blocking 1
90 if {[catch
{close
$fd} err
]} {
92 if {$view != $curview} {
93 set fv
" for the \"$viewname($view)\" view"
95 if {[string range
$err 0 4] == "usage"} {
96 set err
"Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq
"Command line"} {
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
104 set err
"Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i
[string first
"\0" $stuff $start]
118 append leftover
($view) [string range
$stuff $start end
]
122 set cmit
$leftover($view)
123 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
124 set leftover
($view) {}
126 set cmit
[string range
$stuff $start [expr {$i - 1}]]
128 set start
[expr {$i + 1}]
129 set j
[string first
"\n" $cmit]
133 set ids
[string range
$cmit 0 [expr {$j - 1}]]
134 if {[string range
$ids 0 0] == "-"} {
136 set ids
[string range
$ids 1 end
]
140 if {[string length
$id] != 40} {
148 if {[string length
$shortcmit] > 80} {
149 set shortcmit
"[string range $shortcmit 0 80]..."
151 error_popup
"Can't parse git rev-list output: {$shortcmit}"
154 set id
[lindex
$ids 0]
156 set olds
[lrange
$ids 1 end
]
159 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
160 lappend children
($view,$p) $id
167 if {![info exists children
($view,$id)]} {
168 set children
($view,$id) {}
170 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
171 set commitrow
($view,$id) $commitidx($view)
172 incr commitidx
($view)
173 if {$view == $curview} {
174 lappend parentlist
$olds
175 lappend childlist
$children($view,$id)
176 lappend displayorder
$id
177 lappend commitlisted
$listed
179 lappend vparentlist
($view) $olds
180 lappend vchildlist
($view) $children($view,$id)
181 lappend vdisporder
($view) $id
182 lappend vcmitlisted
($view) $listed
187 if {$view == $curview} {
189 } elseif
{[info exists hlview
] && $view == $hlview} {
193 if {[clock clicks
-milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v
[array names commfd
] {
202 fileevent
$commfd($v) readable
{}
205 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate
[expr {$numcommits + 1}]
208 } elseif
{$numcommits < 10000} {
209 set ncmupdate
[expr {$numcommits + 10}]
211 set ncmupdate
[expr {$numcommits + 100}]
213 foreach v
[array names commfd
] {
215 fileevent
$fd readable
[list getcommitlines
$fd $v]
219 proc readcommit
{id
} {
220 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
221 parsecommit
$id $contents 0
224 proc updatecommits
{} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
233 foreach id
$displayorder {
234 catch
{unset children
($n,$id)}
235 catch
{unset commitrow
($n,$id)}
238 catch
{unset selectedline
}
239 catch
{unset thickerline
}
240 catch
{unset viewdata
($n)}
245 proc parsecommit
{id contents listed
} {
246 global commitinfo cdate
255 set hdrend
[string first
"\n\n" $contents]
257 # should never happen...
258 set hdrend
[string length
$contents]
260 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
261 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
262 foreach line
[split $header "\n"] {
263 set tag
[lindex
$line 0]
264 if {$tag == "author"} {
265 set audate
[lindex
$line end-1
]
266 set auname
[lrange
$line 1 end-2
]
267 } elseif
{$tag == "committer"} {
268 set comdate
[lindex
$line end-1
]
269 set comname
[lrange
$line 1 end-2
]
273 # take the first line of the comment as the headline
274 set i
[string first
"\n" $comment]
276 set headline
[string trim
[string range
$comment 0 $i]]
278 set headline
$comment
281 # git rev-list indents the comment by 4 spaces;
282 # if we got this via git cat-file, add the indentation
284 foreach line
[split $comment "\n"] {
285 append newcomment
" "
286 append newcomment
$line
287 append newcomment
"\n"
289 set comment
$newcomment
291 if {$comdate != {}} {
292 set cdate
($id) $comdate
294 set commitinfo
($id) [list
$headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit
{id
} {
299 global commitdata commitinfo
301 if {[info exists commitdata
($id)]} {
302 parsecommit
$id $commitdata($id) 1
305 if {![info exists commitinfo
($id)]} {
306 set commitinfo
($id) {"No commit information available"}
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
319 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
320 while {0 <= [set n
[gets
$refd line
]]} {
321 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
325 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
328 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
332 if {[regexp
{^remotes
/} $path match
]} {
335 if {$type == "tags"} {
336 set tagids
($name) $id
337 lappend idtags
($id) $name
342 set commit
[exec git rev-parse
"$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids
($name) $commit
345 lappend idtags
($commit) $name
349 set tagcontents
($name) [exec git cat-file tag
"$id"]
351 } elseif
{ $type == "heads" } {
352 set headids
($name) $id
353 lappend idheads
($id) $name
355 set otherrefids
($name) $id
356 lappend idotherrefs
($id) $name
362 proc show_error
{w top msg
} {
363 message
$w.m
-text $msg -justify center
-aspect 400
364 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
365 button
$w.ok
-text OK
-command "destroy $top"
366 pack
$w.ok
-side bottom
-fill x
367 bind $top <Visibility
> "grab $top; focus $top"
368 bind $top <Key-Return
> "destroy $top"
372 proc error_popup msg
{
376 show_error
$w $w $msg
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax wrapcomment
386 global highlight_files gdttype
387 global searchstring sstring
390 .bar add cascade
-label "File" -menu .bar.
file
391 .bar configure
-font $uifont
393 .bar.
file add
command -label "Update" -command updatecommits
394 .bar.
file add
command -label "Reread references" -command rereadrefs
395 .bar.
file add
command -label "Quit" -command doquit
396 .bar.
file configure
-font $uifont
398 .bar add cascade
-label "Edit" -menu .bar.edit
399 .bar.edit add
command -label "Preferences" -command doprefs
400 .bar.edit configure
-font $uifont
402 menu .bar.view
-font $uifont
403 .bar add cascade
-label "View" -menu .bar.view
404 .bar.view add
command -label "New view..." -command {newview
0}
405 .bar.view add
command -label "Edit view..." -command editview \
407 .bar.view add
command -label "Delete view" -command delview
-state disabled
408 .bar.view add separator
409 .bar.view add radiobutton
-label "All files" -command {showview
0} \
410 -variable selectedview
-value 0
413 .bar add cascade
-label "Help" -menu .bar.
help
414 .bar.
help add
command -label "About gitk" -command about
415 .bar.
help add
command -label "Key bindings" -command keys
416 .bar.
help configure
-font $uifont
417 . configure
-menu .bar
419 if {![info exists geometry
(canv1
)]} {
420 set geometry
(canv1
) [expr {45 * $charspc}]
421 set geometry
(canv2
) [expr {30 * $charspc}]
422 set geometry
(canv3
) [expr {15 * $charspc}]
423 set geometry
(canvh
) [expr {25 * $linespc + 4}]
424 set geometry
(ctextw
) 80
425 set geometry
(ctexth
) 30
426 set geometry
(cflistw
) 30
428 panedwindow .ctop
-orient vertical
429 if {[info exists geometry
(width
)]} {
430 .ctop conf
-width $geometry(width
) -height $geometry(height
)
431 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
432 set geometry
(ctexth
) [expr {($texth - 8) /
433 [font metrics
$textfont -linespace]}]
438 pack .ctop.top.lbar
-side bottom
-fill x
439 pack .ctop.top.bar
-side bottom
-fill x
440 set cscroll .ctop.top.csb
441 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
442 pack
$cscroll -side right
-fill y
443 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
444 pack .ctop.top.clist
-side top
-fill both
-expand 1
446 set canv .ctop.top.clist.canv
447 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add
$canv
451 set canv2 .ctop.top.clist.canv2
452 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
453 -bg white
-bd 0 -yscrollincr $linespc
454 .ctop.top.clist add
$canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
457 -bg white
-bd 0 -yscrollincr $linespc
458 .ctop.top.clist add
$canv3
459 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
461 set sha1entry .ctop.top.bar.sha1
462 set entries
$sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
465 -command gotocommit
-width 8 -font $uifont
466 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
467 pack .ctop.top.bar.sha1label
-side left
468 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string
write sha1change
470 pack
$sha1entry -side left
-pady 2
472 image create bitmap bm-left
-data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits
[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right
-data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits
[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
489 -state disabled
-width 26
490 pack .ctop.top.bar.leftbut
-side left
-fill y
491 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
492 -state disabled
-width 26
493 pack .ctop.top.bar.rightbut
-side left
-fill y
495 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
496 pack .ctop.top.bar.findbut
-side left
498 set fstring .ctop.top.bar.findstring
499 lappend entries
$fstring
500 entry
$fstring -width 30 -font $textfont -textvariable findstring
501 trace add variable findstring
write find_change
502 pack
$fstring -side left
-expand 1 -fill x
504 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
505 findtype Exact IgnCase Regexp
]
506 trace add variable findtype
write find_change
507 .ctop.top.bar.findtype configure
-font $uifont
508 .ctop.top.bar.findtype.menu configure
-font $uifont
509 set findloc
"All fields"
510 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
511 Comments Author Committer
512 trace add variable findloc
write find_change
513 .ctop.top.bar.findloc configure
-font $uifont
514 .ctop.top.bar.findloc.menu configure
-font $uifont
515 pack .ctop.top.bar.findloc
-side right
516 pack .ctop.top.bar.findtype
-side right
518 label .ctop.top.lbar.flabel
-text "Highlight: Commits " \
520 pack .ctop.top.lbar.flabel
-side left
-fill y
521 set gdttype
"touching paths:"
522 set gm
[tk_optionMenu .ctop.top.lbar.gdttype gdttype
"touching paths:" \
523 "adding/removing string:"]
524 trace add variable gdttype
write hfiles_change
525 $gm conf
-font $uifont
526 .ctop.top.lbar.gdttype conf
-font $uifont
527 pack .ctop.top.lbar.gdttype
-side left
-fill y
528 entry .ctop.top.lbar.fent
-width 25 -font $textfont \
529 -textvariable highlight_files
530 trace add variable highlight_files
write hfiles_change
531 lappend entries .ctop.top.lbar.fent
532 pack .ctop.top.lbar.fent
-side left
-fill x
-expand 1
533 label .ctop.top.lbar.vlabel
-text " OR in view" -font $uifont
534 pack .ctop.top.lbar.vlabel
-side left
-fill y
535 global viewhlmenu selectedhlview
536 set viewhlmenu
[tk_optionMenu .ctop.top.lbar.vhl selectedhlview None
]
537 $viewhlmenu entryconf
0 -command delvhighlight
538 $viewhlmenu conf
-font $uifont
539 .ctop.top.lbar.vhl conf
-font $uifont
540 pack .ctop.top.lbar.vhl
-side left
-fill y
541 label .ctop.top.lbar.rlabel
-text " OR " -font $uifont
542 pack .ctop.top.lbar.rlabel
-side left
-fill y
543 global highlight_related
544 set m
[tk_optionMenu .ctop.top.lbar.relm highlight_related None \
545 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
546 $m conf
-font $uifont
547 .ctop.top.lbar.relm conf
-font $uifont
548 trace add variable highlight_related
write vrel_change
549 pack .ctop.top.lbar.relm
-side left
-fill y
551 panedwindow .ctop.cdet
-orient horizontal
553 frame .ctop.cdet.left
554 frame .ctop.cdet.left.bot
555 pack .ctop.cdet.left.bot
-side bottom
-fill x
556 button .ctop.cdet.left.bot.search
-text "Search" -command dosearch \
558 pack .ctop.cdet.left.bot.search
-side left
-padx 5
559 set sstring .ctop.cdet.left.bot.sstring
560 entry
$sstring -width 20 -font $textfont -textvariable searchstring
561 lappend entries
$sstring
562 trace add variable searchstring
write incrsearch
563 pack
$sstring -side left
-expand 1 -fill x
564 set ctext .ctop.cdet.left.ctext
565 text
$ctext -bg white
-state disabled
-font $textfont \
566 -width $geometry(ctextw
) -height $geometry(ctexth
) \
567 -yscrollcommand scrolltext
-wrap none
568 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
569 pack .ctop.cdet.left.sb
-side right
-fill y
570 pack
$ctext -side left
-fill both
-expand 1
571 .ctop.cdet add .ctop.cdet.left
573 $ctext tag conf comment
-wrap $wrapcomment
574 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
575 $ctext tag conf hunksep
-fore blue
576 $ctext tag conf d0
-fore red
577 $ctext tag conf d1
-fore "#00a000"
578 $ctext tag conf m0
-fore red
579 $ctext tag conf m1
-fore blue
580 $ctext tag conf m2
-fore green
581 $ctext tag conf m3
-fore purple
582 $ctext tag conf
m4 -fore brown
583 $ctext tag conf m5
-fore "#009090"
584 $ctext tag conf m6
-fore magenta
585 $ctext tag conf m7
-fore "#808000"
586 $ctext tag conf m8
-fore "#009000"
587 $ctext tag conf m9
-fore "#ff0080"
588 $ctext tag conf m10
-fore cyan
589 $ctext tag conf m11
-fore "#b07070"
590 $ctext tag conf m12
-fore "#70b0f0"
591 $ctext tag conf m13
-fore "#70f0b0"
592 $ctext tag conf m14
-fore "#f0b070"
593 $ctext tag conf m15
-fore "#ff70b0"
594 $ctext tag conf mmax
-fore darkgrey
596 $ctext tag conf mresult
-font [concat
$textfont bold
]
597 $ctext tag conf msep
-font [concat
$textfont bold
]
598 $ctext tag conf found
-back yellow
600 frame .ctop.cdet.right
601 frame .ctop.cdet.right.mode
602 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
603 -command reselectline
-variable cmitmode
-value "patch"
604 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
605 -command reselectline
-variable cmitmode
-value "tree"
606 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
607 pack .ctop.cdet.right.mode
-side top
-fill x
608 set cflist .ctop.cdet.right.cfiles
609 set indent
[font measure
$mainfont "nn"]
610 text
$cflist -width $geometry(cflistw
) -background white
-font $mainfont \
611 -tabs [list
$indent [expr {2 * $indent}]] \
612 -yscrollcommand ".ctop.cdet.right.sb set" \
613 -cursor [. cget
-cursor] \
614 -spacing1 1 -spacing3 1
615 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
616 pack .ctop.cdet.right.sb
-side right
-fill y
617 pack
$cflist -side left
-fill both
-expand 1
618 $cflist tag configure highlight \
619 -background [$cflist cget
-selectbackground]
620 $cflist tag configure bold
-font [concat
$mainfont bold
]
621 .ctop.cdet add .ctop.cdet.right
622 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
624 pack .ctop
-side top
-fill both
-expand 1
626 bindall
<1> {selcanvline
%W
%x
%y
}
627 #bindall <B1-Motion> {selcanvline %W %x %y}
628 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
629 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
630 bindall
<2> "canvscan mark %W %x %y"
631 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
632 bindkey
<Home
> selfirstline
633 bindkey
<End
> sellastline
634 bind .
<Key-Up
> "selnextline -1"
635 bind .
<Key-Down
> "selnextline 1"
636 bind .
<Shift-Key-Up
> "next_highlight -1"
637 bind .
<Shift-Key-Down
> "next_highlight 1"
638 bindkey
<Key-Right
> "goforw"
639 bindkey
<Key-Left
> "goback"
640 bind .
<Key-Prior
> "selnextpage -1"
641 bind .
<Key-Next
> "selnextpage 1"
642 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
643 bind .
<Control-End
> "allcanvs yview moveto 1.0"
644 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
645 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
646 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
647 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
648 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
649 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
650 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
651 bindkey p
"selnextline -1"
652 bindkey n
"selnextline 1"
655 bindkey i
"selnextline -1"
656 bindkey k
"selnextline 1"
659 bindkey b
"$ctext yview scroll -1 pages"
660 bindkey d
"$ctext yview scroll 18 units"
661 bindkey u
"$ctext yview scroll -18 units"
662 bindkey
/ {findnext
1}
663 bindkey
<Key-Return
> {findnext
0}
666 bind .
<Control-q
> doquit
667 bind .
<Control-f
> dofind
668 bind .
<Control-g
> {findnext
0}
669 bind .
<Control-r
> dosearchback
670 bind .
<Control-s
> dosearch
671 bind .
<Control-equal
> {incrfont
1}
672 bind .
<Control-KP_Add
> {incrfont
1}
673 bind .
<Control-minus
> {incrfont
-1}
674 bind .
<Control-KP_Subtract
> {incrfont
-1}
675 bind .
<Destroy
> {savestuff
%W
}
676 bind .
<Button-1
> "click %W"
677 bind $fstring <Key-Return
> dofind
678 bind $sha1entry <Key-Return
> gotocommit
679 bind $sha1entry <<PasteSelection>> clearsha1
680 bind $cflist <1> {sel_flist %W %x %y; break}
681 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
682 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
684 set maincursor [. cget -cursor]
685 set textcursor [$ctext cget -cursor]
686 set curtextcursor $textcursor
688 set rowctxmenu .rowctxmenu
689 menu $rowctxmenu -tearoff 0
690 $rowctxmenu add command -label "Diff this -> selected" \
691 -command {diffvssel 0}
692 $rowctxmenu add command -label "Diff selected -> this" \
693 -command {diffvssel 1}
694 $rowctxmenu add command -label "Make patch" -command mkpatch
695 $rowctxmenu add command -label "Create tag" -command mktag
696 $rowctxmenu add command -label "Write commit to file" -command writecommit
699 # mouse-2 makes all windows scan vertically, but only the one
700 # the cursor is in scans horizontally
701 proc canvscan {op w x y} {
702 global canv canv2 canv3
703 foreach c [list $canv $canv2 $canv3] {
712 proc scrollcanv {cscroll f0 f1} {
718 # when we make a key binding for the toplevel, make sure
719 # it doesn't get triggered when that key is pressed in the
720 # find string entry widget.
721 proc bindkey {ev script} {
724 set escript [bind Entry $ev]
725 if {$escript == {}} {
726 set escript [bind Entry <Key>]
729 bind $e $ev "$escript; break"
733 # set the focus back to the toplevel for any click outside
744 global canv canv2 canv3 ctext cflist mainfont textfont uifont
745 global stuffsaved findmergefiles maxgraphpct
746 global maxwidth showneartags
747 global viewname viewfiles viewargs viewperm nextviewnum
748 global cmitmode wrapcomment
750 if {$stuffsaved} return
751 if {![winfo viewable .]} return
753 set f [open "~/.gitk-new" w]
754 puts $f [list set mainfont $mainfont]
755 puts $f [list set textfont $textfont]
756 puts $f [list set uifont $uifont]
757 puts $f [list set findmergefiles $findmergefiles]
758 puts $f [list set maxgraphpct $maxgraphpct]
759 puts $f [list set maxwidth $maxwidth]
760 puts $f [list set cmitmode $cmitmode]
761 puts $f [list set wrapcomment $wrapcomment]
762 puts $f [list set showneartags $showneartags]
763 puts $f "set geometry(width) [winfo width .ctop]"
764 puts $f "set geometry(height) [winfo height .ctop]"
765 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
766 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
767 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
768 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
769 set wid [expr {([winfo width $ctext] - 8) \
770 / [font measure $textfont "0"]}]
771 puts $f "set geometry(ctextw) $wid"
772 set wid [expr {([winfo width $cflist] - 11) \
773 / [font measure [$cflist cget -font] "0"]}]
774 puts $f "set geometry(cflistw) $wid"
775 puts -nonewline $f "set permviews {"
776 for {set v 0} {$v < $nextviewnum} {incr v} {
778 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
783 file rename -force "~/.gitk-new" "~/.gitk"
788 proc resizeclistpanes {win w} {
790 if {[info exists oldwidth($win)]} {
791 set s0 [$win sash coord 0]
792 set s1 [$win sash coord 1]
794 set sash0 [expr {int($w/2 - 2)}]
795 set sash1 [expr {int($w*5/6 - 2)}]
797 set factor [expr {1.0 * $w / $oldwidth($win)}]
798 set sash0 [expr {int($factor * [lindex $s0 0])}]
799 set sash1 [expr {int($factor * [lindex $s1 0])}]
803 if {$sash1 < $sash0 + 20} {
804 set sash1 [expr {$sash0 + 20}]
806 if {$sash1 > $w - 10} {
807 set sash1 [expr {$w - 10}]
808 if {$sash0 > $sash1 - 20} {
809 set sash0 [expr {$sash1 - 20}]
813 $win sash place 0 $sash0 [lindex $s0 1]
814 $win sash place 1 $sash1 [lindex $s1 1]
816 set oldwidth($win) $w
819 proc resizecdetpanes {win w} {
821 if {[info exists oldwidth($win)]} {
822 set s0 [$win sash coord 0]
824 set sash0 [expr {int($w*3/4 - 2)}]
826 set factor [expr {1.0 * $w / $oldwidth($win)}]
827 set sash0 [expr {int($factor * [lindex $s0 0])}]
831 if {$sash0 > $w - 15} {
832 set sash0 [expr {$w - 15}]
835 $win sash place 0 $sash0 [lindex $s0 1]
837 set oldwidth($win) $w
841 global canv canv2 canv3
847 proc bindall {event action} {
848 global canv canv2 canv3
849 bind $canv $event $action
850 bind $canv2 $event $action
851 bind $canv3 $event $action
856 if {[winfo exists $w]} {
861 wm title $w "About gitk"
863 Gitk - a commit viewer for git
865 Copyright © 2005-2006 Paul Mackerras
867 Use and redistribute under the terms of the GNU General Public License} \
868 -justify center -aspect 400
869 pack $w.m -side top -fill x -padx 20 -pady 20
870 button $w.ok -text Close -command "destroy $w"
871 pack $w.ok -side bottom
876 if {[winfo exists $w]} {
881 wm title $w "Gitk key bindings"
886 <Home> Move to first commit
887 <End> Move to last commit
888 <Up>, p, i Move up one commit
889 <Down>, n, k Move down one commit
890 <Left>, z, j Go back in history list
891 <Right>, x, l Go forward in history list
892 <PageUp> Move up one page in commit list
893 <PageDown> Move down one page in commit list
894 <Ctrl-Home> Scroll to top of commit list
895 <Ctrl-End> Scroll to bottom of commit list
896 <Ctrl-Up> Scroll commit list up one line
897 <Ctrl-Down> Scroll commit list down one line
898 <Ctrl-PageUp> Scroll commit list up one page
899 <Ctrl-PageDown> Scroll commit list down one page
900 <Shift-Up> Move to previous highlighted line
901 <Shift-Down> Move to next highlighted line
902 <Delete>, b Scroll diff view up one page
903 <Backspace> Scroll diff view up one page
904 <Space> Scroll diff view down one page
905 u Scroll diff view up 18 lines
906 d Scroll diff view down 18 lines
908 <Ctrl-G> Move to next find hit
909 <Return> Move to next find hit
910 / Move to next find hit, or redo find
911 ? Move to previous find hit
912 f Scroll diff view to next file
913 <Ctrl-S> Search for next hit in diff view
914 <Ctrl-R> Search for previous hit in diff view
915 <Ctrl-KP+> Increase font size
916 <Ctrl-plus> Increase font size
917 <Ctrl-KP-> Decrease font size
918 <Ctrl-minus> Decrease font size
920 -justify left -bg white -border 2 -relief sunken
921 pack $w.m -side top -fill both
922 button $w.ok -text Close -command "destroy $w"
923 pack $w.ok -side bottom
926 # Procedures for manipulating the file list window at the
927 # bottom right of the overall window.
929 proc treeview {w l openlevs} {
930 global treecontents treediropen treeheight treeparent treeindex
940 set treecontents() {}
941 $w conf -state normal
943 while {[string range $f 0 $prefixend] ne $prefix} {
944 if {$lev <= $openlevs} {
945 $w mark set e:$treeindex($prefix) "end -1c"
946 $w mark gravity e:$treeindex($prefix) left
948 set treeheight($prefix) $ht
949 incr ht [lindex $htstack end]
950 set htstack [lreplace $htstack end end]
951 set prefixend [lindex $prefendstack end]
952 set prefendstack [lreplace $prefendstack end end]
953 set prefix [string range $prefix 0 $prefixend]
956 set tail [string range $f [expr {$prefixend+1}] end]
957 while {[set slash [string first "/" $tail]] >= 0} {
960 lappend prefendstack $prefixend
961 incr prefixend [expr {$slash + 1}]
962 set d [string range $tail 0 $slash]
963 lappend treecontents($prefix) $d
964 set oldprefix $prefix
966 set treecontents($prefix) {}
967 set treeindex($prefix) [incr ix]
968 set treeparent($prefix) $oldprefix
969 set tail [string range $tail [expr {$slash+1}] end]
970 if {$lev <= $openlevs} {
972 set treediropen($prefix) [expr {$lev < $openlevs}]
973 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
974 $w mark set d:$ix "end -1c"
975 $w mark gravity d:$ix left
977 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
979 $w image create end -align center -image $bm -padx 1 \
981 $w insert end $d [highlight_tag $prefix]
982 $w mark set s:$ix "end -1c"
983 $w mark gravity s:$ix left
988 if {$lev <= $openlevs} {
991 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
993 $w insert end $tail [highlight_tag $f]
995 lappend treecontents($prefix) $tail
998 while {$htstack ne {}} {
999 set treeheight($prefix) $ht
1000 incr ht [lindex $htstack end]
1001 set htstack [lreplace $htstack end end]
1003 $w conf -state disabled
1006 proc linetoelt {l} {
1007 global treeheight treecontents
1012 foreach e $treecontents($prefix) {
1017 if {[string index $e end] eq "/"} {
1018 set n $treeheight($prefix$e)
1030 proc highlight_tree {y prefix} {
1031 global treeheight treecontents cflist
1033 foreach e $treecontents($prefix) {
1035 if {[highlight_tag $path] ne {}} {
1036 $cflist tag add bold $y.0 "$y.0 lineend"
1039 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1040 set y [highlight_tree $y $path]
1046 proc treeclosedir {w dir} {
1047 global treediropen treeheight treeparent treeindex
1049 set ix $treeindex($dir)
1050 $w conf -state normal
1051 $w delete s:$ix e:$ix
1052 set treediropen($dir) 0
1053 $w image configure a:$ix -image tri-rt
1054 $w conf -state disabled
1055 set n [expr {1 - $treeheight($dir)}]
1056 while {$dir ne {}} {
1057 incr treeheight($dir) $n
1058 set dir $treeparent($dir)
1062 proc treeopendir {w dir} {
1063 global treediropen treeheight treeparent treecontents treeindex
1065 set ix $treeindex($dir)
1066 $w conf -state normal
1067 $w image configure a:$ix -image tri-dn
1068 $w mark set e:$ix s:$ix
1069 $w mark gravity e:$ix right
1072 set n [llength $treecontents($dir)]
1073 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1076 incr treeheight($x) $n
1078 foreach e $treecontents($dir) {
1080 if {[string index $e end] eq "/"} {
1081 set iy $treeindex($de)
1082 $w mark set d:$iy e:$ix
1083 $w mark gravity d:$iy left
1084 $w insert e:$ix $str
1085 set treediropen($de) 0
1086 $w image create e:$ix -align center -image tri-rt -padx 1 \
1088 $w insert e:$ix $e [highlight_tag $de]
1089 $w mark set s:$iy e:$ix
1090 $w mark gravity s:$iy left
1091 set treeheight($de) 1
1093 $w insert e:$ix $str
1094 $w insert e:$ix $e [highlight_tag $de]
1097 $w mark gravity e:$ix left
1098 $w conf -state disabled
1099 set treediropen($dir) 1
1100 set top [lindex [split [$w index @0,0] .] 0]
1101 set ht [$w cget -height]
1102 set l [lindex [split [$w index s:$ix] .] 0]
1105 } elseif {$l + $n + 1 > $top + $ht} {
1106 set top [expr {$l + $n + 2 - $ht}]
1114 proc treeclick {w x y} {
1115 global treediropen cmitmode ctext cflist cflist_top
1117 if {$cmitmode ne "tree"} return
1118 if {![info exists cflist_top]} return
1119 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1120 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1121 $cflist tag add highlight $l.0 "$l.0 lineend"
1127 set e [linetoelt $l]
1128 if {[string index $e end] ne "/"} {
1130 } elseif {$treediropen($e)} {
1137 proc setfilelist {id} {
1138 global treefilelist cflist
1140 treeview $cflist $treefilelist($id) 0
1143 image create bitmap tri-rt -background black -foreground blue -data {
1144 #define tri-rt_width 13
1145 #define tri-rt_height 13
1146 static unsigned char tri-rt_bits[] = {
1147 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1148 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1151 #define tri-rt-mask_width 13
1152 #define tri-rt-mask_height 13
1153 static unsigned char tri-rt-mask_bits[] = {
1154 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1155 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1158 image create bitmap tri-dn -background black -foreground blue -data {
1159 #define tri-dn_width 13
1160 #define tri-dn_height 13
1161 static unsigned char tri-dn_bits[] = {
1162 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1163 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1166 #define tri-dn-mask_width 13
1167 #define tri-dn-mask_height 13
1168 static unsigned char tri-dn-mask_bits[] = {
1169 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1170 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1174 proc init_flist {first} {
1175 global cflist cflist_top selectedline difffilestart
1177 $cflist conf -state normal
1178 $cflist delete 0.0 end
1180 $cflist insert end $first
1182 $cflist tag add highlight 1.0 "1.0 lineend"
1184 catch {unset cflist_top}
1186 $cflist conf -state disabled
1187 set difffilestart {}
1190 proc highlight_tag {f} {
1191 global highlight_paths
1193 foreach p $highlight_paths {
1194 if {[string match $p $f]} {
1201 proc highlight_filelist {} {
1202 global cmitmode cflist
1204 $cflist conf -state normal
1205 if {$cmitmode ne "tree"} {
1206 set end [lindex [split [$cflist index end] .] 0]
1207 for {set l 2} {$l < $end} {incr l} {
1208 set line [$cflist get $l.0 "$l.0 lineend"]
1209 if {[highlight_tag $line] ne {}} {
1210 $cflist tag add bold $l.0 "$l.0 lineend"
1216 $cflist conf -state disabled
1219 proc unhighlight_filelist {} {
1222 $cflist conf -state normal
1223 $cflist tag remove bold 1.0 end
1224 $cflist conf -state disabled
1227 proc add_flist {fl} {
1230 $cflist conf -state normal
1232 $cflist insert end "\n"
1233 $cflist insert end $f [highlight_tag $f]
1235 $cflist conf -state disabled
1238 proc sel_flist {w x y} {
1239 global ctext difffilestart cflist cflist_top cmitmode
1241 if {$cmitmode eq "tree"} return
1242 if {![info exists cflist_top]} return
1243 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1244 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1245 $cflist tag add highlight $l.0 "$l.0 lineend"
1250 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1254 # Functions for adding and removing shell-type quoting
1256 proc shellquote {str} {
1257 if {![string match "*\['\"\\ \t]*" $str]} {
1260 if {![string match "*\['\"\\]*" $str]} {
1263 if {![string match "*'*" $str]} {
1266 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1269 proc shellarglist {l} {
1275 append str [shellquote $a]
1280 proc shelldequote {str} {
1285 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1286 append ret [string range $str $used end]
1287 set used [string length $str]
1290 set first [lindex $first 0]
1291 set ch [string index $str $first]
1292 if {$first > $used} {
1293 append ret [string range $str $used [expr {$first - 1}]]
1296 if {$ch eq " " || $ch eq "\t"} break
1299 set first [string first "'" $str $used]
1301 error "unmatched single-quote"
1303 append ret [string range $str $used [expr {$first - 1}]]
1308 if {$used >= [string length $str]} {
1309 error "trailing backslash"
1311 append ret [string index $str $used]
1316 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1317 error "unmatched double-quote"
1319 set first [lindex $first 0]
1320 set ch [string index $str $first]
1321 if {$first > $used} {
1322 append ret [string range $str $used [expr {$first - 1}]]
1325 if {$ch eq "\""} break
1327 append ret [string index $str $used]
1331 return [list $used $ret]
1334 proc shellsplit {str} {
1337 set str [string trimleft $str]
1338 if {$str eq {}} break
1339 set dq [shelldequote $str]
1340 set n [lindex $dq 0]
1341 set word [lindex $dq 1]
1342 set str [string range $str $n end]
1348 # Code to implement multiple views
1350 proc newview {ishighlight} {
1351 global nextviewnum newviewname newviewperm uifont newishighlight
1352 global newviewargs revtreeargs
1354 set newishighlight $ishighlight
1356 if {[winfo exists $top]} {
1360 set newviewname($nextviewnum) "View $nextviewnum"
1361 set newviewperm($nextviewnum) 0
1362 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1363 vieweditor $top $nextviewnum "Gitk view definition"
1368 global viewname viewperm newviewname newviewperm
1369 global viewargs newviewargs
1371 set top .gitkvedit-$curview
1372 if {[winfo exists $top]} {
1376 set newviewname($curview) $viewname($curview)
1377 set newviewperm($curview) $viewperm($curview)
1378 set newviewargs($curview) [shellarglist $viewargs($curview)]
1379 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1382 proc vieweditor {top n title} {
1383 global newviewname newviewperm viewfiles
1387 wm title $top $title
1388 label $top.nl -text "Name" -font $uifont
1389 entry $top.name -width 20 -textvariable newviewname($n)
1390 grid $top.nl $top.name -sticky w -pady 5
1391 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1392 grid $top.perm - -pady 5 -sticky w
1393 message $top.al -aspect 1000 -font $uifont \
1394 -text "Commits to include (arguments to git rev-list):"
1395 grid $top.al - -sticky w -pady 5
1396 entry $top.args -width 50 -textvariable newviewargs($n) \
1398 grid $top.args - -sticky ew -padx 5
1399 message $top.l -aspect 1000 -font $uifont \
1400 -text "Enter files and directories to include, one per line:"
1401 grid $top.l - -sticky w
1402 text $top.t -width 40 -height 10 -background white
1403 if {[info exists viewfiles($n)]} {
1404 foreach f $viewfiles($n) {
1405 $top.t insert end $f
1406 $top.t insert end "\n"
1408 $top.t delete {end - 1c} end
1409 $top.t mark set insert 0.0
1411 grid $top.t - -sticky ew -padx 5
1413 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1414 button $top.buts.can -text "Cancel" -command [list destroy $top]
1415 grid $top.buts.ok $top.buts.can
1416 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1417 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1418 grid $top.buts - -pady 10 -sticky ew
1422 proc doviewmenu {m first cmd op argv} {
1423 set nmenu [$m index end]
1424 for {set i $first} {$i <= $nmenu} {incr i} {
1425 if {[$m entrycget $i -command] eq $cmd} {
1426 eval $m $op $i $argv
1432 proc allviewmenus {n op args} {
1435 doviewmenu .bar.view 7 [list showview $n] $op $args
1436 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1439 proc newviewok {top n} {
1440 global nextviewnum newviewperm newviewname newishighlight
1441 global viewname viewfiles viewperm selectedview curview
1442 global viewargs newviewargs viewhlmenu
1445 set newargs [shellsplit $newviewargs($n)]
1447 error_popup "Error in commit selection arguments: $err"
1453 foreach f [split [$top.t get 0.0 end] "\n"] {
1454 set ft [string trim $f]
1459 if {![info exists viewfiles($n)]} {
1460 # creating a new view
1462 set viewname($n) $newviewname($n)
1463 set viewperm($n) $newviewperm($n)
1464 set viewfiles($n) $files
1465 set viewargs($n) $newargs
1467 if {!$newishighlight} {
1468 after idle showview $n
1470 after idle addvhighlight $n
1473 # editing an existing view
1474 set viewperm($n) $newviewperm($n)
1475 if {$newviewname($n) ne $viewname($n)} {
1476 set viewname($n) $newviewname($n)
1477 doviewmenu .bar.view 7 [list showview $n] \
1478 entryconf [list -label $viewname($n)]
1479 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1480 entryconf [list -label $viewname($n) -value $viewname($n)]
1482 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1483 set viewfiles($n) $files
1484 set viewargs($n) $newargs
1485 if {$curview == $n} {
1486 after idle updatecommits
1490 catch {destroy $top}
1494 global curview viewdata viewperm hlview selectedhlview
1496 if {$curview == 0} return
1497 if {[info exists hlview] && $hlview == $curview} {
1498 set selectedhlview None
1501 allviewmenus $curview delete
1502 set viewdata($curview) {}
1503 set viewperm($curview) 0
1507 proc addviewmenu {n} {
1508 global viewname viewhlmenu
1510 .bar.view add radiobutton -label $viewname($n) \
1511 -command [list showview $n] -variable selectedview -value $n
1512 $viewhlmenu add radiobutton -label $viewname($n) \
1513 -command [list addvhighlight $n] -variable selectedhlview
1516 proc flatten {var} {
1520 foreach i [array names $var] {
1521 lappend ret $i [set $var\($i\)]
1526 proc unflatten {var l} {
1536 global curview viewdata viewfiles
1537 global displayorder parentlist childlist rowidlist rowoffsets
1538 global colormap rowtextx commitrow nextcolor canvxmax
1539 global numcommits rowrangelist commitlisted idrowranges
1540 global selectedline currentid canv canvy0
1541 global matchinglines treediffs
1542 global pending_select phase
1543 global commitidx rowlaidout rowoptim linesegends
1544 global commfd nextupdate
1546 global vparentlist vchildlist vdisporder vcmitlisted
1547 global hlview selectedhlview
1549 if {$n == $curview} return
1551 if {[info exists selectedline]} {
1552 set selid $currentid
1553 set y [yc $selectedline]
1554 set ymax [lindex [$canv cget -scrollregion] 3]
1555 set span [$canv yview]
1556 set ytop [expr {[lindex $span 0] * $ymax}]
1557 set ybot [expr {[lindex $span 1] * $ymax}]
1558 if {$ytop < $y && $y < $ybot} {
1559 set yscreen [expr {$y - $ytop}]
1561 set yscreen [expr {($ybot - $ytop) / 2}]
1567 if {$curview >= 0} {
1568 set vparentlist($curview) $parentlist
1569 set vchildlist($curview) $childlist
1570 set vdisporder($curview) $displayorder
1571 set vcmitlisted($curview) $commitlisted
1573 set viewdata($curview) \
1574 [list $phase $rowidlist $rowoffsets $rowrangelist \
1575 [flatten idrowranges] [flatten idinlist] \
1576 $rowlaidout $rowoptim $numcommits $linesegends]
1577 } elseif {![info exists viewdata($curview)]
1578 || [lindex $viewdata($curview) 0] ne {}} {
1579 set viewdata($curview) \
1580 [list {} $rowidlist $rowoffsets $rowrangelist]
1583 catch {unset matchinglines}
1584 catch {unset treediffs}
1586 if {[info exists hlview] && $hlview == $n} {
1588 set selectedhlview None
1593 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1594 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1596 if {![info exists viewdata($n)]} {
1597 set pending_select $selid
1603 set phase [lindex $v 0]
1604 set displayorder $vdisporder($n)
1605 set parentlist $vparentlist($n)
1606 set childlist $vchildlist($n)
1607 set commitlisted $vcmitlisted($n)
1608 set rowidlist [lindex $v 1]
1609 set rowoffsets [lindex $v 2]
1610 set rowrangelist [lindex $v 3]
1612 set numcommits [llength $displayorder]
1613 catch {unset idrowranges}
1615 unflatten idrowranges [lindex $v 4]
1616 unflatten idinlist [lindex $v 5]
1617 set rowlaidout [lindex $v 6]
1618 set rowoptim [lindex $v 7]
1619 set numcommits [lindex $v 8]
1620 set linesegends [lindex $v 9]
1623 catch {unset colormap}
1624 catch {unset rowtextx}
1626 set canvxmax [$canv cget -width]
1632 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1633 set row $commitrow($n,$selid)
1634 # try to get the selected row in the same position on the screen
1635 set ymax [lindex [$canv cget -scrollregion] 3]
1636 set ytop [expr {[yc $row] - $yscreen}]
1640 set yf [expr {$ytop * 1.0 / $ymax}]
1642 allcanvs yview moveto $yf
1646 if {$phase eq "getcommits"} {
1647 show_status "Reading commits..."
1649 if {[info exists commfd($n)]} {
1654 } elseif {$numcommits == 0} {
1655 show_status "No commits selected"
1659 # Stuff relating to the highlighting facility
1661 proc ishighlighted {row} {
1662 global vhighlights fhighlights nhighlights rhighlights
1664 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1665 return $nhighlights($row)
1667 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1668 return $vhighlights($row)
1670 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1671 return $fhighlights($row)
1673 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1674 return $rhighlights($row)
1679 proc bolden {row font} {
1680 global canv linehtag selectedline boldrows
1682 lappend boldrows $row
1683 $canv itemconf $linehtag($row) -font $font
1684 if {[info exists selectedline] && $row == $selectedline} {
1686 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1687 -outline {{}} -tags secsel \
1688 -fill [$canv cget -selectbackground]]
1693 proc bolden_name {row font} {
1694 global canv2 linentag selectedline boldnamerows
1696 lappend boldnamerows $row
1697 $canv2 itemconf $linentag($row) -font $font
1698 if {[info exists selectedline] && $row == $selectedline} {
1699 $canv2 delete secsel
1700 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1701 -outline {{}} -tags secsel \
1702 -fill [$canv2 cget -selectbackground]]
1708 global mainfont boldrows
1711 foreach row $boldrows {
1712 if {![ishighlighted $row]} {
1713 bolden $row $mainfont
1715 lappend stillbold $row
1718 set boldrows $stillbold
1721 proc addvhighlight {n} {
1722 global hlview curview viewdata vhl_done vhighlights commitidx
1724 if {[info exists hlview]} {
1728 if {$n != $curview && ![info exists viewdata($n)]} {
1729 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1730 set vparentlist($n) {}
1731 set vchildlist($n) {}
1732 set vdisporder($n) {}
1733 set vcmitlisted($n) {}
1736 set vhl_done $commitidx($hlview)
1737 if {$vhl_done > 0} {
1742 proc delvhighlight {} {
1743 global hlview vhighlights
1745 if {![info exists hlview]} return
1747 catch {unset vhighlights}
1751 proc vhighlightmore {} {
1752 global hlview vhl_done commitidx vhighlights
1753 global displayorder vdisporder curview mainfont
1755 set font [concat $mainfont bold]
1756 set max $commitidx($hlview)
1757 if {$hlview == $curview} {
1758 set disp $displayorder
1760 set disp $vdisporder($hlview)
1762 set vr [visiblerows]
1763 set r0 [lindex $vr 0]
1764 set r1 [lindex $vr 1]
1765 for {set i $vhl_done} {$i < $max} {incr i} {
1766 set id [lindex $disp $i]
1767 if {[info exists commitrow($curview,$id)]} {
1768 set row $commitrow($curview,$id)
1769 if {$r0 <= $row && $row <= $r1} {
1770 if {![highlighted $row]} {
1773 set vhighlights($row) 1
1780 proc askvhighlight {row id} {
1781 global hlview vhighlights commitrow iddrawn mainfont
1783 if {[info exists commitrow($hlview,$id)]} {
1784 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1785 bolden $row [concat $mainfont bold]
1787 set vhighlights($row) 1
1789 set vhighlights($row) 0
1793 proc hfiles_change {name ix op} {
1794 global highlight_files filehighlight fhighlights fh_serial
1795 global mainfont highlight_paths
1797 if {[info exists filehighlight]} {
1798 # delete previous highlights
1799 catch {close $filehighlight}
1801 catch {unset fhighlights}
1803 unhighlight_filelist
1805 set highlight_paths {}
1806 after cancel do_file_hl $fh_serial
1808 if {$highlight_files ne {}} {
1809 after 300 do_file_hl $fh_serial
1813 proc makepatterns {l} {
1816 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1817 if {[string index $ee end] eq "/"} {
1827 proc do_file_hl {serial} {
1828 global highlight_files filehighlight highlight_paths gdttype fhl_list
1830 if {$gdttype eq "touching paths:"} {
1831 if {[catch {set paths [shellsplit $highlight_files]}]} return
1832 set highlight_paths [makepatterns $paths]
1834 set gdtargs [concat -- $paths]
1836 set gdtargs [list "-S$highlight_files"]
1838 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1839 set filehighlight [open $cmd r+]
1840 fconfigure $filehighlight -blocking 0
1841 fileevent $filehighlight readable readfhighlight
1847 proc flushhighlights {} {
1848 global filehighlight fhl_list
1850 if {[info exists filehighlight]} {
1852 puts $filehighlight ""
1853 flush $filehighlight
1857 proc askfilehighlight {row id} {
1858 global filehighlight fhighlights fhl_list
1860 lappend fhl_list $id
1861 set fhighlights($row) -1
1862 puts $filehighlight $id
1865 proc readfhighlight {} {
1866 global filehighlight fhighlights commitrow curview mainfont iddrawn
1869 while {[gets $filehighlight line] >= 0} {
1870 set line [string trim $line]
1871 set i [lsearch -exact $fhl_list $line]
1872 if {$i < 0} continue
1873 for {set j 0} {$j < $i} {incr j} {
1874 set id [lindex $fhl_list $j]
1875 if {[info exists commitrow($curview,$id)]} {
1876 set fhighlights($commitrow($curview,$id)) 0
1879 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1880 if {$line eq {}} continue
1881 if {![info exists commitrow($curview,$line)]} continue
1882 set row $commitrow($curview,$line)
1883 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1884 bolden $row [concat $mainfont bold]
1886 set fhighlights($row) 1
1888 if {[eof $filehighlight]} {
1890 puts "oops, git-diff-tree died"
1891 catch {close $filehighlight}
1897 proc find_change {name ix op} {
1898 global nhighlights mainfont boldnamerows
1899 global findstring findpattern findtype
1901 # delete previous highlights, if any
1902 foreach row $boldnamerows {
1903 bolden_name $row $mainfont
1906 catch {unset nhighlights}
1908 if {$findtype ne "Regexp"} {
1909 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1911 set findpattern "*$e*"
1916 proc askfindhighlight {row id} {
1917 global nhighlights commitinfo iddrawn mainfont
1918 global findstring findtype findloc findpattern
1920 if {![info exists commitinfo($id)]} {
1923 set info $commitinfo($id)
1925 set fldtypes {Headline Author Date Committer CDate Comments}
1926 foreach f $info ty $fldtypes {
1927 if {$findloc ne "All fields" && $findloc ne $ty} {
1930 if {$findtype eq "Regexp"} {
1931 set doesmatch [regexp $findstring $f]
1932 } elseif {$findtype eq "IgnCase"} {
1933 set doesmatch [string match -nocase $findpattern $f]
1935 set doesmatch [string match $findpattern $f]
1938 if {$ty eq "Author"} {
1945 if {[info exists iddrawn($id)]} {
1946 if {$isbold && ![ishighlighted $row]} {
1947 bolden $row [concat $mainfont bold]
1950 bolden_name $row [concat $mainfont bold]
1953 set nhighlights($row) $isbold
1956 proc vrel_change {name ix op} {
1957 global highlight_related
1960 if {$highlight_related ne "None"} {
1961 after idle drawvisible
1965 # prepare for testing whether commits are descendents or ancestors of a
1966 proc rhighlight_sel {a} {
1967 global descendent desc_todo ancestor anc_todo
1968 global highlight_related rhighlights
1970 catch {unset descendent}
1971 set desc_todo [list $a]
1972 catch {unset ancestor}
1973 set anc_todo [list $a]
1974 if {$highlight_related ne "None"} {
1976 after idle drawvisible
1980 proc rhighlight_none {} {
1983 catch {unset rhighlights}
1987 proc is_descendent {a} {
1988 global curview children commitrow descendent desc_todo
1991 set la $commitrow($v,$a)
1995 for {set i 0} {$i < [llength $todo]} {incr i} {
1996 set do [lindex $todo $i]
1997 if {$commitrow($v,$do) < $la} {
1998 lappend leftover $do
2001 foreach nk $children($v,$do) {
2002 if {![info exists descendent($nk)]} {
2003 set descendent($nk) 1
2011 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2015 set descendent($a) 0
2016 set desc_todo $leftover
2019 proc is_ancestor {a} {
2020 global curview parentlist commitrow ancestor anc_todo
2023 set la $commitrow($v,$a)
2027 for {set i 0} {$i < [llength $todo]} {incr i} {
2028 set do [lindex $todo $i]
2029 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2030 lappend leftover $do
2033 foreach np [lindex $parentlist $commitrow($v,$do)] {
2034 if {![info exists ancestor($np)]} {
2043 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2048 set anc_todo $leftover
2051 proc askrelhighlight {row id} {
2052 global descendent highlight_related iddrawn mainfont rhighlights
2053 global selectedline ancestor
2055 if {![info exists selectedline]} return
2057 if {$highlight_related eq "Descendent" ||
2058 $highlight_related eq "Not descendent"} {
2059 if {![info exists descendent($id)]} {
2062 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2065 } elseif {$highlight_related eq "Ancestor" ||
2066 $highlight_related eq "Not ancestor"} {
2067 if {![info exists ancestor($id)]} {
2070 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2074 if {[info exists iddrawn($id)]} {
2075 if {$isbold && ![ishighlighted $row]} {
2076 bolden $row [concat $mainfont bold]
2079 set rhighlights($row) $isbold
2082 proc next_hlcont {} {
2083 global fhl_row fhl_dirn displayorder numcommits
2084 global vhighlights fhighlights nhighlights rhighlights
2085 global hlview filehighlight findstring highlight_related
2087 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2090 if {$row < 0 || $row >= $numcommits} {
2095 set id [lindex $displayorder $row]
2096 if {[info exists hlview]} {
2097 if {![info exists vhighlights($row)]} {
2098 askvhighlight $row $id
2100 if {$vhighlights($row) > 0} break
2102 if {$findstring ne {}} {
2103 if {![info exists nhighlights($row)]} {
2104 askfindhighlight $row $id
2106 if {$nhighlights($row) > 0} break
2108 if {$highlight_related ne "None"} {
2109 if {![info exists rhighlights($row)]} {
2110 askrelhighlight $row $id
2112 if {$rhighlights($row) > 0} break
2114 if {[info exists filehighlight]} {
2115 if {![info exists fhighlights($row)]} {
2116 # ask for a few more while we're at it...
2118 for {set n 0} {$n < 100} {incr n} {
2119 if {![info exists fhighlights($r)]} {
2120 askfilehighlight $r [lindex $displayorder $r]
2123 if {$r < 0 || $r >= $numcommits} break
2127 if {$fhighlights($row) < 0} {
2131 if {$fhighlights($row) > 0} break
2139 proc next_highlight {dirn} {
2140 global selectedline fhl_row fhl_dirn
2141 global hlview filehighlight findstring highlight_related
2143 if {![info exists selectedline]} return
2144 if {!([info exists hlview] || $findstring ne {} ||
2145 $highlight_related ne "None" || [info exists filehighlight])} return
2146 set fhl_row [expr {$selectedline + $dirn}]
2151 proc cancel_next_highlight {} {
2157 # Graph layout functions
2159 proc shortids {ids} {
2162 if {[llength $id] > 1} {
2163 lappend res [shortids $id]
2164 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2165 lappend res [string range $id 0 7]
2173 proc incrange {l x o} {
2176 set e [lindex $l $x]
2178 lset l $x [expr {$e + $o}]
2187 for {} {$n > 0} {incr n -1} {
2193 proc usedinrange {id l1 l2} {
2194 global children commitrow childlist curview
2196 if {[info exists commitrow($curview,$id)]} {
2197 set r $commitrow($curview,$id)
2198 if {$l1 <= $r && $r <= $l2} {
2199 return [expr {$r - $l1 + 1}]
2201 set kids [lindex $childlist $r]
2203 set kids $children($curview,$id)
2206 set r $commitrow($curview,$c)
2207 if {$l1 <= $r && $r <= $l2} {
2208 return [expr {$r - $l1 + 1}]
2214 proc sanity {row {full 0}} {
2215 global rowidlist rowoffsets
2218 set ids [lindex $rowidlist $row]
2221 if {$id eq {}} continue
2222 if {$col < [llength $ids] - 1 &&
2223 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2224 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2226 set o [lindex $rowoffsets $row $col]
2232 if {[lindex $rowidlist $y $x] != $id} {
2233 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2234 puts " id=[shortids $id] check started at row $row"
2235 for {set i $row} {$i >= $y} {incr i -1} {
2236 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2241 set o [lindex $rowoffsets $y $x]
2246 proc makeuparrow {oid x y z} {
2247 global rowidlist rowoffsets uparrowlen idrowranges
2249 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2252 set off0 [lindex $rowoffsets $y]
2253 for {set x0 $x} {1} {incr x0} {
2254 if {$x0 >= [llength $off0]} {
2255 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2258 set z [lindex $off0 $x0]
2264 set z [expr {$x0 - $x}]
2265 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2266 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2268 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2269 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2270 lappend idrowranges($oid) $y
2273 proc initlayout {} {
2274 global rowidlist rowoffsets displayorder commitlisted
2275 global rowlaidout rowoptim
2276 global idinlist rowchk rowrangelist idrowranges
2277 global numcommits canvxmax canv
2279 global parentlist childlist children
2280 global colormap rowtextx
2292 catch {unset idinlist}
2293 catch {unset rowchk}
2296 set canvxmax [$canv cget -width]
2297 catch {unset colormap}
2298 catch {unset rowtextx}
2299 catch {unset idrowranges}
2303 proc setcanvscroll {} {
2304 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2306 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2307 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2308 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2309 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2312 proc visiblerows {} {
2313 global canv numcommits linespc
2315 set ymax [lindex [$canv cget -scrollregion] 3]
2316 if {$ymax eq {} || $ymax == 0} return
2318 set y0 [expr {int([lindex $f 0] * $ymax)}]
2319 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2323 set y1 [expr {int([lindex $f 1] * $ymax)}]
2324 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2325 if {$r1 >= $numcommits} {
2326 set r1 [expr {$numcommits - 1}]
2328 return [list $r0 $r1]
2331 proc layoutmore {} {
2332 global rowlaidout rowoptim commitidx numcommits optim_delay
2333 global uparrowlen curview
2336 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2337 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2338 if {$orow > $rowoptim} {
2339 optimize_rows $rowoptim 0 $orow
2342 set canshow [expr {$rowoptim - $optim_delay}]
2343 if {$canshow > $numcommits} {
2348 proc showstuff {canshow} {
2349 global numcommits commitrow pending_select selectedline
2350 global linesegends idrowranges idrangedrawn curview
2352 if {$numcommits == 0} {
2354 set phase "incrdraw"
2358 set numcommits $canshow
2360 set rows [visiblerows]
2361 set r0 [lindex $rows 0]
2362 set r1 [lindex $rows 1]
2364 for {set r $row} {$r < $canshow} {incr r} {
2365 foreach id [lindex $linesegends [expr {$r+1}]] {
2367 foreach {s e} [rowranges $id] {
2369 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2370 && ![info exists idrangedrawn($id,$i)]} {
2372 set idrangedrawn($id,$i) 1
2377 if {$canshow > $r1} {
2380 while {$row < $canshow} {
2384 if {[info exists pending_select] &&
2385 [info exists commitrow($curview,$pending_select)] &&
2386 $commitrow($curview,$pending_select) < $numcommits} {
2387 selectline $commitrow($curview,$pending_select) 1
2389 if {![info exists selectedline] && ![info exists pending_select]} {
2394 proc layoutrows {row endrow last} {
2395 global rowidlist rowoffsets displayorder
2396 global uparrowlen downarrowlen maxwidth mingaplen
2397 global childlist parentlist
2398 global idrowranges linesegends
2399 global commitidx curview
2400 global idinlist rowchk rowrangelist
2402 set idlist [lindex $rowidlist $row]
2403 set offs [lindex $rowoffsets $row]
2404 while {$row < $endrow} {
2405 set id [lindex $displayorder $row]
2408 foreach p [lindex $parentlist $row] {
2409 if {![info exists idinlist($p)]} {
2411 } elseif {!$idinlist($p)} {
2416 set nev [expr {[llength $idlist] + [llength $newolds]
2417 + [llength $oldolds] - $maxwidth + 1}]
2420 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2421 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2422 set i [lindex $idlist $x]
2423 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2424 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2425 [expr {$row + $uparrowlen + $mingaplen}]]
2427 set idlist [lreplace $idlist $x $x]
2428 set offs [lreplace $offs $x $x]
2429 set offs [incrange $offs $x 1]
2431 set rm1 [expr {$row - 1}]
2433 lappend idrowranges($i) $rm1
2434 if {[incr nev -1] <= 0} break
2437 set rowchk($id) [expr {$row + $r}]
2440 lset rowidlist $row $idlist
2441 lset rowoffsets $row $offs
2443 lappend linesegends $lse
2444 set col [lsearch -exact $idlist $id]
2446 set col [llength $idlist]
2448 lset rowidlist $row $idlist
2450 if {[lindex $childlist $row] ne {}} {
2451 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2455 lset rowoffsets $row $offs
2457 makeuparrow $id $col $row $z
2463 if {[info exists idrowranges($id)]} {
2464 set ranges $idrowranges($id)
2466 unset idrowranges($id)
2468 lappend rowrangelist $ranges
2470 set offs [ntimes [llength $idlist] 0]
2471 set l [llength $newolds]
2472 set idlist [eval lreplace \$idlist $col $col $newolds]
2475 set offs [lrange $offs 0 [expr {$col - 1}]]
2476 foreach x $newolds {
2481 set tmp [expr {[llength $idlist] - [llength $offs]}]
2483 set offs [concat $offs [ntimes $tmp $o]]
2488 foreach i $newolds {
2490 set idrowranges($i) $row
2493 foreach oid $oldolds {
2494 set idinlist($oid) 1
2495 set idlist [linsert $idlist $col $oid]
2496 set offs [linsert $offs $col $o]
2497 makeuparrow $oid $col $row $o
2500 lappend rowidlist $idlist
2501 lappend rowoffsets $offs
2506 proc addextraid {id row} {
2507 global displayorder commitrow commitinfo
2508 global commitidx commitlisted
2509 global parentlist childlist children curview
2511 incr commitidx($curview)
2512 lappend displayorder $id
2513 lappend commitlisted 0
2514 lappend parentlist {}
2515 set commitrow($curview,$id) $row
2517 if {![info exists commitinfo($id)]} {
2518 set commitinfo($id) {"No commit information available"}
2520 if {![info exists children($curview,$id)]} {
2521 set children($curview,$id) {}
2523 lappend childlist $children($curview,$id)
2526 proc layouttail {} {
2527 global rowidlist rowoffsets idinlist commitidx curview
2528 global idrowranges rowrangelist
2530 set row $commitidx($curview)
2531 set idlist [lindex $rowidlist $row]
2532 while {$idlist ne {}} {
2533 set col [expr {[llength $idlist] - 1}]
2534 set id [lindex $idlist $col]
2537 lappend idrowranges($id) $row
2538 lappend rowrangelist $idrowranges($id)
2539 unset idrowranges($id)
2541 set offs [ntimes $col 0]
2542 set idlist [lreplace $idlist $col $col]
2543 lappend rowidlist $idlist
2544 lappend rowoffsets $offs
2547 foreach id [array names idinlist] {
2549 lset rowidlist $row [list $id]
2550 lset rowoffsets $row 0
2551 makeuparrow $id 0 $row 0
2552 lappend idrowranges($id) $row
2553 lappend rowrangelist $idrowranges($id)
2554 unset idrowranges($id)
2556 lappend rowidlist {}
2557 lappend rowoffsets {}
2561 proc insert_pad {row col npad} {
2562 global rowidlist rowoffsets
2564 set pad [ntimes $npad {}]
2565 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2566 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2567 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2570 proc optimize_rows {row col endrow} {
2571 global rowidlist rowoffsets idrowranges displayorder
2573 for {} {$row < $endrow} {incr row} {
2574 set idlist [lindex $rowidlist $row]
2575 set offs [lindex $rowoffsets $row]
2577 for {} {$col < [llength $offs]} {incr col} {
2578 if {[lindex $idlist $col] eq {}} {
2582 set z [lindex $offs $col]
2583 if {$z eq {}} continue
2585 set x0 [expr {$col + $z}]
2586 set y0 [expr {$row - 1}]
2587 set z0 [lindex $rowoffsets $y0 $x0]
2589 set id [lindex $idlist $col]
2590 set ranges [rowranges $id]
2591 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2595 if {$z < -1 || ($z < 0 && $isarrow)} {
2596 set npad [expr {-1 - $z + $isarrow}]
2597 set offs [incrange $offs $col $npad]
2598 insert_pad $y0 $x0 $npad
2600 optimize_rows $y0 $x0 $row
2602 set z [lindex $offs $col]
2603 set x0 [expr {$col + $z}]
2604 set z0 [lindex $rowoffsets $y0 $x0]
2605 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2606 set npad [expr {$z - 1 + $isarrow}]
2607 set y1 [expr {$row + 1}]
2608 set offs2 [lindex $rowoffsets $y1]
2612 if {$z eq {} || $x1 + $z < $col} continue
2613 if {$x1 + $z > $col} {
2616 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2619 set pad [ntimes $npad {}]
2620 set idlist [eval linsert \$idlist $col $pad]
2621 set tmp [eval linsert \$offs $col $pad]
2623 set offs [incrange $tmp $col [expr {-$npad}]]
2624 set z [lindex $offs $col]
2627 if {$z0 eq {} && !$isarrow} {
2628 # this line links to its first child on row $row-2
2629 set rm2 [expr {$row - 2}]
2630 set id [lindex $displayorder $rm2]
2631 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2633 set z0 [expr {$xc - $x0}]
2636 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2637 insert_pad $y0 $x0 1
2638 set offs [incrange $offs $col 1]
2639 optimize_rows $y0 [expr {$x0 + 1}] $row
2644 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2645 set o [lindex $offs $col]
2647 # check if this is the link to the first child
2648 set id [lindex $idlist $col]
2649 set ranges [rowranges $id]
2650 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2651 # it is, work out offset to child
2652 set y0 [expr {$row - 1}]
2653 set id [lindex $displayorder $y0]
2654 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2656 set o [expr {$x0 - $col}]
2660 if {$o eq {} || $o <= 0} break
2662 if {$o ne {} && [incr col] < [llength $idlist]} {
2663 set y1 [expr {$row + 1}]
2664 set offs2 [lindex $rowoffsets $y1]
2668 if {$z eq {} || $x1 + $z < $col} continue
2669 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2672 set idlist [linsert $idlist $col {}]
2673 set tmp [linsert $offs $col {}]
2675 set offs [incrange $tmp $col -1]
2678 lset rowidlist $row $idlist
2679 lset rowoffsets $row $offs
2685 global canvx0 linespc
2686 return [expr {$canvx0 + $col * $linespc}]
2690 global canvy0 linespc
2691 return [expr {$canvy0 + $row * $linespc}]
2694 proc linewidth {id} {
2695 global thickerline lthickness
2698 if {[info exists thickerline] && $id eq $thickerline} {
2699 set wid [expr {2 * $lthickness}]
2704 proc rowranges {id} {
2705 global phase idrowranges commitrow rowlaidout rowrangelist curview
2709 ([info exists commitrow($curview,$id)]
2710 && $commitrow($curview,$id) < $rowlaidout)} {
2711 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2712 } elseif {[info exists idrowranges($id)]} {
2713 set ranges $idrowranges($id)
2718 proc drawlineseg {id i} {
2719 global rowoffsets rowidlist
2721 global canv colormap linespc
2722 global numcommits commitrow curview
2724 set ranges [rowranges $id]
2726 if {[info exists commitrow($curview,$id)]
2727 && $commitrow($curview,$id) < $numcommits} {
2728 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2732 set startrow [lindex $ranges [expr {2 * $i}]]
2733 set row [lindex $ranges [expr {2 * $i + 1}]]
2734 if {$startrow == $row} return
2737 set col [lsearch -exact [lindex $rowidlist $row] $id]
2739 puts "oops: drawline: id $id not on row $row"
2745 set o [lindex $rowoffsets $row $col]
2748 # changing direction
2749 set x [xc $row $col]
2751 lappend coords $x $y
2757 set x [xc $row $col]
2759 lappend coords $x $y
2761 # draw the link to the first child as part of this line
2763 set child [lindex $displayorder $row]
2764 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2766 set x [xc $row $ccol]
2768 if {$ccol < $col - 1} {
2769 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2770 } elseif {$ccol > $col + 1} {
2771 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2773 lappend coords $x $y
2776 if {[llength $coords] < 4} return
2778 # This line has an arrow at the lower end: check if the arrow is
2779 # on a diagonal segment, and if so, work around the Tk 8.4
2780 # refusal to draw arrows on diagonal lines.
2781 set x0 [lindex $coords 0]
2782 set x1 [lindex $coords 2]
2784 set y0 [lindex $coords 1]
2785 set y1 [lindex $coords 3]
2786 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2787 # we have a nearby vertical segment, just trim off the diag bit
2788 set coords [lrange $coords 2 end]
2790 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2791 set xi [expr {$x0 - $slope * $linespc / 2}]
2792 set yi [expr {$y0 - $linespc / 2}]
2793 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2797 set arrow [expr {2 * ($i > 0) + $downarrow}]
2798 set arrow [lindex {none first last both} $arrow]
2799 set t [$canv create line $coords -width [linewidth $id] \
2800 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2805 proc drawparentlinks {id row col olds} {
2806 global rowidlist canv colormap
2808 set row2 [expr {$row + 1}]
2809 set x [xc $row $col]
2812 set ids [lindex $rowidlist $row2]
2813 # rmx = right-most X coord used
2816 set i [lsearch -exact $ids $p]
2818 puts "oops, parent $p of $id not in list"
2821 set x2 [xc $row2 $i]
2825 set ranges [rowranges $p]
2826 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2827 && $row2 < [lindex $ranges 1]} {
2828 # drawlineseg will do this one for us
2832 # should handle duplicated parents here...
2833 set coords [list $x $y]
2834 if {$i < $col - 1} {
2835 lappend coords [xc $row [expr {$i + 1}]] $y
2836 } elseif {$i > $col + 1} {
2837 lappend coords [xc $row [expr {$i - 1}]] $y
2839 lappend coords $x2 $y2
2840 set t [$canv create line $coords -width [linewidth $p] \
2841 -fill $colormap($p) -tags lines.$p]
2848 proc drawlines {id} {
2849 global colormap canv
2851 global children iddrawn commitrow rowidlist curview
2853 $canv delete lines.$id
2854 set nr [expr {[llength [rowranges $id]] / 2}]
2855 for {set i 0} {$i < $nr} {incr i} {
2856 if {[info exists idrangedrawn($id,$i)]} {
2860 foreach child $children($curview,$id) {
2861 if {[info exists iddrawn($child)]} {
2862 set row $commitrow($curview,$child)
2863 set col [lsearch -exact [lindex $rowidlist $row] $child]
2865 drawparentlinks $child $row $col [list $id]
2871 proc drawcmittext {id row col rmx} {
2872 global linespc canv canv2 canv3 canvy0
2873 global commitlisted commitinfo rowidlist
2874 global rowtextx idpos idtags idheads idotherrefs
2875 global linehtag linentag linedtag
2876 global mainfont canvxmax boldrows boldnamerows
2878 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2879 set x [xc $row $col]
2881 set orad [expr {$linespc / 3}]
2882 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2883 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2884 -fill $ofill -outline black -width 1]
2886 $canv bind $t <1> {selcanvline {} %x %y}
2887 set xt [xc $row [llength [lindex $rowidlist $row]]]
2891 set rowtextx($row) $xt
2892 set idpos($id) [list $x $xt $y]
2893 if {[info exists idtags($id)] || [info exists idheads($id)]
2894 || [info exists idotherrefs($id)]} {
2895 set xt [drawtags $id $x $xt $y]
2897 set headline [lindex $commitinfo($id) 0]
2898 set name [lindex $commitinfo($id) 1]
2899 set date [lindex $commitinfo($id) 2]
2900 set date [formatdate $date]
2903 set isbold [ishighlighted $row]
2905 lappend boldrows $row
2908 lappend boldnamerows $row
2912 set linehtag($row) [$canv create text $xt $y -anchor w \
2913 -text $headline -font $font]
2914 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2915 set linentag($row) [$canv2 create text 3 $y -anchor w \
2916 -text $name -font $nfont]
2917 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2918 -text $date -font $mainfont]
2919 set xr [expr {$xt + [font measure $mainfont $headline]}]
2920 if {$xr > $canvxmax} {
2926 proc drawcmitrow {row} {
2927 global displayorder rowidlist
2928 global idrangedrawn iddrawn
2929 global commitinfo parentlist numcommits
2930 global filehighlight fhighlights findstring nhighlights
2931 global hlview vhighlights
2932 global highlight_related rhighlights
2934 if {$row >= $numcommits} return
2935 foreach id [lindex $rowidlist $row] {
2936 if {$id eq {}} continue
2938 foreach {s e} [rowranges $id] {
2940 if {$row < $s} continue
2943 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2945 set idrangedrawn($id,$i) 1
2952 set id [lindex $displayorder $row]
2953 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2954 askvhighlight $row $id
2956 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2957 askfilehighlight $row $id
2959 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2960 askfindhighlight $row $id
2962 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2963 askrelhighlight $row $id
2965 if {[info exists iddrawn($id)]} return
2966 set col [lsearch -exact [lindex $rowidlist $row] $id]
2968 puts "oops, row $row id $id not in list"
2971 if {![info exists commitinfo($id)]} {
2975 set olds [lindex $parentlist $row]
2977 set rmx [drawparentlinks $id $row $col $olds]
2981 drawcmittext $id $row $col $rmx
2985 proc drawfrac {f0 f1} {
2986 global numcommits canv
2989 set ymax [lindex [$canv cget -scrollregion] 3]
2990 if {$ymax eq {} || $ymax == 0} return
2991 set y0 [expr {int($f0 * $ymax)}]
2992 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2996 set y1 [expr {int($f1 * $ymax)}]
2997 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2998 if {$endrow >= $numcommits} {
2999 set endrow [expr {$numcommits - 1}]
3001 for {} {$row <= $endrow} {incr row} {
3006 proc drawvisible {} {
3008 eval drawfrac [$canv yview]
3011 proc clear_display {} {
3012 global iddrawn idrangedrawn
3013 global vhighlights fhighlights nhighlights rhighlights
3016 catch {unset iddrawn}
3017 catch {unset idrangedrawn}
3018 catch {unset vhighlights}
3019 catch {unset fhighlights}
3020 catch {unset nhighlights}
3021 catch {unset rhighlights}
3024 proc findcrossings {id} {
3025 global rowidlist parentlist numcommits rowoffsets displayorder
3029 foreach {s e} [rowranges $id] {
3030 if {$e >= $numcommits} {
3031 set e [expr {$numcommits - 1}]
3033 if {$e <= $s} continue
3034 set x [lsearch -exact [lindex $rowidlist $e] $id]
3036 puts "findcrossings: oops, no [shortids $id] in row $e"
3039 for {set row $e} {[incr row -1] >= $s} {} {
3040 set olds [lindex $parentlist $row]
3041 set kid [lindex $displayorder $row]
3042 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3043 if {$kidx < 0} continue
3044 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3046 set px [lsearch -exact $nextrow $p]
3047 if {$px < 0} continue
3048 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3049 if {[lsearch -exact $ccross $p] >= 0} continue
3050 if {$x == $px + ($kidx < $px? -1: 1)} {
3052 } elseif {[lsearch -exact $cross $p] < 0} {
3057 set inc [lindex $rowoffsets $row $x]
3058 if {$inc eq {}} break
3062 return [concat $ccross {{}} $cross]
3065 proc assigncolor {id} {
3066 global colormap colors nextcolor
3067 global commitrow parentlist children children curview
3069 if {[info exists colormap($id)]} return
3070 set ncolors [llength $colors]
3071 if {[info exists children($curview,$id)]} {
3072 set kids $children($curview,$id)
3076 if {[llength $kids] == 1} {
3077 set child [lindex $kids 0]
3078 if {[info exists colormap($child)]
3079 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3080 set colormap($id) $colormap($child)
3086 foreach x [findcrossings $id] {
3088 # delimiter between corner crossings and other crossings
3089 if {[llength $badcolors] >= $ncolors - 1} break
3090 set origbad $badcolors
3092 if {[info exists colormap($x)]
3093 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3094 lappend badcolors $colormap($x)
3097 if {[llength $badcolors] >= $ncolors} {
3098 set badcolors $origbad
3100 set origbad $badcolors
3101 if {[llength $badcolors] < $ncolors - 1} {
3102 foreach child $kids {
3103 if {[info exists colormap($child)]
3104 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3105 lappend badcolors $colormap($child)
3107 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3108 if {[info exists colormap($p)]
3109 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3110 lappend badcolors $colormap($p)
3114 if {[llength $badcolors] >= $ncolors} {
3115 set badcolors $origbad
3118 for {set i 0} {$i <= $ncolors} {incr i} {
3119 set c [lindex $colors $nextcolor]
3120 if {[incr nextcolor] >= $ncolors} {
3123 if {[lsearch -exact $badcolors $c]} break
3125 set colormap($id) $c
3128 proc bindline {t id} {
3131 $canv bind $t <Enter> "lineenter %x %y $id"
3132 $canv bind $t <Motion> "linemotion %x %y $id"
3133 $canv bind $t <Leave> "lineleave $id"
3134 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3137 proc drawtags {id x xt y1} {
3138 global idtags idheads idotherrefs
3139 global linespc lthickness
3140 global canv mainfont commitrow rowtextx curview
3145 if {[info exists idtags($id)]} {
3146 set marks $idtags($id)
3147 set ntags [llength $marks]
3149 if {[info exists idheads($id)]} {
3150 set marks [concat $marks $idheads($id)]
3151 set nheads [llength $idheads($id)]
3153 if {[info exists idotherrefs($id)]} {
3154 set marks [concat $marks $idotherrefs($id)]
3160 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3161 set yt [expr {$y1 - 0.5 * $linespc}]
3162 set yb [expr {$yt + $linespc - 1}]
3165 foreach tag $marks {
3166 set wid [font measure $mainfont $tag]
3169 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3171 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3172 -width $lthickness -fill black -tags tag.$id]
3174 foreach tag $marks x $xvals wid $wvals {
3175 set xl [expr {$x + $delta}]
3176 set xr [expr {$x + $delta + $wid + $lthickness}]
3177 if {[incr ntags -1] >= 0} {
3179 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3180 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3181 -width 1 -outline black -fill yellow -tags tag.$id]
3182 $canv bind $t <1> [list showtag $tag 1]
3183 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3185 # draw a head or other ref
3186 if {[incr nheads -1] >= 0} {
3191 set xl [expr {$xl - $delta/2}]
3192 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3193 -width 1 -outline black -fill $col -tags tag.$id
3194 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3195 set rwid [font measure $mainfont $remoteprefix]
3196 set xi [expr {$x + 1}]
3197 set yti [expr {$yt + 1}]
3198 set xri [expr {$x + $rwid}]
3199 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3200 -width 0 -fill "#ffddaa" -tags tag.$id
3203 set t [$canv create text $xl $y1 -anchor w -text $tag \
3204 -font $mainfont -tags tag.$id]
3206 $canv bind $t <1> [list showtag $tag 1]
3212 proc xcoord {i level ln} {
3213 global canvx0 xspc1 xspc2
3215 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3216 if {$i > 0 && $i == $level} {
3217 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3218 } elseif {$i > $level} {
3219 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3224 proc show_status {msg} {
3225 global canv mainfont
3228 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3231 proc finishcommits {} {
3232 global commitidx phase curview
3233 global canv mainfont ctext maincursor textcursor
3234 global findinprogress pending_select
3236 if {$commitidx($curview) > 0} {
3239 show_status "No commits selected"
3242 catch {unset pending_select}
3245 # Don't change the text pane cursor if it is currently the hand cursor,
3246 # showing that we are over a sha1 ID link.
3247 proc settextcursor {c} {
3248 global ctext curtextcursor
3250 if {[$ctext cget -cursor] == $curtextcursor} {
3251 $ctext config -cursor $c
3253 set curtextcursor $c
3256 proc nowbusy {what} {
3259 if {[array names isbusy] eq {}} {
3260 . config -cursor watch
3266 proc notbusy {what} {
3267 global isbusy maincursor textcursor
3269 catch {unset isbusy($what)}
3270 if {[array names isbusy] eq {}} {
3271 . config -cursor $maincursor
3272 settextcursor $textcursor
3279 global canvy0 numcommits linespc
3280 global rowlaidout commitidx curview
3281 global pending_select
3284 layoutrows $rowlaidout $commitidx($curview) 1
3286 optimize_rows $row 0 $commitidx($curview)
3287 showstuff $commitidx($curview)
3288 if {[info exists pending_select]} {
3292 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3293 #puts "overall $drawmsecs ms for $numcommits commits"
3296 proc findmatches {f} {
3297 global findtype foundstring foundstrlen
3298 if {$findtype == "Regexp"} {
3299 set matches [regexp -indices -all -inline $foundstring $f]
3301 if {$findtype == "IgnCase"} {
3302 set str [string tolower $f]
3308 while {[set j [string first $foundstring $str $i]] >= 0} {
3309 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3310 set i [expr {$j + $foundstrlen}]
3317 global findtype findloc findstring markedmatches commitinfo
3318 global numcommits displayorder linehtag linentag linedtag
3319 global mainfont canv canv2 canv3 selectedline
3320 global matchinglines foundstring foundstrlen matchstring
3325 cancel_next_highlight
3327 set matchinglines {}
3328 if {$findtype == "IgnCase"} {
3329 set foundstring [string tolower $findstring]
3331 set foundstring $findstring
3333 set foundstrlen [string length $findstring]
3334 if {$foundstrlen == 0} return
3335 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3336 set matchstring "*$matchstring*"
3337 if {![info exists selectedline]} {
3340 set oldsel $selectedline
3343 set fldtypes {Headline Author Date Committer CDate Comments}
3345 foreach id $displayorder {
3346 set d $commitdata($id)
3348 if {$findtype == "Regexp"} {
3349 set doesmatch [regexp $foundstring $d]
3350 } elseif {$findtype == "IgnCase"} {
3351 set doesmatch [string match -nocase $matchstring $d]
3353 set doesmatch [string match $matchstring $d]
3355 if {!$doesmatch} continue
3356 if {![info exists commitinfo($id)]} {
3359 set info $commitinfo($id)
3361 foreach f $info ty $fldtypes {
3362 if {$findloc != "All fields" && $findloc != $ty} {
3365 set matches [findmatches $f]
3366 if {$matches == {}} continue
3368 if {$ty == "Headline"} {
3370 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3371 } elseif {$ty == "Author"} {
3373 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3374 } elseif {$ty == "Date"} {
3376 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3380 lappend matchinglines $l
3381 if {!$didsel && $l > $oldsel} {
3387 if {$matchinglines == {}} {
3389 } elseif {!$didsel} {
3390 findselectline [lindex $matchinglines 0]
3394 proc findselectline {l} {
3395 global findloc commentend ctext
3397 if {$findloc == "All fields" || $findloc == "Comments"} {
3398 # highlight the matches in the comments
3399 set f [$ctext get 1.0 $commentend]
3400 set matches [findmatches $f]
3401 foreach match $matches {
3402 set start [lindex $match 0]
3403 set end [expr {[lindex $match 1] + 1}]
3404 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3409 proc findnext {restart} {
3410 global matchinglines selectedline
3411 if {![info exists matchinglines]} {
3417 if {![info exists selectedline]} return
3418 foreach l $matchinglines {
3419 if {$l > $selectedline} {
3428 global matchinglines selectedline
3429 if {![info exists matchinglines]} {
3433 if {![info exists selectedline]} return
3435 foreach l $matchinglines {
3436 if {$l >= $selectedline} break
3440 findselectline $prev
3446 proc stopfindproc {{done 0}} {
3447 global findprocpid findprocfile findids
3448 global ctext findoldcursor phase maincursor textcursor
3449 global findinprogress
3451 catch {unset findids}
3452 if {[info exists findprocpid]} {
3454 catch {exec kill $findprocpid}
3456 catch {close $findprocfile}
3459 catch {unset findinprogress}
3463 # mark a commit as matching by putting a yellow background
3464 # behind the headline
3465 proc markheadline {l id} {
3466 global canv mainfont linehtag
3469 set bbox [$canv bbox $linehtag($l)]
3470 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3474 # mark the bits of a headline, author or date that match a find string
3475 proc markmatches {canv l str tag matches font} {
3476 set bbox [$canv bbox $tag]
3477 set x0 [lindex $bbox 0]
3478 set y0 [lindex $bbox 1]
3479 set y1 [lindex $bbox 3]
3480 foreach match $matches {
3481 set start [lindex $match 0]
3482 set end [lindex $match 1]
3483 if {$start > $end} continue
3484 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3485 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3486 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3487 [expr {$x0+$xlen+2}] $y1 \
3488 -outline {} -tags matches -fill yellow]
3493 proc unmarkmatches {} {
3494 global matchinglines findids
3495 allcanvs delete matches
3496 catch {unset matchinglines}
3497 catch {unset findids}
3500 proc selcanvline {w x y} {
3501 global canv canvy0 ctext linespc
3503 set ymax [lindex [$canv cget -scrollregion] 3]
3504 if {$ymax == {}} return
3505 set yfrac [lindex [$canv yview] 0]
3506 set y [expr {$y + $yfrac * $ymax}]
3507 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3512 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3518 proc commit_descriptor {p} {
3520 if {![info exists commitinfo($p)]} {
3524 if {[llength $commitinfo($p)] > 1} {
3525 set l [lindex $commitinfo($p) 0]
3530 # append some text to the ctext widget, and make any SHA1 ID
3531 # that we know about be a clickable link.
3532 proc appendwithlinks {text tags} {
3533 global ctext commitrow linknum curview
3535 set start [$ctext index "end - 1c"]
3536 $ctext insert end $text $tags
3537 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3541 set linkid [string range $text $s $e]
3542 if {![info exists commitrow($curview,$linkid)]} continue
3544 $ctext tag add link "$start + $s c" "$start + $e c"
3545 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3546 $ctext tag bind link$linknum <1> \
3547 [list selectline $commitrow($curview,$linkid) 1]
3550 $ctext tag conf link -foreground blue -underline 1
3551 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3552 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3555 proc viewnextline {dir} {
3559 set ymax [lindex [$canv cget -scrollregion] 3]
3560 set wnow [$canv yview]
3561 set wtop [expr {[lindex $wnow 0] * $ymax}]
3562 set newtop [expr {$wtop + $dir * $linespc}]
3565 } elseif {$newtop > $ymax} {
3568 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3571 # add a list of tag or branch names at position pos
3572 # returns the number of names inserted
3573 proc appendrefs {pos l var} {
3574 global ctext commitrow linknum curview idtags $var
3576 if {[catch {$ctext index $pos}]} {
3581 foreach tag [set $var\($id\)] {
3582 lappend tags [concat $tag $id]
3585 set tags [lsort -index 1 $tags]
3588 set name [lindex $tag 0]
3589 set id [lindex $tag 1]
3592 $ctext insert $pos $sep
3593 $ctext insert $pos $name $lk
3594 $ctext tag conf $lk -foreground blue
3595 if {[info exists commitrow($curview,$id)]} {
3596 $ctext tag bind $lk <1> \
3597 [list selectline $commitrow($curview,$id) 1]
3598 $ctext tag conf $lk -underline 1
3599 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3600 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3604 return [llength $tags]
3607 # called when we have finished computing the nearby tags
3608 proc dispneartags {} {
3609 global selectedline currentid ctext anc_tags desc_tags showneartags
3612 if {![info exists selectedline] || !$showneartags} return
3614 $ctext conf -state normal
3615 if {[info exists desc_heads($id)]} {
3616 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3617 $ctext insert "branch -2c" "es"
3620 if {[info exists anc_tags($id)]} {
3621 appendrefs follows $anc_tags($id) idtags
3623 if {[info exists desc_tags($id)]} {
3624 appendrefs precedes $desc_tags($id) idtags
3626 $ctext conf -state disabled
3629 proc selectline {l isnew} {
3630 global canv canv2 canv3 ctext commitinfo selectedline
3631 global displayorder linehtag linentag linedtag
3632 global canvy0 linespc parentlist childlist
3633 global currentid sha1entry
3634 global commentend idtags linknum
3635 global mergemax numcommits pending_select
3636 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3638 catch {unset pending_select}
3641 cancel_next_highlight
3642 if {$l < 0 || $l >= $numcommits} return
3643 set y [expr {$canvy0 + $l * $linespc}]
3644 set ymax [lindex [$canv cget -scrollregion] 3]
3645 set ytop [expr {$y - $linespc - 1}]
3646 set ybot [expr {$y + $linespc + 1}]
3647 set wnow [$canv yview]
3648 set wtop [expr {[lindex $wnow 0] * $ymax}]
3649 set wbot [expr {[lindex $wnow 1] * $ymax}]
3650 set wh [expr {$wbot - $wtop}]
3652 if {$ytop < $wtop} {
3653 if {$ybot < $wtop} {
3654 set newtop [expr {$y - $wh / 2.0}]
3657 if {$newtop > $wtop - $linespc} {
3658 set newtop [expr {$wtop - $linespc}]
3661 } elseif {$ybot > $wbot} {
3662 if {$ytop > $wbot} {
3663 set newtop [expr {$y - $wh / 2.0}]
3665 set newtop [expr {$ybot - $wh}]
3666 if {$newtop < $wtop + $linespc} {
3667 set newtop [expr {$wtop + $linespc}]
3671 if {$newtop != $wtop} {
3675 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3679 if {![info exists linehtag($l)]} return
3681 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3682 -tags secsel -fill [$canv cget -selectbackground]]
3684 $canv2 delete secsel
3685 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3686 -tags secsel -fill [$canv2 cget -selectbackground]]
3688 $canv3 delete secsel
3689 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3690 -tags secsel -fill [$canv3 cget -selectbackground]]
3694 addtohistory [list selectline $l 0]
3699 set id [lindex $displayorder $l]
3701 $sha1entry delete 0 end
3702 $sha1entry insert 0 $id
3703 $sha1entry selection from 0
3704 $sha1entry selection to end
3707 $ctext conf -state normal
3710 set info $commitinfo($id)
3711 set date [formatdate [lindex $info 2]]
3712 $ctext insert end "Author: [lindex $info 1] $date\n"
3713 set date [formatdate [lindex $info 4]]
3714 $ctext insert end "Committer: [lindex $info 3] $date\n"
3715 if {[info exists idtags($id)]} {
3716 $ctext insert end "Tags:"
3717 foreach tag $idtags($id) {
3718 $ctext insert end " $tag"
3720 $ctext insert end "\n"
3724 set olds [lindex $parentlist $l]
3725 if {[llength $olds] > 1} {
3728 if {$np >= $mergemax} {
3733 $ctext insert end "Parent: " $tag
3734 appendwithlinks [commit_descriptor $p] {}
3739 append headers "Parent: [commit_descriptor $p]"
3743 foreach c [lindex $childlist $l] {
3744 append headers "Child: [commit_descriptor $c]"
3747 # make anything that looks like a SHA1 ID be a clickable link
3748 appendwithlinks $headers {}
3749 if {$showneartags} {
3750 if {![info exists allcommits]} {
3753 $ctext insert end "Branch: "
3754 $ctext mark set branch "end -1c"
3755 $ctext mark gravity branch left
3756 if {[info exists desc_heads($id)]} {
3757 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3758 # turn "Branch" into "Branches"
3759 $ctext insert "branch -2c" "es"
3762 $ctext insert end "\nFollows: "
3763 $ctext mark set follows "end -1c"
3764 $ctext mark gravity follows left
3765 if {[info exists anc_tags($id)]} {
3766 appendrefs follows $anc_tags($id) idtags
3768 $ctext insert end "\nPrecedes: "
3769 $ctext mark set precedes "end -1c"
3770 $ctext mark gravity precedes left
3771 if {[info exists desc_tags($id)]} {
3772 appendrefs precedes $desc_tags($id) idtags
3774 $ctext insert end "\n"
3776 $ctext insert end "\n"
3777 appendwithlinks [lindex $info 5] {comment}
3779 $ctext tag delete Comments
3780 $ctext tag remove found 1.0 end
3781 $ctext conf -state disabled
3782 set commentend [$ctext index "end - 1c"]
3784 init_flist "Comments"
3785 if {$cmitmode eq "tree"} {
3787 } elseif {[llength $olds] <= 1} {
3794 proc selfirstline {} {
3799 proc sellastline {} {
3802 set l [expr {$numcommits - 1}]
3806 proc selnextline {dir} {
3808 if {![info exists selectedline]} return
3809 set l [expr {$selectedline + $dir}]
3814 proc selnextpage {dir} {
3815 global canv linespc selectedline numcommits
3817 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3821 allcanvs yview scroll [expr {$dir * $lpp}] units
3823 if {![info exists selectedline]} return
3824 set l [expr {$selectedline + $dir * $lpp}]
3827 } elseif {$l >= $numcommits} {
3828 set l [expr $numcommits - 1]
3834 proc unselectline {} {
3835 global selectedline currentid
3837 catch {unset selectedline}
3838 catch {unset currentid}
3839 allcanvs delete secsel
3841 cancel_next_highlight
3844 proc reselectline {} {
3847 if {[info exists selectedline]} {
3848 selectline $selectedline 0
3852 proc addtohistory {cmd} {
3853 global history historyindex curview
3855 set elt [list $curview $cmd]
3856 if {$historyindex > 0
3857 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3861 if {$historyindex < [llength $history]} {
3862 set history [lreplace $history $historyindex end $elt]
3864 lappend history $elt
3867 if {$historyindex > 1} {
3868 .ctop.top.bar.leftbut conf -state normal
3870 .ctop.top.bar.leftbut conf -state disabled
3872 .ctop.top.bar.rightbut conf -state disabled
3878 set view [lindex $elt 0]
3879 set cmd [lindex $elt 1]
3880 if {$curview != $view} {
3887 global history historyindex
3889 if {$historyindex > 1} {
3890 incr historyindex -1
3891 godo [lindex $history [expr {$historyindex - 1}]]
3892 .ctop.top.bar.rightbut conf -state normal
3894 if {$historyindex <= 1} {
3895 .ctop.top.bar.leftbut conf -state disabled
3900 global history historyindex
3902 if {$historyindex < [llength $history]} {
3903 set cmd [lindex $history $historyindex]
3906 .ctop.top.bar.leftbut conf -state normal
3908 if {$historyindex >= [llength $history]} {
3909 .ctop.top.bar.rightbut conf -state disabled
3914 global treefilelist treeidlist diffids diffmergeid treepending
3917 catch {unset diffmergeid}
3918 if {![info exists treefilelist($id)]} {
3919 if {![info exists treepending]} {
3920 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3924 set treefilelist($id) {}
3925 set treeidlist($id) {}
3926 fconfigure $gtf -blocking 0
3927 fileevent $gtf readable [list gettreeline $gtf $id]
3934 proc gettreeline {gtf id} {
3935 global treefilelist treeidlist treepending cmitmode diffids
3937 while {[gets $gtf line] >= 0} {
3938 if {[lindex $line 1] ne "blob"} continue
3939 set sha1 [lindex $line 2]
3940 set fname [lindex $line 3]
3941 lappend treefilelist($id) $fname
3942 lappend treeidlist($id) $sha1
3944 if {![eof $gtf]} return
3947 if {$cmitmode ne "tree"} {
3948 if {![info exists diffmergeid]} {
3949 gettreediffs $diffids
3951 } elseif {$id ne $diffids} {
3959 global treefilelist treeidlist diffids
3960 global ctext commentend
3962 set i [lsearch -exact $treefilelist($diffids) $f]
3964 puts "oops, $f not in list for id $diffids"
3967 set blob [lindex $treeidlist($diffids) $i]
3968 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3969 puts "oops, error reading blob $blob: $err"
3972 fconfigure $bf -blocking 0
3973 fileevent $bf readable [list getblobline $bf $diffids]
3974 $ctext config -state normal
3975 clear_ctext $commentend
3976 $ctext insert end "\n"
3977 $ctext insert end "$f\n" filesep
3978 $ctext config -state disabled
3979 $ctext yview $commentend
3982 proc getblobline {bf id} {
3983 global diffids cmitmode ctext
3985 if {$id ne $diffids || $cmitmode ne "tree"} {
3989 $ctext config -state normal
3990 while {[gets $bf line] >= 0} {
3991 $ctext insert end "$line\n"
3994 # delete last newline
3995 $ctext delete "end - 2c" "end - 1c"
3998 $ctext config -state disabled
4001 proc mergediff {id l} {
4002 global diffmergeid diffopts mdifffd
4008 # this doesn't seem to actually affect anything...
4009 set env(GIT_DIFF_OPTS) $diffopts
4010 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4011 if {[catch {set mdf [open $cmd r]} err]} {
4012 error_popup "Error getting merge diffs: $err"
4015 fconfigure $mdf -blocking 0
4016 set mdifffd($id) $mdf
4017 set np [llength [lindex $parentlist $l]]
4018 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4019 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4022 proc getmergediffline {mdf id np} {
4023 global diffmergeid ctext cflist nextupdate mergemax
4024 global difffilestart mdifffd
4026 set n [gets $mdf line]
4033 if {![info exists diffmergeid] || $id != $diffmergeid
4034 || $mdf != $mdifffd($id)} {
4037 $ctext conf -state normal
4038 if {[regexp {^diff --cc (.*)} $line match fname]} {
4039 # start of a new file
4040 $ctext insert end "\n"
4041 set here [$ctext index "end - 1c"]
4042 lappend difffilestart $here
4043 add_flist [list $fname]
4044 set l [expr {(78 - [string length $fname]) / 2}]
4045 set pad [string range "----------------------------------------" 1 $l]
4046 $ctext insert end "$pad $fname $pad\n" filesep
4047 } elseif {[regexp {^@@} $line]} {
4048 $ctext insert end "$line\n" hunksep
4049 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4052 # parse the prefix - one ' ', '-' or '+' for each parent
4057 for {set j 0} {$j < $np} {incr j} {
4058 set c [string range $line $j $j]
4061 } elseif {$c == "-"} {
4063 } elseif {$c == "+"} {
4072 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4073 # line doesn't appear in result, parents in $minuses have the line
4074 set num [lindex $minuses 0]
4075 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4076 # line appears in result, parents in $pluses don't have the line
4077 lappend tags mresult
4078 set num [lindex $spaces 0]
4081 if {$num >= $mergemax} {
4086 $ctext insert end "$line\n" $tags
4088 $ctext conf -state disabled
4089 if {[clock clicks -milliseconds] >= $nextupdate} {
4091 fileevent $mdf readable {}
4093 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4097 proc startdiff {ids} {
4098 global treediffs diffids treepending diffmergeid
4101 catch {unset diffmergeid}
4102 if {![info exists treediffs($ids)]} {
4103 if {![info exists treepending]} {
4111 proc addtocflist {ids} {
4112 global treediffs cflist
4113 add_flist $treediffs($ids)
4117 proc gettreediffs {ids} {
4118 global treediff treepending
4119 set treepending $ids
4122 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4124 fconfigure $gdtf -blocking 0
4125 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4128 proc gettreediffline {gdtf ids} {
4129 global treediff treediffs treepending diffids diffmergeid
4132 set n [gets $gdtf line]
4134 if {![eof $gdtf]} return
4136 set treediffs($ids) $treediff
4138 if {$cmitmode eq "tree"} {
4140 } elseif {$ids != $diffids} {
4141 if {![info exists diffmergeid]} {
4142 gettreediffs $diffids
4149 set file [lindex $line 5]
4150 lappend treediff $file
4153 proc getblobdiffs {ids} {
4154 global diffopts blobdifffd diffids env curdifftag curtagstart
4155 global nextupdate diffinhdr treediffs
4157 set env(GIT_DIFF_OPTS) $diffopts
4158 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4159 if {[catch {set bdf [open $cmd r]} err]} {
4160 puts "error getting diffs: $err"
4164 fconfigure $bdf -blocking 0
4165 set blobdifffd($ids) $bdf
4166 set curdifftag Comments
4168 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4169 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4172 proc setinlist {var i val} {
4175 while {[llength [set $var]] < $i} {
4178 if {[llength [set $var]] == $i} {
4185 proc getblobdiffline {bdf ids} {
4186 global diffids blobdifffd ctext curdifftag curtagstart
4187 global diffnexthead diffnextnote difffilestart
4188 global nextupdate diffinhdr treediffs
4190 set n [gets $bdf line]
4194 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4195 $ctext tag add $curdifftag $curtagstart end
4200 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4203 $ctext conf -state normal
4204 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4205 # start of a new file
4206 $ctext insert end "\n"
4207 $ctext tag add $curdifftag $curtagstart end
4208 set here [$ctext index "end - 1c"]
4209 set curtagstart $here
4211 set i [lsearch -exact $treediffs($ids) $fname]
4213 setinlist difffilestart $i $here
4215 if {$newname ne $fname} {
4216 set i [lsearch -exact $treediffs($ids) $newname]
4218 setinlist difffilestart $i $here
4221 set curdifftag "f:$fname"
4222 $ctext tag delete $curdifftag
4223 set l [expr {(78 - [string length $header]) / 2}]
4224 set pad [string range "----------------------------------------" 1 $l]
4225 $ctext insert end "$pad $header $pad\n" filesep
4227 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4229 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4231 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4232 $line match f1l f1c f2l f2c rest]} {
4233 $ctext insert end "$line\n" hunksep
4236 set x [string range $line 0 0]
4237 if {$x == "-" || $x == "+"} {
4238 set tag [expr {$x == "+"}]
4239 $ctext insert end "$line\n" d$tag
4240 } elseif {$x == " "} {
4241 $ctext insert end "$line\n"
4242 } elseif {$diffinhdr || $x == "\\"} {
4243 # e.g. "\ No newline at end of file"
4244 $ctext insert end "$line\n" filesep
4246 # Something else we don't recognize
4247 if {$curdifftag != "Comments"} {
4248 $ctext insert end "\n"
4249 $ctext tag add $curdifftag $curtagstart end
4250 set curtagstart [$ctext index "end - 1c"]
4251 set curdifftag Comments
4253 $ctext insert end "$line\n" filesep
4256 $ctext conf -state disabled
4257 if {[clock clicks -milliseconds] >= $nextupdate} {
4259 fileevent $bdf readable {}
4261 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4266 global difffilestart ctext
4267 set here [$ctext index @0,0]
4268 foreach loc $difffilestart {
4269 if {[$ctext compare $loc > $here]} {
4275 proc clear_ctext {{first 1.0}} {
4276 global ctext smarktop smarkbot
4278 set l [lindex [split $first .] 0]
4279 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4282 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4285 $ctext delete $first end
4288 proc incrsearch {name ix op} {
4289 global ctext searchstring searchdirn
4291 $ctext tag remove found 1.0 end
4292 if {[catch {$ctext index anchor}]} {
4293 # no anchor set, use start of selection, or of visible area
4294 set sel [$ctext tag ranges sel]
4296 $ctext mark set anchor [lindex $sel 0]
4297 } elseif {$searchdirn eq "-forwards"} {
4298 $ctext mark set anchor @0,0
4300 $ctext mark set anchor @0,[winfo height $ctext]
4303 if {$searchstring ne {}} {
4304 set here [$ctext search $searchdirn -- $searchstring anchor]
4313 global sstring ctext searchstring searchdirn
4316 $sstring icursor end
4317 set searchdirn -forwards
4318 if {$searchstring ne {}} {
4319 set sel [$ctext tag ranges sel]
4321 set start "[lindex $sel 0] + 1c"
4322 } elseif {[catch {set start [$ctext index anchor]}]} {
4325 set match [$ctext search -count mlen -- $searchstring $start]
4326 $ctext tag remove sel 1.0 end
4332 set mend "$match + $mlen c"
4333 $ctext tag add sel $match $mend
4334 $ctext mark unset anchor
4338 proc dosearchback {} {
4339 global sstring ctext searchstring searchdirn
4342 $sstring icursor end
4343 set searchdirn -backwards
4344 if {$searchstring ne {}} {
4345 set sel [$ctext tag ranges sel]
4347 set start [lindex $sel 0]
4348 } elseif {[catch {set start [$ctext index anchor]}]} {
4349 set start @0,[winfo height $ctext]
4351 set match [$ctext search -backwards -count ml -- $searchstring $start]
4352 $ctext tag remove sel 1.0 end
4358 set mend "$match + $ml c"
4359 $ctext tag add sel $match $mend
4360 $ctext mark unset anchor
4364 proc searchmark {first last} {
4365 global ctext searchstring
4369 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4370 if {$match eq {}} break
4371 set mend "$match + $mlen c"
4372 $ctext tag add found $match $mend
4376 proc searchmarkvisible {doall} {
4377 global ctext smarktop smarkbot
4379 set topline [lindex [split [$ctext index @0,0] .] 0]
4380 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4381 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4382 # no overlap with previous
4383 searchmark $topline $botline
4384 set smarktop $topline
4385 set smarkbot $botline
4387 if {$topline < $smarktop} {
4388 searchmark $topline [expr {$smarktop-1}]
4389 set smarktop $topline
4391 if {$botline > $smarkbot} {
4392 searchmark [expr {$smarkbot+1}] $botline
4393 set smarkbot $botline
4398 proc scrolltext {f0 f1} {
4401 .ctop.cdet.left.sb set $f0 $f1
4402 if {$searchstring ne {}} {
4408 global linespc charspc canvx0 canvy0 mainfont
4409 global xspc1 xspc2 lthickness
4411 set linespc [font metrics $mainfont -linespace]
4412 set charspc [font measure $mainfont "m"]
4413 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4414 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4415 set lthickness [expr {int($linespc / 9) + 1}]
4416 set xspc1(0) $linespc
4424 set ymax [lindex [$canv cget -scrollregion] 3]
4425 if {$ymax eq {} || $ymax == 0} return
4426 set span [$canv yview]
4429 allcanvs yview moveto [lindex $span 0]
4431 if {[info exists selectedline]} {
4432 selectline $selectedline 0
4436 proc incrfont {inc} {
4437 global mainfont textfont ctext canv phase
4438 global stopped entries
4440 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4441 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4443 $ctext conf -font $textfont
4444 $ctext tag conf filesep -font [concat $textfont bold]
4445 foreach e $entries {
4446 $e conf -font $mainfont
4448 if {$phase eq "getcommits"} {
4449 $canv itemconf textitems -font $mainfont
4455 global sha1entry sha1string
4456 if {[string length $sha1string] == 40} {
4457 $sha1entry delete 0 end
4461 proc sha1change {n1 n2 op} {
4462 global sha1string currentid sha1but
4463 if {$sha1string == {}
4464 || ([info exists currentid] && $sha1string == $currentid)} {
4469 if {[$sha1but cget -state] == $state} return
4470 if {$state == "normal"} {
4471 $sha1but conf -state normal -relief raised -text "Goto: "
4473 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4477 proc gotocommit {} {
4478 global sha1string currentid commitrow tagids headids
4479 global displayorder numcommits curview
4481 if {$sha1string == {}
4482 || ([info exists currentid] && $sha1string == $currentid)} return
4483 if {[info exists tagids($sha1string)]} {
4484 set id $tagids($sha1string)
4485 } elseif {[info exists headids($sha1string)]} {
4486 set id $headids($sha1string)
4488 set id [string tolower $sha1string]
4489 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4491 foreach i $displayorder {
4492 if {[string match $id* $i]} {
4496 if {$matches ne {}} {
4497 if {[llength $matches] > 1} {
4498 error_popup "Short SHA1 id $id is ambiguous"
4501 set id [lindex $matches 0]
4505 if {[info exists commitrow($curview,$id)]} {
4506 selectline $commitrow($curview,$id) 1
4509 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4514 error_popup "$type $sha1string is not known"
4517 proc lineenter {x y id} {
4518 global hoverx hovery hoverid hovertimer
4519 global commitinfo canv
4521 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4525 if {[info exists hovertimer]} {
4526 after cancel $hovertimer
4528 set hovertimer [after 500 linehover]
4532 proc linemotion {x y id} {
4533 global hoverx hovery hoverid hovertimer
4535 if {[info exists hoverid] && $id == $hoverid} {
4538 if {[info exists hovertimer]} {
4539 after cancel $hovertimer
4541 set hovertimer [after 500 linehover]
4545 proc lineleave {id} {
4546 global hoverid hovertimer canv
4548 if {[info exists hoverid] && $id == $hoverid} {
4550 if {[info exists hovertimer]} {
4551 after cancel $hovertimer
4559 global hoverx hovery hoverid hovertimer
4560 global canv linespc lthickness
4561 global commitinfo mainfont
4563 set text [lindex $commitinfo($hoverid) 0]
4564 set ymax [lindex [$canv cget -scrollregion] 3]
4565 if {$ymax == {}} return
4566 set yfrac [lindex [$canv yview] 0]
4567 set x [expr {$hoverx + 2 * $linespc}]
4568 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4569 set x0 [expr {$x - 2 * $lthickness}]
4570 set y0 [expr {$y - 2 * $lthickness}]
4571 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4572 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4573 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4574 -fill \#ffff80 -outline black -width 1 -tags hover]
4576 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4580 proc clickisonarrow {id y} {
4583 set ranges [rowranges $id]
4584 set thresh [expr {2 * $lthickness + 6}]
4585 set n [expr {[llength $ranges] - 1}]
4586 for {set i 1} {$i < $n} {incr i} {
4587 set row [lindex $ranges $i]
4588 if {abs([yc $row] - $y) < $thresh} {
4595 proc arrowjump {id n y} {
4598 # 1 <-> 2, 3 <-> 4, etc...
4599 set n [expr {(($n - 1) ^ 1) + 1}]
4600 set row [lindex [rowranges $id] $n]
4602 set ymax [lindex [$canv cget -scrollregion] 3]
4603 if {$ymax eq {} || $ymax <= 0} return
4604 set view [$canv yview]
4605 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4606 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4610 allcanvs yview moveto $yfrac
4613 proc lineclick {x y id isnew} {
4614 global ctext commitinfo children canv thickerline curview
4616 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4621 # draw this line thicker than normal
4625 set ymax [lindex [$canv cget -scrollregion] 3]
4626 if {$ymax eq {}} return
4627 set yfrac [lindex [$canv yview] 0]
4628 set y [expr {$y + $yfrac * $ymax}]
4630 set dirn [clickisonarrow $id $y]
4632 arrowjump $id $dirn $y
4637 addtohistory [list lineclick $x $y $id 0]
4639 # fill the details pane with info about this line
4640 $ctext conf -state normal
4642 $ctext tag conf link -foreground blue -underline 1
4643 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4644 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4645 $ctext insert end "Parent:\t"
4646 $ctext insert end $id [list link link0]
4647 $ctext tag bind link0 <1> [list selbyid $id]
4648 set info $commitinfo($id)
4649 $ctext insert end "\n\t[lindex $info 0]\n"
4650 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4651 set date [formatdate [lindex $info 2]]
4652 $ctext insert end "\tDate:\t$date\n"
4653 set kids $children($curview,$id)
4655 $ctext insert end "\nChildren:"
4657 foreach child $kids {
4659 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4660 set info $commitinfo($child)
4661 $ctext insert end "\n\t"
4662 $ctext insert end $child [list link link$i]
4663 $ctext tag bind link$i <1> [list selbyid $child]
4664 $ctext insert end "\n\t[lindex $info 0]"
4665 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4666 set date [formatdate [lindex $info 2]]
4667 $ctext insert end "\n\tDate:\t$date\n"
4670 $ctext conf -state disabled
4674 proc normalline {} {
4676 if {[info exists thickerline]} {
4684 global commitrow curview
4685 if {[info exists commitrow($curview,$id)]} {
4686 selectline $commitrow($curview,$id) 1
4692 if {![info exists startmstime]} {
4693 set startmstime [clock clicks -milliseconds]
4695 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4698 proc rowmenu {x y id} {
4699 global rowctxmenu commitrow selectedline rowmenuid curview
4701 if {![info exists selectedline]
4702 || $commitrow($curview,$id) eq $selectedline} {
4707 $rowctxmenu entryconfigure 0 -state $state
4708 $rowctxmenu entryconfigure 1 -state $state
4709 $rowctxmenu entryconfigure 2 -state $state
4711 tk_popup $rowctxmenu $x $y
4714 proc diffvssel {dirn} {
4715 global rowmenuid selectedline displayorder
4717 if {![info exists selectedline]} return
4719 set oldid [lindex $displayorder $selectedline]
4720 set newid $rowmenuid
4722 set oldid $rowmenuid
4723 set newid [lindex $displayorder $selectedline]
4725 addtohistory [list doseldiff $oldid $newid]
4726 doseldiff $oldid $newid
4729 proc doseldiff {oldid newid} {
4733 $ctext conf -state normal
4736 $ctext insert end "From "
4737 $ctext tag conf link -foreground blue -underline 1
4738 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4739 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4740 $ctext tag bind link0 <1> [list selbyid $oldid]
4741 $ctext insert end $oldid [list link link0]
4742 $ctext insert end "\n "
4743 $ctext insert end [lindex $commitinfo($oldid) 0]
4744 $ctext insert end "\n\nTo "
4745 $ctext tag bind link1 <1> [list selbyid $newid]
4746 $ctext insert end $newid [list link link1]
4747 $ctext insert end "\n "
4748 $ctext insert end [lindex $commitinfo($newid) 0]
4749 $ctext insert end "\n"
4750 $ctext conf -state disabled
4751 $ctext tag delete Comments
4752 $ctext tag remove found 1.0 end
4753 startdiff [list $oldid $newid]
4757 global rowmenuid currentid commitinfo patchtop patchnum
4759 if {![info exists currentid]} return
4760 set oldid $currentid
4761 set oldhead [lindex $commitinfo($oldid) 0]
4762 set newid $rowmenuid
4763 set newhead [lindex $commitinfo($newid) 0]
4766 catch {destroy $top}
4768 label $top.title -text "Generate patch"
4769 grid $top.title - -pady 10
4770 label $top.from -text "From:"
4771 entry $top.fromsha1 -width 40 -relief flat
4772 $top.fromsha1 insert 0 $oldid
4773 $top.fromsha1 conf -state readonly
4774 grid $top.from $top.fromsha1 -sticky w
4775 entry $top.fromhead -width 60 -relief flat
4776 $top.fromhead insert 0 $oldhead
4777 $top.fromhead conf -state readonly
4778 grid x $top.fromhead -sticky w
4779 label $top.to -text "To:"
4780 entry $top.tosha1 -width 40 -relief flat
4781 $top.tosha1 insert 0 $newid
4782 $top.tosha1 conf -state readonly
4783 grid $top.to $top.tosha1 -sticky w
4784 entry $top.tohead -width 60 -relief flat
4785 $top.tohead insert 0 $newhead
4786 $top.tohead conf -state readonly
4787 grid x $top.tohead -sticky w
4788 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4789 grid $top.rev x -pady 10
4790 label $top.flab -text "Output file:"
4791 entry $top.fname -width 60
4792 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4794 grid $top.flab $top.fname -sticky w
4796 button $top.buts.gen -text "Generate" -command mkpatchgo
4797 button $top.buts.can -text "Cancel" -command mkpatchcan
4798 grid $top.buts.gen $top.buts.can
4799 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4800 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4801 grid $top.buts - -pady 10 -sticky ew
4805 proc mkpatchrev {} {
4808 set oldid [$patchtop.fromsha1 get]
4809 set oldhead [$patchtop.fromhead get]
4810 set newid [$patchtop.tosha1 get]
4811 set newhead [$patchtop.tohead get]
4812 foreach e [list fromsha1 fromhead tosha1 tohead] \
4813 v [list $newid $newhead $oldid $oldhead] {
4814 $patchtop.$e conf -state normal
4815 $patchtop.$e delete 0 end
4816 $patchtop.$e insert 0 $v
4817 $patchtop.$e conf -state readonly
4824 set oldid [$patchtop.fromsha1 get]
4825 set newid [$patchtop.tosha1 get]
4826 set fname [$patchtop.fname get]
4827 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4828 error_popup "Error creating patch: $err"
4830 catch {destroy $patchtop}
4834 proc mkpatchcan {} {
4837 catch {destroy $patchtop}
4842 global rowmenuid mktagtop commitinfo
4846 catch {destroy $top}
4848 label $top.title -text "Create tag"
4849 grid $top.title - -pady 10
4850 label $top.id -text "ID:"
4851 entry $top.sha1 -width 40 -relief flat
4852 $top.sha1 insert 0 $rowmenuid
4853 $top.sha1 conf -state readonly
4854 grid $top.id $top.sha1 -sticky w
4855 entry $top.head -width 60 -relief flat
4856 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4857 $top.head conf -state readonly
4858 grid x $top.head -sticky w
4859 label $top.tlab -text "Tag name:"
4860 entry $top.tag -width 60
4861 grid $top.tlab $top.tag -sticky w
4863 button $top.buts.gen -text "Create" -command mktaggo
4864 button $top.buts.can -text "Cancel" -command mktagcan
4865 grid $top.buts.gen $top.buts.can
4866 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4867 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4868 grid $top.buts - -pady 10 -sticky ew
4873 global mktagtop env tagids idtags
4875 set id [$mktagtop.sha1 get]
4876 set tag [$mktagtop.tag get]
4878 error_popup "No tag name specified"
4881 if {[info exists tagids($tag)]} {
4882 error_popup "Tag \"$tag\" already exists"
4887 set fname [file join $dir "refs/tags" $tag]
4888 set f [open $fname w]
4892 error_popup "Error creating tag: $err"
4896 set tagids($tag) $id
4897 lappend idtags($id) $tag
4901 proc redrawtags {id} {
4902 global canv linehtag commitrow idpos selectedline curview
4905 if {![info exists commitrow($curview,$id)]} return
4906 drawcmitrow $commitrow($curview,$id)
4907 $canv delete tag.$id
4908 set xt [eval drawtags $id $idpos($id)]
4909 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4910 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4911 set xr [expr {$xt + [font measure $mainfont $text]}]
4912 if {$xr > $canvxmax} {
4916 if {[info exists selectedline]
4917 && $selectedline == $commitrow($curview,$id)} {
4918 selectline $selectedline 0
4925 catch {destroy $mktagtop}
4934 proc writecommit {} {
4935 global rowmenuid wrcomtop commitinfo wrcomcmd
4937 set top .writecommit
4939 catch {destroy $top}
4941 label $top.title -text "Write commit to file"
4942 grid $top.title - -pady 10
4943 label $top.id -text "ID:"
4944 entry $top.sha1 -width 40 -relief flat
4945 $top.sha1 insert 0 $rowmenuid
4946 $top.sha1 conf -state readonly
4947 grid $top.id $top.sha1 -sticky w
4948 entry $top.head -width 60 -relief flat
4949 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4950 $top.head conf -state readonly
4951 grid x $top.head -sticky w
4952 label $top.clab -text "Command:"
4953 entry $top.cmd -width 60 -textvariable wrcomcmd
4954 grid $top.clab $top.cmd -sticky w -pady 10
4955 label $top.flab -text "Output file:"
4956 entry $top.fname -width 60
4957 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4958 grid $top.flab $top.fname -sticky w
4960 button $top.buts.gen -text "Write" -command wrcomgo
4961 button $top.buts.can -text "Cancel" -command wrcomcan
4962 grid $top.buts.gen $top.buts.can
4963 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4964 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4965 grid $top.buts - -pady 10 -sticky ew
4972 set id [$wrcomtop.sha1 get]
4973 set cmd "echo $id | [$wrcomtop.cmd get]"
4974 set fname [$wrcomtop.fname get]
4975 if {[catch {exec sh -c $cmd >$fname &} err]} {
4976 error_popup "Error writing commit: $err"
4978 catch {destroy $wrcomtop}
4985 catch {destroy $wrcomtop}
4989 # Stuff for finding nearby tags
4990 proc getallcommits {} {
4991 global allcstart allcommits
4993 set fd [open [concat | git rev-list --all --topo-order --parents] r]
4994 fconfigure $fd -blocking 0
4995 set allcommits "reading"
5000 proc restartgetall {fd} {
5003 fileevent $fd readable [list getallclines $fd]
5004 set allcstart [clock clicks -milliseconds]
5007 proc combine_dtags {l1 l2} {
5008 global tagisdesc notfirstd
5010 set res [lsort -unique [concat $l1 $l2]]
5011 for {set i 0} {$i < [llength $res]} {incr i} {
5012 set x [lindex $res $i]
5013 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5014 set y [lindex $res $j]
5015 if {[info exists tagisdesc($x,$y)]} {
5016 if {$tagisdesc($x,$y) > 0} {
5017 # x is a descendent of y, exclude x
5018 set res [lreplace $res $i $i]
5022 # y is a descendent of x, exclude y
5023 set res [lreplace $res $j $j]
5026 # no relation, keep going
5034 proc combine_atags {l1 l2} {
5037 set res [lsort -unique [concat $l1 $l2]]
5038 for {set i 0} {$i < [llength $res]} {incr i} {
5039 set x [lindex $res $i]
5040 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5041 set y [lindex $res $j]
5042 if {[info exists tagisdesc($x,$y)]} {
5043 if {$tagisdesc($x,$y) < 0} {
5044 # x is an ancestor of y, exclude x
5045 set res [lreplace $res $i $i]
5049 # y is an ancestor of x, exclude y
5050 set res [lreplace $res $j $j]
5053 # no relation, keep going
5061 proc getallclines {fd} {
5062 global allparents allchildren allcommits allcstart
5063 global desc_tags anc_tags idtags alldtags tagisdesc allids
5064 global desc_heads idheads
5066 while {[gets $fd line] >= 0} {
5067 set id [lindex $line 0]
5069 set olds [lrange $line 1 end]
5070 set allparents($id) $olds
5071 if {![info exists allchildren($id)]} {
5072 set allchildren($id) {}
5075 lappend allchildren($p) $id
5077 # compute nearest tagged descendents as we go
5078 # also compute descendent heads
5081 foreach child $allchildren($id) {
5082 if {[info exists idtags($child)]} {
5083 set ctags [list $child]
5085 set ctags $desc_tags($child)
5089 } elseif {$ctags ne $dtags} {
5090 set dtags [combine_dtags $dtags $ctags]
5092 set cheads $desc_heads($child)
5093 if {$dheads eq {}} {
5095 } elseif {$cheads ne $dheads} {
5096 set dheads [lsort -unique [concat $dheads $cheads]]
5099 set desc_tags($id) $dtags
5100 if {[info exists idtags($id)]} {
5102 foreach tag $dtags {
5103 set adt [concat $adt $alldtags($tag)]
5105 set adt [lsort -unique $adt]
5106 set alldtags($id) $adt
5108 set tagisdesc($id,$tag) -1
5109 set tagisdesc($tag,$id) 1
5112 if {[info exists idheads($id)]} {
5115 set desc_heads($id) $dheads
5116 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5117 fileevent $fd readable {}
5118 after idle restartgetall $fd
5123 after idle restartatags [llength $allids]
5124 if {[catch {close $fd} err]} {
5125 error_popup "Error reading full commit graph: $err.\n\
5126 Results may be incomplete."
5131 # walk backward through the tree and compute nearest tagged ancestors
5132 proc restartatags {i} {
5133 global allids allparents idtags anc_tags t0
5135 set t0 [clock clicks -milliseconds]
5136 while {[incr i -1] >= 0} {
5137 set id [lindex $allids $i]
5139 foreach p $allparents($id) {
5140 if {[info exists idtags($p)]} {
5143 set ptags $anc_tags($p)
5147 } elseif {$ptags ne $atags} {
5148 set atags [combine_atags $atags $ptags]
5151 set anc_tags($id) $atags
5152 if {[clock clicks -milliseconds] - $t0 >= 50} {
5153 after idle restartatags $i
5157 set allcommits "done"
5162 proc rereadrefs {} {
5163 global idtags idheads idotherrefs
5165 set refids [concat [array names idtags] \
5166 [array names idheads] [array names idotherrefs]]
5167 foreach id $refids {
5168 if {![info exists ref($id)]} {
5169 set ref($id) [listrefs $id]
5173 set refids [lsort -unique [concat $refids [array names idtags] \
5174 [array names idheads] [array names idotherrefs]]]
5175 foreach id $refids {
5176 set v [listrefs $id]
5177 if {![info exists ref($id)] || $ref($id) != $v} {
5183 proc showtag {tag isnew} {
5184 global ctext tagcontents tagids linknum
5187 addtohistory [list showtag $tag 0]
5189 $ctext conf -state normal
5192 if {[info exists tagcontents($tag)]} {
5193 set text $tagcontents($tag)
5195 set text "Tag: $tag\nId: $tagids($tag)"
5197 appendwithlinks $text {}
5198 $ctext conf -state disabled
5209 global maxwidth maxgraphpct diffopts
5210 global oldprefs prefstop showneartags
5214 if {[winfo exists $top]} {
5218 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5219 set oldprefs($v) [set $v]
5222 wm title $top "Gitk preferences"
5223 label $top.ldisp -text "Commit list display options"
5224 grid $top.ldisp - -sticky w -pady 10
5225 label $top.spacer -text " "
5226 label $top.maxwidthl -text "Maximum graph width (lines)" \
5228 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5229 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5230 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5232 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5233 grid x $top.maxpctl $top.maxpct -sticky w
5234 label $top.ddisp -text "Diff display options"
5235 grid $top.ddisp - -sticky w -pady 10
5236 label $top.diffoptl -text "Options for diff program" \
5238 entry $top.diffopt -width 20 -textvariable diffopts
5239 grid x $top.diffoptl $top.diffopt -sticky w
5241 label $top.ntag.l -text "Display nearby tags" -font optionfont
5242 checkbutton $top.ntag.b -variable showneartags
5243 pack $top.ntag.b $top.ntag.l -side left
5244 grid x $top.ntag -sticky w
5246 button $top.buts.ok -text "OK" -command prefsok
5247 button $top.buts.can -text "Cancel" -command prefscan
5248 grid $top.buts.ok $top.buts.can
5249 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5250 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5251 grid $top.buts - - -pady 10 -sticky ew
5255 global maxwidth maxgraphpct diffopts
5256 global oldprefs prefstop showneartags
5258 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5259 set $v $oldprefs($v)
5261 catch {destroy $prefstop}
5266 global maxwidth maxgraphpct
5267 global oldprefs prefstop showneartags
5269 catch {destroy $prefstop}
5271 if {$maxwidth != $oldprefs(maxwidth)
5272 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5274 } elseif {$showneartags != $oldprefs(showneartags)} {
5279 proc formatdate {d} {
5280 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5283 # This list of encoding names and aliases is distilled from
5284 # http://www.iana.org/assignments/character-sets.
5285 # Not all of them are supported by Tcl.
5286 set encoding_aliases {
5287 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5288 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5289 { ISO-10646-UTF-1 csISO10646UTF1 }
5290 { ISO_646.basic:1983 ref csISO646basic1983 }
5291 { INVARIANT csINVARIANT }
5292 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5293 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5294 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5295 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5296 { NATS-DANO iso-ir-9-1 csNATSDANO }
5297 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5298 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5299 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5300 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5301 { ISO-2022-KR csISO2022KR }
5303 { ISO-2022-JP csISO2022JP }
5304 { ISO-2022-JP-2 csISO2022JP2 }
5305 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5307 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5308 { IT iso-ir-15 ISO646-IT csISO15Italian }
5309 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5310 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5311 { greek7-old iso-ir-18 csISO18Greek7Old }
5312 { latin-greek iso-ir-19 csISO19LatinGreek }
5313 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5314 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5315 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5316 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5317 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5318 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5319 { INIS iso-ir-49 csISO49INIS }
5320 { INIS-8 iso-ir-50 csISO50INIS8 }
5321 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5322 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5323 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5324 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5325 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5326 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5328 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5329 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5330 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5331 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5332 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5333 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5334 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5335 { greek7 iso-ir-88 csISO88Greek7 }
5336 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5337 { iso-ir-90 csISO90 }
5338 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5339 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5340 csISO92JISC62991984b }
5341 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5342 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5343 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5344 csISO95JIS62291984handadd }
5345 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5346 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5347 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5348 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5350 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5351 { T.61-7bit iso-ir-102 csISO102T617bit }
5352 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5353 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5354 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5355 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5356 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5357 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5358 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5359 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5360 arabic csISOLatinArabic }
5361 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5362 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5363 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5364 greek greek8 csISOLatinGreek }
5365 { T.101-G2 iso-ir-128 csISO128T101G2 }
5366 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5368 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5369 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5370 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5371 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5372 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5373 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5374 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5375 csISOLatinCyrillic }
5376 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5377 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5378 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5379 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5380 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5381 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5382 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5383 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5384 { ISO_10367-box iso-ir-155 csISO10367Box }
5385 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5386 { latin-lap lap iso-ir-158 csISO158Lap }
5387 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5388 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5391 { JIS_X0201 X0201 csHalfWidthKatakana }
5392 { KSC5636 ISO646-KR csKSC5636 }
5393 { ISO-10646-UCS-2 csUnicode }
5394 { ISO-10646-UCS-4 csUCS4 }
5395 { DEC-MCS dec csDECMCS }
5396 { hp-roman8 roman8 r8 csHPRoman8 }
5397 { macintosh mac csMacintosh }
5398 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5400 { IBM038 EBCDIC-INT cp038 csIBM038 }
5401 { IBM273 CP273 csIBM273 }
5402 { IBM274 EBCDIC-BE CP274 csIBM274 }
5403 { IBM275 EBCDIC-BR cp275 csIBM275 }
5404 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5405 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5406 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5407 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5408 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5409 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5410 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5411 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5412 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5413 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5414 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5415 { IBM437 cp437 437 csPC8CodePage437 }
5416 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5417 { IBM775 cp775 csPC775Baltic }
5418 { IBM850 cp850 850 csPC850Multilingual }
5419 { IBM851 cp851 851 csIBM851 }
5420 { IBM852 cp852 852 csPCp852 }
5421 { IBM855 cp855 855 csIBM855 }
5422 { IBM857 cp857 857 csIBM857 }
5423 { IBM860 cp860 860 csIBM860 }
5424 { IBM861 cp861 861 cp-is csIBM861 }
5425 { IBM862 cp862 862 csPC862LatinHebrew }
5426 { IBM863 cp863 863 csIBM863 }
5427 { IBM864 cp864 csIBM864 }
5428 { IBM865 cp865 865 csIBM865 }
5429 { IBM866 cp866 866 csIBM866 }
5430 { IBM868 CP868 cp-ar csIBM868 }
5431 { IBM869 cp869 869 cp-gr csIBM869 }
5432 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5433 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5434 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5435 { IBM891 cp891 csIBM891 }
5436 { IBM903 cp903 csIBM903 }
5437 { IBM904 cp904 904 csIBBM904 }
5438 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5439 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5440 { IBM1026 CP1026 csIBM1026 }
5441 { EBCDIC-AT-DE csIBMEBCDICATDE }
5442 { EBCDIC-AT-DE-A csEBCDICATDEA }
5443 { EBCDIC-CA-FR csEBCDICCAFR }
5444 { EBCDIC-DK-NO csEBCDICDKNO }
5445 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5446 { EBCDIC-FI-SE csEBCDICFISE }
5447 { EBCDIC-FI-SE-A csEBCDICFISEA }
5448 { EBCDIC-FR csEBCDICFR }
5449 { EBCDIC-IT csEBCDICIT }
5450 { EBCDIC-PT csEBCDICPT }
5451 { EBCDIC-ES csEBCDICES }
5452 { EBCDIC-ES-A csEBCDICESA }
5453 { EBCDIC-ES-S csEBCDICESS }
5454 { EBCDIC-UK csEBCDICUK }
5455 { EBCDIC-US csEBCDICUS }
5456 { UNKNOWN-8BIT csUnknown8BiT }
5457 { MNEMONIC csMnemonic }
5462 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5463 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5464 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5465 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5466 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5467 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5468 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5469 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5470 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5471 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5472 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5473 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5474 { IBM1047 IBM-1047 }
5475 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5476 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5477 { UNICODE-1-1 csUnicode11 }
5480 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5481 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5483 { ISO-8859-15 ISO_8859-15 Latin-9 }
5484 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5485 { GBK CP936 MS936 windows-936 }
5486 { JIS_Encoding csJISEncoding }
5487 { Shift_JIS MS_Kanji csShiftJIS }
5488 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5490 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5491 { ISO-10646-UCS-Basic csUnicodeASCII }
5492 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5493 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5494 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5495 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5496 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5497 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5498 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5499 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5500 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5501 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5502 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5503 { Ventura-US csVenturaUS }
5504 { Ventura-International csVenturaInternational }
5505 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5506 { PC8-Turkish csPC8Turkish }
5507 { IBM-Symbols csIBMSymbols }
5508 { IBM-Thai csIBMThai }
5509 { HP-Legal csHPLegal }
5510 { HP-Pi-font csHPPiFont }
5511 { HP-Math8 csHPMath8 }
5512 { Adobe-Symbol-Encoding csHPPSMath }
5513 { HP-DeskTop csHPDesktop }
5514 { Ventura-Math csVenturaMath }
5515 { Microsoft-Publishing csMicrosoftPublishing }
5516 { Windows-31J csWindows31J }
5521 proc tcl_encoding {enc} {
5522 global encoding_aliases
5523 set names [encoding names]
5524 set lcnames [string tolower $names]
5525 set enc [string tolower $enc]
5526 set i [lsearch -exact $lcnames $enc]
5528 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5529 if {[regsub {^iso[-_]} $enc iso encx]} {
5530 set i [lsearch -exact $lcnames $encx]
5534 foreach l $encoding_aliases {
5535 set ll [string tolower $l]
5536 if {[lsearch -exact $ll $enc] < 0} continue
5537 # look through the aliases for one that tcl knows about
5539 set i [lsearch -exact $lcnames $e]
5541 if {[regsub {^iso[-_]} $e iso ex]} {
5542 set i [lsearch -exact $lcnames $ex]
5551 return [lindex $names $i]
5558 set diffopts "-U 5 -p"
5559 set wrcomcmd "git diff-tree --stdin -p --pretty"
5563 set gitencoding [exec git repo-config --get i18n.commitencoding]
5565 if {$gitencoding == ""} {
5566 set gitencoding "utf-8"
5568 set tclencoding [tcl_encoding $gitencoding]
5569 if {$tclencoding == {}} {
5570 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5573 set mainfont {Helvetica 9}
5574 set textfont {Courier 9}
5575 set uifont {Helvetica 9 bold}
5576 set findmergefiles 0
5584 set cmitmode "patch"
5585 set wrapcomment "none"
5588 set colors {green red blue magenta darkgrey brown orange}
5590 catch {source ~/.gitk}
5592 font create optionfont -family sans-serif -size -12
5596 switch -regexp -- $arg {
5598 "^-d" { set datemode 1 }
5600 lappend revtreeargs $arg
5605 # check that we can find a .git directory somewhere...
5607 if {![file isdirectory $gitdir]} {
5608 show_error {} . "Cannot find the git directory \"$gitdir\"."
5612 set cmdline_files {}
5613 set i [lsearch -exact $revtreeargs "--"]
5615 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5616 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5617 } elseif {$revtreeargs ne {}} {
5619 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5620 set cmdline_files [split $f "\n"]
5621 set n [llength $cmdline_files]
5622 set revtreeargs [lrange $revtreeargs 0 end-$n]
5624 # unfortunately we get both stdout and stderr in $err,
5625 # so look for "fatal:".
5626 set i [string first "fatal:" $err]
5628 set err [string range $err [expr {$i + 6}] end]
5630 show_error {} . "Bad arguments to gitk:\n$err"
5639 set highlight_paths {}
5640 set searchdirn -forwards
5649 set selectedhlview None
5662 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5663 # create a view for the files/dirs specified on the command line
5667 set viewname(1) "Command line"
5668 set viewfiles(1) $cmdline_files
5669 set viewargs(1) $revtreeargs
5672 .bar.view entryconf 2 -state normal
5673 .bar.view entryconf 3 -state normal
5676 if {[info exists permviews]} {
5677 foreach v $permviews {
5680 set viewname($n) [lindex $v 0]
5681 set viewfiles($n) [lindex $v 1]
5682 set viewargs($n) [lindex $v 2]