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)}
246 proc parsecommit
{id contents listed
} {
247 global commitinfo cdate
256 set hdrend
[string first
"\n\n" $contents]
258 # should never happen...
259 set hdrend
[string length
$contents]
261 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
262 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
263 foreach line
[split $header "\n"] {
264 set tag
[lindex
$line 0]
265 if {$tag == "author"} {
266 set audate
[lindex
$line end-1
]
267 set auname
[lrange
$line 1 end-2
]
268 } elseif
{$tag == "committer"} {
269 set comdate
[lindex
$line end-1
]
270 set comname
[lrange
$line 1 end-2
]
274 # take the first line of the comment as the headline
275 set i
[string first
"\n" $comment]
277 set headline
[string trim
[string range
$comment 0 $i]]
279 set headline
$comment
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
285 foreach line
[split $comment "\n"] {
286 append newcomment
" "
287 append newcomment
$line
288 append newcomment
"\n"
290 set comment
$newcomment
292 if {$comdate != {}} {
293 set cdate
($id) $comdate
295 set commitinfo
($id) [list
$headline $auname $audate \
296 $comname $comdate $comment]
299 proc getcommit
{id
} {
300 global commitdata commitinfo
302 if {[info exists commitdata
($id)]} {
303 parsecommit
$id $commitdata($id) 1
306 if {![info exists commitinfo
($id)]} {
307 set commitinfo
($id) {"No commit information available"}
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs
317 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
320 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
321 while {0 <= [set n
[gets
$refd line
]]} {
322 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
326 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
329 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
333 if {[regexp
{^remotes
/} $path match
]} {
336 if {$type == "tags"} {
337 set tagids
($name) $id
338 lappend idtags
($id) $name
343 set commit
[exec git rev-parse
"$id^0"]
344 if {"$commit" != "$id"} {
345 set tagids
($name) $commit
346 lappend idtags
($commit) $name
350 set tagcontents
($name) [exec git cat-file tag
"$id"]
352 } elseif
{ $type == "heads" } {
353 set headids
($name) $id
354 lappend idheads
($id) $name
356 set otherrefids
($name) $id
357 lappend idotherrefs
($id) $name
363 proc show_error
{w top msg
} {
364 message
$w.m
-text $msg -justify center
-aspect 400
365 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
366 button
$w.ok
-text OK
-command "destroy $top"
367 pack
$w.ok
-side bottom
-fill x
368 bind $top <Visibility
> "grab $top; focus $top"
369 bind $top <Key-Return
> "destroy $top"
373 proc error_popup msg
{
377 show_error
$w $w $msg
381 global canv canv2 canv3 linespc charspc ctext cflist
382 global textfont mainfont uifont
383 global findtype findtypemenu findloc findstring fstring geometry
384 global entries sha1entry sha1string sha1but
385 global maincursor textcursor curtextcursor
386 global rowctxmenu mergemax wrapcomment
387 global highlight_files gdttype
388 global searchstring sstring
389 global bgcolor fgcolor bglist fglist diffcolors
392 .bar add cascade
-label "File" -menu .bar.
file
393 .bar configure
-font $uifont
395 .bar.
file add
command -label "Update" -command updatecommits
396 .bar.
file add
command -label "Reread references" -command rereadrefs
397 .bar.
file add
command -label "Quit" -command doquit
398 .bar.
file configure
-font $uifont
400 .bar add cascade
-label "Edit" -menu .bar.edit
401 .bar.edit add
command -label "Preferences" -command doprefs
402 .bar.edit configure
-font $uifont
404 menu .bar.view
-font $uifont
405 .bar add cascade
-label "View" -menu .bar.view
406 .bar.view add
command -label "New view..." -command {newview
0}
407 .bar.view add
command -label "Edit view..." -command editview \
409 .bar.view add
command -label "Delete view" -command delview
-state disabled
410 .bar.view add separator
411 .bar.view add radiobutton
-label "All files" -command {showview
0} \
412 -variable selectedview
-value 0
415 .bar add cascade
-label "Help" -menu .bar.
help
416 .bar.
help add
command -label "About gitk" -command about
417 .bar.
help add
command -label "Key bindings" -command keys
418 .bar.
help configure
-font $uifont
419 . configure
-menu .bar
421 if {![info exists geometry
(canv1
)]} {
422 set geometry
(canv1
) [expr {45 * $charspc}]
423 set geometry
(canv2
) [expr {30 * $charspc}]
424 set geometry
(canv3
) [expr {15 * $charspc}]
425 set geometry
(canvh
) [expr {25 * $linespc + 4}]
426 set geometry
(ctextw
) 80
427 set geometry
(ctexth
) 30
428 set geometry
(cflistw
) 30
430 panedwindow .ctop
-orient vertical
431 if {[info exists geometry
(width
)]} {
432 .ctop conf
-width $geometry(width
) -height $geometry(height
)
433 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
434 set geometry
(ctexth
) [expr {($texth - 8) /
435 [font metrics
$textfont -linespace]}]
440 pack .ctop.top.lbar
-side bottom
-fill x
441 pack .ctop.top.bar
-side bottom
-fill x
442 set cscroll .ctop.top.csb
443 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
444 pack
$cscroll -side right
-fill y
445 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
446 pack .ctop.top.clist
-side top
-fill both
-expand 1
448 set canv .ctop.top.clist.canv
449 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
450 -background $bgcolor -bd 0 \
451 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
452 .ctop.top.clist add
$canv
453 set canv2 .ctop.top.clist.canv2
454 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
455 -background $bgcolor -bd 0 -yscrollincr $linespc
456 .ctop.top.clist add
$canv2
457 set canv3 .ctop.top.clist.canv3
458 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
459 -background $bgcolor -bd 0 -yscrollincr $linespc
460 .ctop.top.clist add
$canv3
461 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
462 lappend bglist
$canv $canv2 $canv3
464 set sha1entry .ctop.top.bar.sha1
465 set entries
$sha1entry
466 set sha1but .ctop.top.bar.sha1label
467 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
468 -command gotocommit
-width 8 -font $uifont
469 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
470 pack .ctop.top.bar.sha1label
-side left
471 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
472 trace add variable sha1string
write sha1change
473 pack
$sha1entry -side left
-pady 2
475 image create bitmap bm-left
-data {
476 #define left_width 16
477 #define left_height 16
478 static unsigned char left_bits
[] = {
479 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
480 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
481 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
483 image create bitmap bm-right
-data {
484 #define right_width 16
485 #define right_height 16
486 static unsigned char right_bits
[] = {
487 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
488 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
489 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
491 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
492 -state disabled
-width 26
493 pack .ctop.top.bar.leftbut
-side left
-fill y
494 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
495 -state disabled
-width 26
496 pack .ctop.top.bar.rightbut
-side left
-fill y
498 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
499 pack .ctop.top.bar.findbut
-side left
501 set fstring .ctop.top.bar.findstring
502 lappend entries
$fstring
503 entry
$fstring -width 30 -font $textfont -textvariable findstring
504 trace add variable findstring
write find_change
505 pack
$fstring -side left
-expand 1 -fill x
507 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
508 findtype Exact IgnCase Regexp
]
509 trace add variable findtype
write find_change
510 .ctop.top.bar.findtype configure
-font $uifont
511 .ctop.top.bar.findtype.menu configure
-font $uifont
512 set findloc
"All fields"
513 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
514 Comments Author Committer
515 trace add variable findloc
write find_change
516 .ctop.top.bar.findloc configure
-font $uifont
517 .ctop.top.bar.findloc.menu configure
-font $uifont
518 pack .ctop.top.bar.findloc
-side right
519 pack .ctop.top.bar.findtype
-side right
521 label .ctop.top.lbar.flabel
-text "Highlight: Commits " \
523 pack .ctop.top.lbar.flabel
-side left
-fill y
524 set gdttype
"touching paths:"
525 set gm
[tk_optionMenu .ctop.top.lbar.gdttype gdttype
"touching paths:" \
526 "adding/removing string:"]
527 trace add variable gdttype
write hfiles_change
528 $gm conf
-font $uifont
529 .ctop.top.lbar.gdttype conf
-font $uifont
530 pack .ctop.top.lbar.gdttype
-side left
-fill y
531 entry .ctop.top.lbar.fent
-width 25 -font $textfont \
532 -textvariable highlight_files
533 trace add variable highlight_files
write hfiles_change
534 lappend entries .ctop.top.lbar.fent
535 pack .ctop.top.lbar.fent
-side left
-fill x
-expand 1
536 label .ctop.top.lbar.vlabel
-text " OR in view" -font $uifont
537 pack .ctop.top.lbar.vlabel
-side left
-fill y
538 global viewhlmenu selectedhlview
539 set viewhlmenu
[tk_optionMenu .ctop.top.lbar.vhl selectedhlview None
]
540 $viewhlmenu entryconf
0 -command delvhighlight
541 $viewhlmenu conf
-font $uifont
542 .ctop.top.lbar.vhl conf
-font $uifont
543 pack .ctop.top.lbar.vhl
-side left
-fill y
544 label .ctop.top.lbar.rlabel
-text " OR " -font $uifont
545 pack .ctop.top.lbar.rlabel
-side left
-fill y
546 global highlight_related
547 set m
[tk_optionMenu .ctop.top.lbar.relm highlight_related None \
548 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
549 $m conf
-font $uifont
550 .ctop.top.lbar.relm conf
-font $uifont
551 trace add variable highlight_related
write vrel_change
552 pack .ctop.top.lbar.relm
-side left
-fill y
554 panedwindow .ctop.cdet
-orient horizontal
556 frame .ctop.cdet.left
557 frame .ctop.cdet.left.bot
558 pack .ctop.cdet.left.bot
-side bottom
-fill x
559 button .ctop.cdet.left.bot.search
-text "Search" -command dosearch \
561 pack .ctop.cdet.left.bot.search
-side left
-padx 5
562 set sstring .ctop.cdet.left.bot.sstring
563 entry
$sstring -width 20 -font $textfont -textvariable searchstring
564 lappend entries
$sstring
565 trace add variable searchstring
write incrsearch
566 pack
$sstring -side left
-expand 1 -fill x
567 set ctext .ctop.cdet.left.ctext
568 text
$ctext -background $bgcolor -foreground $fgcolor \
569 -state disabled
-font $textfont \
570 -width $geometry(ctextw
) -height $geometry(ctexth
) \
571 -yscrollcommand scrolltext
-wrap none
572 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
573 pack .ctop.cdet.left.sb
-side right
-fill y
574 pack
$ctext -side left
-fill both
-expand 1
575 .ctop.cdet add .ctop.cdet.left
576 lappend bglist
$ctext
577 lappend fglist
$ctext
579 $ctext tag conf comment
-wrap $wrapcomment
580 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
581 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
582 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
583 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
584 $ctext tag conf m0
-fore red
585 $ctext tag conf m1
-fore blue
586 $ctext tag conf m2
-fore green
587 $ctext tag conf m3
-fore purple
588 $ctext tag conf
m4 -fore brown
589 $ctext tag conf m5
-fore "#009090"
590 $ctext tag conf m6
-fore magenta
591 $ctext tag conf m7
-fore "#808000"
592 $ctext tag conf m8
-fore "#009000"
593 $ctext tag conf m9
-fore "#ff0080"
594 $ctext tag conf m10
-fore cyan
595 $ctext tag conf m11
-fore "#b07070"
596 $ctext tag conf m12
-fore "#70b0f0"
597 $ctext tag conf m13
-fore "#70f0b0"
598 $ctext tag conf m14
-fore "#f0b070"
599 $ctext tag conf m15
-fore "#ff70b0"
600 $ctext tag conf mmax
-fore darkgrey
602 $ctext tag conf mresult
-font [concat
$textfont bold
]
603 $ctext tag conf msep
-font [concat
$textfont bold
]
604 $ctext tag conf found
-back yellow
606 frame .ctop.cdet.right
607 frame .ctop.cdet.right.mode
608 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
609 -command reselectline
-variable cmitmode
-value "patch"
610 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
611 -command reselectline
-variable cmitmode
-value "tree"
612 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
613 pack .ctop.cdet.right.mode
-side top
-fill x
614 set cflist .ctop.cdet.right.cfiles
615 set indent
[font measure
$mainfont "nn"]
616 text
$cflist -width $geometry(cflistw
) \
617 -background $bgcolor -foreground $fgcolor \
619 -tabs [list
$indent [expr {2 * $indent}]] \
620 -yscrollcommand ".ctop.cdet.right.sb set" \
621 -cursor [. cget
-cursor] \
622 -spacing1 1 -spacing3 1
623 lappend bglist
$cflist
624 lappend fglist
$cflist
625 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
626 pack .ctop.cdet.right.sb
-side right
-fill y
627 pack
$cflist -side left
-fill both
-expand 1
628 $cflist tag configure highlight \
629 -background [$cflist cget
-selectbackground]
630 $cflist tag configure bold
-font [concat
$mainfont bold
]
631 .ctop.cdet add .ctop.cdet.right
632 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
634 pack .ctop
-side top
-fill both
-expand 1
636 bindall
<1> {selcanvline
%W
%x
%y
}
637 #bindall <B1-Motion> {selcanvline %W %x %y}
638 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
639 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
640 bindall
<2> "canvscan mark %W %x %y"
641 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
642 bindkey
<Home
> selfirstline
643 bindkey
<End
> sellastline
644 bind .
<Key-Up
> "selnextline -1"
645 bind .
<Key-Down
> "selnextline 1"
646 bind .
<Shift-Key-Up
> "next_highlight -1"
647 bind .
<Shift-Key-Down
> "next_highlight 1"
648 bindkey
<Key-Right
> "goforw"
649 bindkey
<Key-Left
> "goback"
650 bind .
<Key-Prior
> "selnextpage -1"
651 bind .
<Key-Next
> "selnextpage 1"
652 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
653 bind .
<Control-End
> "allcanvs yview moveto 1.0"
654 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
655 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
656 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
657 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
658 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
659 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
660 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
661 bindkey p
"selnextline -1"
662 bindkey n
"selnextline 1"
665 bindkey i
"selnextline -1"
666 bindkey k
"selnextline 1"
669 bindkey b
"$ctext yview scroll -1 pages"
670 bindkey d
"$ctext yview scroll 18 units"
671 bindkey u
"$ctext yview scroll -18 units"
672 bindkey
/ {findnext
1}
673 bindkey
<Key-Return
> {findnext
0}
676 bind .
<Control-q
> doquit
677 bind .
<Control-f
> dofind
678 bind .
<Control-g
> {findnext
0}
679 bind .
<Control-r
> dosearchback
680 bind .
<Control-s
> dosearch
681 bind .
<Control-equal
> {incrfont
1}
682 bind .
<Control-KP_Add
> {incrfont
1}
683 bind .
<Control-minus
> {incrfont
-1}
684 bind .
<Control-KP_Subtract
> {incrfont
-1}
685 bind .
<Destroy
> {savestuff
%W
}
686 bind .
<Button-1
> "click %W"
687 bind $fstring <Key-Return
> dofind
688 bind $sha1entry <Key-Return
> gotocommit
689 bind $sha1entry <<PasteSelection>> clearsha1
690 bind $cflist <1> {sel_flist %W %x %y; break}
691 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
692 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
694 set maincursor [. cget -cursor]
695 set textcursor [$ctext cget -cursor]
696 set curtextcursor $textcursor
698 set rowctxmenu .rowctxmenu
699 menu $rowctxmenu -tearoff 0
700 $rowctxmenu add command -label "Diff this -> selected" \
701 -command {diffvssel 0}
702 $rowctxmenu add command -label "Diff selected -> this" \
703 -command {diffvssel 1}
704 $rowctxmenu add command -label "Make patch" -command mkpatch
705 $rowctxmenu add command -label "Create tag" -command mktag
706 $rowctxmenu add command -label "Write commit to file" -command writecommit
709 # mouse-2 makes all windows scan vertically, but only the one
710 # the cursor is in scans horizontally
711 proc canvscan {op w x y} {
712 global canv canv2 canv3
713 foreach c [list $canv $canv2 $canv3] {
722 proc scrollcanv {cscroll f0 f1} {
728 # when we make a key binding for the toplevel, make sure
729 # it doesn't get triggered when that key is pressed in the
730 # find string entry widget.
731 proc bindkey {ev script} {
734 set escript [bind Entry $ev]
735 if {$escript == {}} {
736 set escript [bind Entry <Key>]
739 bind $e $ev "$escript; break"
743 # set the focus back to the toplevel for any click outside
754 global canv canv2 canv3 ctext cflist mainfont textfont uifont
755 global stuffsaved findmergefiles maxgraphpct
756 global maxwidth showneartags
757 global viewname viewfiles viewargs viewperm nextviewnum
758 global cmitmode wrapcomment
759 global colors bgcolor fgcolor diffcolors
761 if {$stuffsaved} return
762 if {![winfo viewable .]} return
764 set f [open "~/.gitk-new" w]
765 puts $f [list set mainfont $mainfont]
766 puts $f [list set textfont $textfont]
767 puts $f [list set uifont $uifont]
768 puts $f [list set findmergefiles $findmergefiles]
769 puts $f [list set maxgraphpct $maxgraphpct]
770 puts $f [list set maxwidth $maxwidth]
771 puts $f [list set cmitmode $cmitmode]
772 puts $f [list set wrapcomment $wrapcomment]
773 puts $f [list set showneartags $showneartags]
774 puts $f [list set bgcolor $bgcolor]
775 puts $f [list set fgcolor $fgcolor]
776 puts $f [list set colors $colors]
777 puts $f [list set diffcolors $diffcolors]
778 puts $f "set geometry(width) [winfo width .ctop]"
779 puts $f "set geometry(height) [winfo height .ctop]"
780 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
781 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
782 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
783 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
784 set wid [expr {([winfo width $ctext] - 8) \
785 / [font measure $textfont "0"]}]
786 puts $f "set geometry(ctextw) $wid"
787 set wid [expr {([winfo width $cflist] - 11) \
788 / [font measure [$cflist cget -font] "0"]}]
789 puts $f "set geometry(cflistw) $wid"
790 puts -nonewline $f "set permviews {"
791 for {set v 0} {$v < $nextviewnum} {incr v} {
793 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
798 file rename -force "~/.gitk-new" "~/.gitk"
803 proc resizeclistpanes {win w} {
805 if {[info exists oldwidth($win)]} {
806 set s0 [$win sash coord 0]
807 set s1 [$win sash coord 1]
809 set sash0 [expr {int($w/2 - 2)}]
810 set sash1 [expr {int($w*5/6 - 2)}]
812 set factor [expr {1.0 * $w / $oldwidth($win)}]
813 set sash0 [expr {int($factor * [lindex $s0 0])}]
814 set sash1 [expr {int($factor * [lindex $s1 0])}]
818 if {$sash1 < $sash0 + 20} {
819 set sash1 [expr {$sash0 + 20}]
821 if {$sash1 > $w - 10} {
822 set sash1 [expr {$w - 10}]
823 if {$sash0 > $sash1 - 20} {
824 set sash0 [expr {$sash1 - 20}]
828 $win sash place 0 $sash0 [lindex $s0 1]
829 $win sash place 1 $sash1 [lindex $s1 1]
831 set oldwidth($win) $w
834 proc resizecdetpanes {win w} {
836 if {[info exists oldwidth($win)]} {
837 set s0 [$win sash coord 0]
839 set sash0 [expr {int($w*3/4 - 2)}]
841 set factor [expr {1.0 * $w / $oldwidth($win)}]
842 set sash0 [expr {int($factor * [lindex $s0 0])}]
846 if {$sash0 > $w - 15} {
847 set sash0 [expr {$w - 15}]
850 $win sash place 0 $sash0 [lindex $s0 1]
852 set oldwidth($win) $w
856 global canv canv2 canv3
862 proc bindall {event action} {
863 global canv canv2 canv3
864 bind $canv $event $action
865 bind $canv2 $event $action
866 bind $canv3 $event $action
871 if {[winfo exists $w]} {
876 wm title $w "About gitk"
878 Gitk - a commit viewer for git
880 Copyright © 2005-2006 Paul Mackerras
882 Use and redistribute under the terms of the GNU General Public License} \
883 -justify center -aspect 400
884 pack $w.m -side top -fill x -padx 20 -pady 20
885 button $w.ok -text Close -command "destroy $w"
886 pack $w.ok -side bottom
891 if {[winfo exists $w]} {
896 wm title $w "Gitk key bindings"
901 <Home> Move to first commit
902 <End> Move to last commit
903 <Up>, p, i Move up one commit
904 <Down>, n, k Move down one commit
905 <Left>, z, j Go back in history list
906 <Right>, x, l Go forward in history list
907 <PageUp> Move up one page in commit list
908 <PageDown> Move down one page in commit list
909 <Ctrl-Home> Scroll to top of commit list
910 <Ctrl-End> Scroll to bottom of commit list
911 <Ctrl-Up> Scroll commit list up one line
912 <Ctrl-Down> Scroll commit list down one line
913 <Ctrl-PageUp> Scroll commit list up one page
914 <Ctrl-PageDown> Scroll commit list down one page
915 <Shift-Up> Move to previous highlighted line
916 <Shift-Down> Move to next highlighted line
917 <Delete>, b Scroll diff view up one page
918 <Backspace> Scroll diff view up one page
919 <Space> Scroll diff view down one page
920 u Scroll diff view up 18 lines
921 d Scroll diff view down 18 lines
923 <Ctrl-G> Move to next find hit
924 <Return> Move to next find hit
925 / Move to next find hit, or redo find
926 ? Move to previous find hit
927 f Scroll diff view to next file
928 <Ctrl-S> Search for next hit in diff view
929 <Ctrl-R> Search for previous hit in diff view
930 <Ctrl-KP+> Increase font size
931 <Ctrl-plus> Increase font size
932 <Ctrl-KP-> Decrease font size
933 <Ctrl-minus> Decrease font size
935 -justify left -bg white -border 2 -relief sunken
936 pack $w.m -side top -fill both
937 button $w.ok -text Close -command "destroy $w"
938 pack $w.ok -side bottom
941 # Procedures for manipulating the file list window at the
942 # bottom right of the overall window.
944 proc treeview {w l openlevs} {
945 global treecontents treediropen treeheight treeparent treeindex
955 set treecontents() {}
956 $w conf -state normal
958 while {[string range $f 0 $prefixend] ne $prefix} {
959 if {$lev <= $openlevs} {
960 $w mark set e:$treeindex($prefix) "end -1c"
961 $w mark gravity e:$treeindex($prefix) left
963 set treeheight($prefix) $ht
964 incr ht [lindex $htstack end]
965 set htstack [lreplace $htstack end end]
966 set prefixend [lindex $prefendstack end]
967 set prefendstack [lreplace $prefendstack end end]
968 set prefix [string range $prefix 0 $prefixend]
971 set tail [string range $f [expr {$prefixend+1}] end]
972 while {[set slash [string first "/" $tail]] >= 0} {
975 lappend prefendstack $prefixend
976 incr prefixend [expr {$slash + 1}]
977 set d [string range $tail 0 $slash]
978 lappend treecontents($prefix) $d
979 set oldprefix $prefix
981 set treecontents($prefix) {}
982 set treeindex($prefix) [incr ix]
983 set treeparent($prefix) $oldprefix
984 set tail [string range $tail [expr {$slash+1}] end]
985 if {$lev <= $openlevs} {
987 set treediropen($prefix) [expr {$lev < $openlevs}]
988 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
989 $w mark set d:$ix "end -1c"
990 $w mark gravity d:$ix left
992 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
994 $w image create end -align center -image $bm -padx 1 \
996 $w insert end $d [highlight_tag $prefix]
997 $w mark set s:$ix "end -1c"
998 $w mark gravity s:$ix left
1003 if {$lev <= $openlevs} {
1006 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1008 $w insert end $tail [highlight_tag $f]
1010 lappend treecontents($prefix) $tail
1013 while {$htstack ne {}} {
1014 set treeheight($prefix) $ht
1015 incr ht [lindex $htstack end]
1016 set htstack [lreplace $htstack end end]
1018 $w conf -state disabled
1021 proc linetoelt {l} {
1022 global treeheight treecontents
1027 foreach e $treecontents($prefix) {
1032 if {[string index $e end] eq "/"} {
1033 set n $treeheight($prefix$e)
1045 proc highlight_tree {y prefix} {
1046 global treeheight treecontents cflist
1048 foreach e $treecontents($prefix) {
1050 if {[highlight_tag $path] ne {}} {
1051 $cflist tag add bold $y.0 "$y.0 lineend"
1054 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1055 set y [highlight_tree $y $path]
1061 proc treeclosedir {w dir} {
1062 global treediropen treeheight treeparent treeindex
1064 set ix $treeindex($dir)
1065 $w conf -state normal
1066 $w delete s:$ix e:$ix
1067 set treediropen($dir) 0
1068 $w image configure a:$ix -image tri-rt
1069 $w conf -state disabled
1070 set n [expr {1 - $treeheight($dir)}]
1071 while {$dir ne {}} {
1072 incr treeheight($dir) $n
1073 set dir $treeparent($dir)
1077 proc treeopendir {w dir} {
1078 global treediropen treeheight treeparent treecontents treeindex
1080 set ix $treeindex($dir)
1081 $w conf -state normal
1082 $w image configure a:$ix -image tri-dn
1083 $w mark set e:$ix s:$ix
1084 $w mark gravity e:$ix right
1087 set n [llength $treecontents($dir)]
1088 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1091 incr treeheight($x) $n
1093 foreach e $treecontents($dir) {
1095 if {[string index $e end] eq "/"} {
1096 set iy $treeindex($de)
1097 $w mark set d:$iy e:$ix
1098 $w mark gravity d:$iy left
1099 $w insert e:$ix $str
1100 set treediropen($de) 0
1101 $w image create e:$ix -align center -image tri-rt -padx 1 \
1103 $w insert e:$ix $e [highlight_tag $de]
1104 $w mark set s:$iy e:$ix
1105 $w mark gravity s:$iy left
1106 set treeheight($de) 1
1108 $w insert e:$ix $str
1109 $w insert e:$ix $e [highlight_tag $de]
1112 $w mark gravity e:$ix left
1113 $w conf -state disabled
1114 set treediropen($dir) 1
1115 set top [lindex [split [$w index @0,0] .] 0]
1116 set ht [$w cget -height]
1117 set l [lindex [split [$w index s:$ix] .] 0]
1120 } elseif {$l + $n + 1 > $top + $ht} {
1121 set top [expr {$l + $n + 2 - $ht}]
1129 proc treeclick {w x y} {
1130 global treediropen cmitmode ctext cflist cflist_top
1132 if {$cmitmode ne "tree"} return
1133 if {![info exists cflist_top]} return
1134 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1135 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1136 $cflist tag add highlight $l.0 "$l.0 lineend"
1142 set e [linetoelt $l]
1143 if {[string index $e end] ne "/"} {
1145 } elseif {$treediropen($e)} {
1152 proc setfilelist {id} {
1153 global treefilelist cflist
1155 treeview $cflist $treefilelist($id) 0
1158 image create bitmap tri-rt -background black -foreground blue -data {
1159 #define tri-rt_width 13
1160 #define tri-rt_height 13
1161 static unsigned char tri-rt_bits[] = {
1162 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1163 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1166 #define tri-rt-mask_width 13
1167 #define tri-rt-mask_height 13
1168 static unsigned char tri-rt-mask_bits[] = {
1169 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1170 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1173 image create bitmap tri-dn -background black -foreground blue -data {
1174 #define tri-dn_width 13
1175 #define tri-dn_height 13
1176 static unsigned char tri-dn_bits[] = {
1177 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1178 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1181 #define tri-dn-mask_width 13
1182 #define tri-dn-mask_height 13
1183 static unsigned char tri-dn-mask_bits[] = {
1184 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1185 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1189 proc init_flist {first} {
1190 global cflist cflist_top selectedline difffilestart
1192 $cflist conf -state normal
1193 $cflist delete 0.0 end
1195 $cflist insert end $first
1197 $cflist tag add highlight 1.0 "1.0 lineend"
1199 catch {unset cflist_top}
1201 $cflist conf -state disabled
1202 set difffilestart {}
1205 proc highlight_tag {f} {
1206 global highlight_paths
1208 foreach p $highlight_paths {
1209 if {[string match $p $f]} {
1216 proc highlight_filelist {} {
1217 global cmitmode cflist
1219 $cflist conf -state normal
1220 if {$cmitmode ne "tree"} {
1221 set end [lindex [split [$cflist index end] .] 0]
1222 for {set l 2} {$l < $end} {incr l} {
1223 set line [$cflist get $l.0 "$l.0 lineend"]
1224 if {[highlight_tag $line] ne {}} {
1225 $cflist tag add bold $l.0 "$l.0 lineend"
1231 $cflist conf -state disabled
1234 proc unhighlight_filelist {} {
1237 $cflist conf -state normal
1238 $cflist tag remove bold 1.0 end
1239 $cflist conf -state disabled
1242 proc add_flist {fl} {
1245 $cflist conf -state normal
1247 $cflist insert end "\n"
1248 $cflist insert end $f [highlight_tag $f]
1250 $cflist conf -state disabled
1253 proc sel_flist {w x y} {
1254 global ctext difffilestart cflist cflist_top cmitmode
1256 if {$cmitmode eq "tree"} return
1257 if {![info exists cflist_top]} return
1258 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1259 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1260 $cflist tag add highlight $l.0 "$l.0 lineend"
1265 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1269 # Functions for adding and removing shell-type quoting
1271 proc shellquote {str} {
1272 if {![string match "*\['\"\\ \t]*" $str]} {
1275 if {![string match "*\['\"\\]*" $str]} {
1278 if {![string match "*'*" $str]} {
1281 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1284 proc shellarglist {l} {
1290 append str [shellquote $a]
1295 proc shelldequote {str} {
1300 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1301 append ret [string range $str $used end]
1302 set used [string length $str]
1305 set first [lindex $first 0]
1306 set ch [string index $str $first]
1307 if {$first > $used} {
1308 append ret [string range $str $used [expr {$first - 1}]]
1311 if {$ch eq " " || $ch eq "\t"} break
1314 set first [string first "'" $str $used]
1316 error "unmatched single-quote"
1318 append ret [string range $str $used [expr {$first - 1}]]
1323 if {$used >= [string length $str]} {
1324 error "trailing backslash"
1326 append ret [string index $str $used]
1331 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1332 error "unmatched double-quote"
1334 set first [lindex $first 0]
1335 set ch [string index $str $first]
1336 if {$first > $used} {
1337 append ret [string range $str $used [expr {$first - 1}]]
1340 if {$ch eq "\""} break
1342 append ret [string index $str $used]
1346 return [list $used $ret]
1349 proc shellsplit {str} {
1352 set str [string trimleft $str]
1353 if {$str eq {}} break
1354 set dq [shelldequote $str]
1355 set n [lindex $dq 0]
1356 set word [lindex $dq 1]
1357 set str [string range $str $n end]
1363 # Code to implement multiple views
1365 proc newview {ishighlight} {
1366 global nextviewnum newviewname newviewperm uifont newishighlight
1367 global newviewargs revtreeargs
1369 set newishighlight $ishighlight
1371 if {[winfo exists $top]} {
1375 set newviewname($nextviewnum) "View $nextviewnum"
1376 set newviewperm($nextviewnum) 0
1377 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1378 vieweditor $top $nextviewnum "Gitk view definition"
1383 global viewname viewperm newviewname newviewperm
1384 global viewargs newviewargs
1386 set top .gitkvedit-$curview
1387 if {[winfo exists $top]} {
1391 set newviewname($curview) $viewname($curview)
1392 set newviewperm($curview) $viewperm($curview)
1393 set newviewargs($curview) [shellarglist $viewargs($curview)]
1394 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1397 proc vieweditor {top n title} {
1398 global newviewname newviewperm viewfiles
1402 wm title $top $title
1403 label $top.nl -text "Name" -font $uifont
1404 entry $top.name -width 20 -textvariable newviewname($n)
1405 grid $top.nl $top.name -sticky w -pady 5
1406 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1407 grid $top.perm - -pady 5 -sticky w
1408 message $top.al -aspect 1000 -font $uifont \
1409 -text "Commits to include (arguments to git rev-list):"
1410 grid $top.al - -sticky w -pady 5
1411 entry $top.args -width 50 -textvariable newviewargs($n) \
1413 grid $top.args - -sticky ew -padx 5
1414 message $top.l -aspect 1000 -font $uifont \
1415 -text "Enter files and directories to include, one per line:"
1416 grid $top.l - -sticky w
1417 text $top.t -width 40 -height 10 -background white
1418 if {[info exists viewfiles($n)]} {
1419 foreach f $viewfiles($n) {
1420 $top.t insert end $f
1421 $top.t insert end "\n"
1423 $top.t delete {end - 1c} end
1424 $top.t mark set insert 0.0
1426 grid $top.t - -sticky ew -padx 5
1428 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1429 button $top.buts.can -text "Cancel" -command [list destroy $top]
1430 grid $top.buts.ok $top.buts.can
1431 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1432 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1433 grid $top.buts - -pady 10 -sticky ew
1437 proc doviewmenu {m first cmd op argv} {
1438 set nmenu [$m index end]
1439 for {set i $first} {$i <= $nmenu} {incr i} {
1440 if {[$m entrycget $i -command] eq $cmd} {
1441 eval $m $op $i $argv
1447 proc allviewmenus {n op args} {
1450 doviewmenu .bar.view 7 [list showview $n] $op $args
1451 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1454 proc newviewok {top n} {
1455 global nextviewnum newviewperm newviewname newishighlight
1456 global viewname viewfiles viewperm selectedview curview
1457 global viewargs newviewargs viewhlmenu
1460 set newargs [shellsplit $newviewargs($n)]
1462 error_popup "Error in commit selection arguments: $err"
1468 foreach f [split [$top.t get 0.0 end] "\n"] {
1469 set ft [string trim $f]
1474 if {![info exists viewfiles($n)]} {
1475 # creating a new view
1477 set viewname($n) $newviewname($n)
1478 set viewperm($n) $newviewperm($n)
1479 set viewfiles($n) $files
1480 set viewargs($n) $newargs
1482 if {!$newishighlight} {
1483 after idle showview $n
1485 after idle addvhighlight $n
1488 # editing an existing view
1489 set viewperm($n) $newviewperm($n)
1490 if {$newviewname($n) ne $viewname($n)} {
1491 set viewname($n) $newviewname($n)
1492 doviewmenu .bar.view 7 [list showview $n] \
1493 entryconf [list -label $viewname($n)]
1494 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1495 entryconf [list -label $viewname($n) -value $viewname($n)]
1497 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1498 set viewfiles($n) $files
1499 set viewargs($n) $newargs
1500 if {$curview == $n} {
1501 after idle updatecommits
1505 catch {destroy $top}
1509 global curview viewdata viewperm hlview selectedhlview
1511 if {$curview == 0} return
1512 if {[info exists hlview] && $hlview == $curview} {
1513 set selectedhlview None
1516 allviewmenus $curview delete
1517 set viewdata($curview) {}
1518 set viewperm($curview) 0
1522 proc addviewmenu {n} {
1523 global viewname viewhlmenu
1525 .bar.view add radiobutton -label $viewname($n) \
1526 -command [list showview $n] -variable selectedview -value $n
1527 $viewhlmenu add radiobutton -label $viewname($n) \
1528 -command [list addvhighlight $n] -variable selectedhlview
1531 proc flatten {var} {
1535 foreach i [array names $var] {
1536 lappend ret $i [set $var\($i\)]
1541 proc unflatten {var l} {
1551 global curview viewdata viewfiles
1552 global displayorder parentlist childlist rowidlist rowoffsets
1553 global colormap rowtextx commitrow nextcolor canvxmax
1554 global numcommits rowrangelist commitlisted idrowranges
1555 global selectedline currentid canv canvy0
1556 global matchinglines treediffs
1557 global pending_select phase
1558 global commitidx rowlaidout rowoptim linesegends
1559 global commfd nextupdate
1561 global vparentlist vchildlist vdisporder vcmitlisted
1562 global hlview selectedhlview
1564 if {$n == $curview} return
1566 if {[info exists selectedline]} {
1567 set selid $currentid
1568 set y [yc $selectedline]
1569 set ymax [lindex [$canv cget -scrollregion] 3]
1570 set span [$canv yview]
1571 set ytop [expr {[lindex $span 0] * $ymax}]
1572 set ybot [expr {[lindex $span 1] * $ymax}]
1573 if {$ytop < $y && $y < $ybot} {
1574 set yscreen [expr {$y - $ytop}]
1576 set yscreen [expr {($ybot - $ytop) / 2}]
1582 if {$curview >= 0} {
1583 set vparentlist($curview) $parentlist
1584 set vchildlist($curview) $childlist
1585 set vdisporder($curview) $displayorder
1586 set vcmitlisted($curview) $commitlisted
1588 set viewdata($curview) \
1589 [list $phase $rowidlist $rowoffsets $rowrangelist \
1590 [flatten idrowranges] [flatten idinlist] \
1591 $rowlaidout $rowoptim $numcommits $linesegends]
1592 } elseif {![info exists viewdata($curview)]
1593 || [lindex $viewdata($curview) 0] ne {}} {
1594 set viewdata($curview) \
1595 [list {} $rowidlist $rowoffsets $rowrangelist]
1598 catch {unset matchinglines}
1599 catch {unset treediffs}
1601 if {[info exists hlview] && $hlview == $n} {
1603 set selectedhlview None
1608 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1609 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1611 if {![info exists viewdata($n)]} {
1612 set pending_select $selid
1618 set phase [lindex $v 0]
1619 set displayorder $vdisporder($n)
1620 set parentlist $vparentlist($n)
1621 set childlist $vchildlist($n)
1622 set commitlisted $vcmitlisted($n)
1623 set rowidlist [lindex $v 1]
1624 set rowoffsets [lindex $v 2]
1625 set rowrangelist [lindex $v 3]
1627 set numcommits [llength $displayorder]
1628 catch {unset idrowranges}
1630 unflatten idrowranges [lindex $v 4]
1631 unflatten idinlist [lindex $v 5]
1632 set rowlaidout [lindex $v 6]
1633 set rowoptim [lindex $v 7]
1634 set numcommits [lindex $v 8]
1635 set linesegends [lindex $v 9]
1638 catch {unset colormap}
1639 catch {unset rowtextx}
1641 set canvxmax [$canv cget -width]
1647 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1648 set row $commitrow($n,$selid)
1649 # try to get the selected row in the same position on the screen
1650 set ymax [lindex [$canv cget -scrollregion] 3]
1651 set ytop [expr {[yc $row] - $yscreen}]
1655 set yf [expr {$ytop * 1.0 / $ymax}]
1657 allcanvs yview moveto $yf
1661 if {$phase eq "getcommits"} {
1662 show_status "Reading commits..."
1664 if {[info exists commfd($n)]} {
1669 } elseif {$numcommits == 0} {
1670 show_status "No commits selected"
1674 # Stuff relating to the highlighting facility
1676 proc ishighlighted {row} {
1677 global vhighlights fhighlights nhighlights rhighlights
1679 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1680 return $nhighlights($row)
1682 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1683 return $vhighlights($row)
1685 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1686 return $fhighlights($row)
1688 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1689 return $rhighlights($row)
1694 proc bolden {row font} {
1695 global canv linehtag selectedline boldrows
1697 lappend boldrows $row
1698 $canv itemconf $linehtag($row) -font $font
1699 if {[info exists selectedline] && $row == $selectedline} {
1701 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1702 -outline {{}} -tags secsel \
1703 -fill [$canv cget -selectbackground]]
1708 proc bolden_name {row font} {
1709 global canv2 linentag selectedline boldnamerows
1711 lappend boldnamerows $row
1712 $canv2 itemconf $linentag($row) -font $font
1713 if {[info exists selectedline] && $row == $selectedline} {
1714 $canv2 delete secsel
1715 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1716 -outline {{}} -tags secsel \
1717 -fill [$canv2 cget -selectbackground]]
1723 global mainfont boldrows
1726 foreach row $boldrows {
1727 if {![ishighlighted $row]} {
1728 bolden $row $mainfont
1730 lappend stillbold $row
1733 set boldrows $stillbold
1736 proc addvhighlight {n} {
1737 global hlview curview viewdata vhl_done vhighlights commitidx
1739 if {[info exists hlview]} {
1743 if {$n != $curview && ![info exists viewdata($n)]} {
1744 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1745 set vparentlist($n) {}
1746 set vchildlist($n) {}
1747 set vdisporder($n) {}
1748 set vcmitlisted($n) {}
1751 set vhl_done $commitidx($hlview)
1752 if {$vhl_done > 0} {
1757 proc delvhighlight {} {
1758 global hlview vhighlights
1760 if {![info exists hlview]} return
1762 catch {unset vhighlights}
1766 proc vhighlightmore {} {
1767 global hlview vhl_done commitidx vhighlights
1768 global displayorder vdisporder curview mainfont
1770 set font [concat $mainfont bold]
1771 set max $commitidx($hlview)
1772 if {$hlview == $curview} {
1773 set disp $displayorder
1775 set disp $vdisporder($hlview)
1777 set vr [visiblerows]
1778 set r0 [lindex $vr 0]
1779 set r1 [lindex $vr 1]
1780 for {set i $vhl_done} {$i < $max} {incr i} {
1781 set id [lindex $disp $i]
1782 if {[info exists commitrow($curview,$id)]} {
1783 set row $commitrow($curview,$id)
1784 if {$r0 <= $row && $row <= $r1} {
1785 if {![highlighted $row]} {
1788 set vhighlights($row) 1
1795 proc askvhighlight {row id} {
1796 global hlview vhighlights commitrow iddrawn mainfont
1798 if {[info exists commitrow($hlview,$id)]} {
1799 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1800 bolden $row [concat $mainfont bold]
1802 set vhighlights($row) 1
1804 set vhighlights($row) 0
1808 proc hfiles_change {name ix op} {
1809 global highlight_files filehighlight fhighlights fh_serial
1810 global mainfont highlight_paths
1812 if {[info exists filehighlight]} {
1813 # delete previous highlights
1814 catch {close $filehighlight}
1816 catch {unset fhighlights}
1818 unhighlight_filelist
1820 set highlight_paths {}
1821 after cancel do_file_hl $fh_serial
1823 if {$highlight_files ne {}} {
1824 after 300 do_file_hl $fh_serial
1828 proc makepatterns {l} {
1831 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1832 if {[string index $ee end] eq "/"} {
1842 proc do_file_hl {serial} {
1843 global highlight_files filehighlight highlight_paths gdttype fhl_list
1845 if {$gdttype eq "touching paths:"} {
1846 if {[catch {set paths [shellsplit $highlight_files]}]} return
1847 set highlight_paths [makepatterns $paths]
1849 set gdtargs [concat -- $paths]
1851 set gdtargs [list "-S$highlight_files"]
1853 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1854 set filehighlight [open $cmd r+]
1855 fconfigure $filehighlight -blocking 0
1856 fileevent $filehighlight readable readfhighlight
1862 proc flushhighlights {} {
1863 global filehighlight fhl_list
1865 if {[info exists filehighlight]} {
1867 puts $filehighlight ""
1868 flush $filehighlight
1872 proc askfilehighlight {row id} {
1873 global filehighlight fhighlights fhl_list
1875 lappend fhl_list $id
1876 set fhighlights($row) -1
1877 puts $filehighlight $id
1880 proc readfhighlight {} {
1881 global filehighlight fhighlights commitrow curview mainfont iddrawn
1884 while {[gets $filehighlight line] >= 0} {
1885 set line [string trim $line]
1886 set i [lsearch -exact $fhl_list $line]
1887 if {$i < 0} continue
1888 for {set j 0} {$j < $i} {incr j} {
1889 set id [lindex $fhl_list $j]
1890 if {[info exists commitrow($curview,$id)]} {
1891 set fhighlights($commitrow($curview,$id)) 0
1894 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1895 if {$line eq {}} continue
1896 if {![info exists commitrow($curview,$line)]} continue
1897 set row $commitrow($curview,$line)
1898 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1899 bolden $row [concat $mainfont bold]
1901 set fhighlights($row) 1
1903 if {[eof $filehighlight]} {
1905 puts "oops, git-diff-tree died"
1906 catch {close $filehighlight}
1912 proc find_change {name ix op} {
1913 global nhighlights mainfont boldnamerows
1914 global findstring findpattern findtype
1916 # delete previous highlights, if any
1917 foreach row $boldnamerows {
1918 bolden_name $row $mainfont
1921 catch {unset nhighlights}
1923 if {$findtype ne "Regexp"} {
1924 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1926 set findpattern "*$e*"
1931 proc askfindhighlight {row id} {
1932 global nhighlights commitinfo iddrawn mainfont
1933 global findstring findtype findloc findpattern
1935 if {![info exists commitinfo($id)]} {
1938 set info $commitinfo($id)
1940 set fldtypes {Headline Author Date Committer CDate Comments}
1941 foreach f $info ty $fldtypes {
1942 if {$findloc ne "All fields" && $findloc ne $ty} {
1945 if {$findtype eq "Regexp"} {
1946 set doesmatch [regexp $findstring $f]
1947 } elseif {$findtype eq "IgnCase"} {
1948 set doesmatch [string match -nocase $findpattern $f]
1950 set doesmatch [string match $findpattern $f]
1953 if {$ty eq "Author"} {
1960 if {[info exists iddrawn($id)]} {
1961 if {$isbold && ![ishighlighted $row]} {
1962 bolden $row [concat $mainfont bold]
1965 bolden_name $row [concat $mainfont bold]
1968 set nhighlights($row) $isbold
1971 proc vrel_change {name ix op} {
1972 global highlight_related
1975 if {$highlight_related ne "None"} {
1976 after idle drawvisible
1980 # prepare for testing whether commits are descendents or ancestors of a
1981 proc rhighlight_sel {a} {
1982 global descendent desc_todo ancestor anc_todo
1983 global highlight_related rhighlights
1985 catch {unset descendent}
1986 set desc_todo [list $a]
1987 catch {unset ancestor}
1988 set anc_todo [list $a]
1989 if {$highlight_related ne "None"} {
1991 after idle drawvisible
1995 proc rhighlight_none {} {
1998 catch {unset rhighlights}
2002 proc is_descendent {a} {
2003 global curview children commitrow descendent desc_todo
2006 set la $commitrow($v,$a)
2010 for {set i 0} {$i < [llength $todo]} {incr i} {
2011 set do [lindex $todo $i]
2012 if {$commitrow($v,$do) < $la} {
2013 lappend leftover $do
2016 foreach nk $children($v,$do) {
2017 if {![info exists descendent($nk)]} {
2018 set descendent($nk) 1
2026 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2030 set descendent($a) 0
2031 set desc_todo $leftover
2034 proc is_ancestor {a} {
2035 global curview parentlist commitrow ancestor anc_todo
2038 set la $commitrow($v,$a)
2042 for {set i 0} {$i < [llength $todo]} {incr i} {
2043 set do [lindex $todo $i]
2044 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2045 lappend leftover $do
2048 foreach np [lindex $parentlist $commitrow($v,$do)] {
2049 if {![info exists ancestor($np)]} {
2058 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2063 set anc_todo $leftover
2066 proc askrelhighlight {row id} {
2067 global descendent highlight_related iddrawn mainfont rhighlights
2068 global selectedline ancestor
2070 if {![info exists selectedline]} return
2072 if {$highlight_related eq "Descendent" ||
2073 $highlight_related eq "Not descendent"} {
2074 if {![info exists descendent($id)]} {
2077 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2080 } elseif {$highlight_related eq "Ancestor" ||
2081 $highlight_related eq "Not ancestor"} {
2082 if {![info exists ancestor($id)]} {
2085 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2089 if {[info exists iddrawn($id)]} {
2090 if {$isbold && ![ishighlighted $row]} {
2091 bolden $row [concat $mainfont bold]
2094 set rhighlights($row) $isbold
2097 proc next_hlcont {} {
2098 global fhl_row fhl_dirn displayorder numcommits
2099 global vhighlights fhighlights nhighlights rhighlights
2100 global hlview filehighlight findstring highlight_related
2102 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2105 if {$row < 0 || $row >= $numcommits} {
2110 set id [lindex $displayorder $row]
2111 if {[info exists hlview]} {
2112 if {![info exists vhighlights($row)]} {
2113 askvhighlight $row $id
2115 if {$vhighlights($row) > 0} break
2117 if {$findstring ne {}} {
2118 if {![info exists nhighlights($row)]} {
2119 askfindhighlight $row $id
2121 if {$nhighlights($row) > 0} break
2123 if {$highlight_related ne "None"} {
2124 if {![info exists rhighlights($row)]} {
2125 askrelhighlight $row $id
2127 if {$rhighlights($row) > 0} break
2129 if {[info exists filehighlight]} {
2130 if {![info exists fhighlights($row)]} {
2131 # ask for a few more while we're at it...
2133 for {set n 0} {$n < 100} {incr n} {
2134 if {![info exists fhighlights($r)]} {
2135 askfilehighlight $r [lindex $displayorder $r]
2138 if {$r < 0 || $r >= $numcommits} break
2142 if {$fhighlights($row) < 0} {
2146 if {$fhighlights($row) > 0} break
2154 proc next_highlight {dirn} {
2155 global selectedline fhl_row fhl_dirn
2156 global hlview filehighlight findstring highlight_related
2158 if {![info exists selectedline]} return
2159 if {!([info exists hlview] || $findstring ne {} ||
2160 $highlight_related ne "None" || [info exists filehighlight])} return
2161 set fhl_row [expr {$selectedline + $dirn}]
2166 proc cancel_next_highlight {} {
2172 # Graph layout functions
2174 proc shortids {ids} {
2177 if {[llength $id] > 1} {
2178 lappend res [shortids $id]
2179 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2180 lappend res [string range $id 0 7]
2188 proc incrange {l x o} {
2191 set e [lindex $l $x]
2193 lset l $x [expr {$e + $o}]
2202 for {} {$n > 0} {incr n -1} {
2208 proc usedinrange {id l1 l2} {
2209 global children commitrow childlist curview
2211 if {[info exists commitrow($curview,$id)]} {
2212 set r $commitrow($curview,$id)
2213 if {$l1 <= $r && $r <= $l2} {
2214 return [expr {$r - $l1 + 1}]
2216 set kids [lindex $childlist $r]
2218 set kids $children($curview,$id)
2221 set r $commitrow($curview,$c)
2222 if {$l1 <= $r && $r <= $l2} {
2223 return [expr {$r - $l1 + 1}]
2229 proc sanity {row {full 0}} {
2230 global rowidlist rowoffsets
2233 set ids [lindex $rowidlist $row]
2236 if {$id eq {}} continue
2237 if {$col < [llength $ids] - 1 &&
2238 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2239 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2241 set o [lindex $rowoffsets $row $col]
2247 if {[lindex $rowidlist $y $x] != $id} {
2248 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2249 puts " id=[shortids $id] check started at row $row"
2250 for {set i $row} {$i >= $y} {incr i -1} {
2251 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2256 set o [lindex $rowoffsets $y $x]
2261 proc makeuparrow {oid x y z} {
2262 global rowidlist rowoffsets uparrowlen idrowranges
2264 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2267 set off0 [lindex $rowoffsets $y]
2268 for {set x0 $x} {1} {incr x0} {
2269 if {$x0 >= [llength $off0]} {
2270 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2273 set z [lindex $off0 $x0]
2279 set z [expr {$x0 - $x}]
2280 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2281 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2283 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2284 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2285 lappend idrowranges($oid) $y
2288 proc initlayout {} {
2289 global rowidlist rowoffsets displayorder commitlisted
2290 global rowlaidout rowoptim
2291 global idinlist rowchk rowrangelist idrowranges
2292 global numcommits canvxmax canv
2294 global parentlist childlist children
2295 global colormap rowtextx
2307 catch {unset idinlist}
2308 catch {unset rowchk}
2311 set canvxmax [$canv cget -width]
2312 catch {unset colormap}
2313 catch {unset rowtextx}
2314 catch {unset idrowranges}
2318 proc setcanvscroll {} {
2319 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2321 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2322 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2323 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2324 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2327 proc visiblerows {} {
2328 global canv numcommits linespc
2330 set ymax [lindex [$canv cget -scrollregion] 3]
2331 if {$ymax eq {} || $ymax == 0} return
2333 set y0 [expr {int([lindex $f 0] * $ymax)}]
2334 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2338 set y1 [expr {int([lindex $f 1] * $ymax)}]
2339 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2340 if {$r1 >= $numcommits} {
2341 set r1 [expr {$numcommits - 1}]
2343 return [list $r0 $r1]
2346 proc layoutmore {} {
2347 global rowlaidout rowoptim commitidx numcommits optim_delay
2348 global uparrowlen curview
2351 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2352 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2353 if {$orow > $rowoptim} {
2354 optimize_rows $rowoptim 0 $orow
2357 set canshow [expr {$rowoptim - $optim_delay}]
2358 if {$canshow > $numcommits} {
2363 proc showstuff {canshow} {
2364 global numcommits commitrow pending_select selectedline
2365 global linesegends idrowranges idrangedrawn curview
2367 if {$numcommits == 0} {
2369 set phase "incrdraw"
2373 set numcommits $canshow
2375 set rows [visiblerows]
2376 set r0 [lindex $rows 0]
2377 set r1 [lindex $rows 1]
2379 for {set r $row} {$r < $canshow} {incr r} {
2380 foreach id [lindex $linesegends [expr {$r+1}]] {
2382 foreach {s e} [rowranges $id] {
2384 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2385 && ![info exists idrangedrawn($id,$i)]} {
2387 set idrangedrawn($id,$i) 1
2392 if {$canshow > $r1} {
2395 while {$row < $canshow} {
2399 if {[info exists pending_select] &&
2400 [info exists commitrow($curview,$pending_select)] &&
2401 $commitrow($curview,$pending_select) < $numcommits} {
2402 selectline $commitrow($curview,$pending_select) 1
2404 if {![info exists selectedline] && ![info exists pending_select]} {
2409 proc layoutrows {row endrow last} {
2410 global rowidlist rowoffsets displayorder
2411 global uparrowlen downarrowlen maxwidth mingaplen
2412 global childlist parentlist
2413 global idrowranges linesegends
2414 global commitidx curview
2415 global idinlist rowchk rowrangelist
2417 set idlist [lindex $rowidlist $row]
2418 set offs [lindex $rowoffsets $row]
2419 while {$row < $endrow} {
2420 set id [lindex $displayorder $row]
2423 foreach p [lindex $parentlist $row] {
2424 if {![info exists idinlist($p)]} {
2426 } elseif {!$idinlist($p)} {
2431 set nev [expr {[llength $idlist] + [llength $newolds]
2432 + [llength $oldolds] - $maxwidth + 1}]
2435 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2436 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2437 set i [lindex $idlist $x]
2438 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2439 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2440 [expr {$row + $uparrowlen + $mingaplen}]]
2442 set idlist [lreplace $idlist $x $x]
2443 set offs [lreplace $offs $x $x]
2444 set offs [incrange $offs $x 1]
2446 set rm1 [expr {$row - 1}]
2448 lappend idrowranges($i) $rm1
2449 if {[incr nev -1] <= 0} break
2452 set rowchk($id) [expr {$row + $r}]
2455 lset rowidlist $row $idlist
2456 lset rowoffsets $row $offs
2458 lappend linesegends $lse
2459 set col [lsearch -exact $idlist $id]
2461 set col [llength $idlist]
2463 lset rowidlist $row $idlist
2465 if {[lindex $childlist $row] ne {}} {
2466 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2470 lset rowoffsets $row $offs
2472 makeuparrow $id $col $row $z
2478 if {[info exists idrowranges($id)]} {
2479 set ranges $idrowranges($id)
2481 unset idrowranges($id)
2483 lappend rowrangelist $ranges
2485 set offs [ntimes [llength $idlist] 0]
2486 set l [llength $newolds]
2487 set idlist [eval lreplace \$idlist $col $col $newolds]
2490 set offs [lrange $offs 0 [expr {$col - 1}]]
2491 foreach x $newolds {
2496 set tmp [expr {[llength $idlist] - [llength $offs]}]
2498 set offs [concat $offs [ntimes $tmp $o]]
2503 foreach i $newolds {
2505 set idrowranges($i) $row
2508 foreach oid $oldolds {
2509 set idinlist($oid) 1
2510 set idlist [linsert $idlist $col $oid]
2511 set offs [linsert $offs $col $o]
2512 makeuparrow $oid $col $row $o
2515 lappend rowidlist $idlist
2516 lappend rowoffsets $offs
2521 proc addextraid {id row} {
2522 global displayorder commitrow commitinfo
2523 global commitidx commitlisted
2524 global parentlist childlist children curview
2526 incr commitidx($curview)
2527 lappend displayorder $id
2528 lappend commitlisted 0
2529 lappend parentlist {}
2530 set commitrow($curview,$id) $row
2532 if {![info exists commitinfo($id)]} {
2533 set commitinfo($id) {"No commit information available"}
2535 if {![info exists children($curview,$id)]} {
2536 set children($curview,$id) {}
2538 lappend childlist $children($curview,$id)
2541 proc layouttail {} {
2542 global rowidlist rowoffsets idinlist commitidx curview
2543 global idrowranges rowrangelist
2545 set row $commitidx($curview)
2546 set idlist [lindex $rowidlist $row]
2547 while {$idlist ne {}} {
2548 set col [expr {[llength $idlist] - 1}]
2549 set id [lindex $idlist $col]
2552 lappend idrowranges($id) $row
2553 lappend rowrangelist $idrowranges($id)
2554 unset idrowranges($id)
2556 set offs [ntimes $col 0]
2557 set idlist [lreplace $idlist $col $col]
2558 lappend rowidlist $idlist
2559 lappend rowoffsets $offs
2562 foreach id [array names idinlist] {
2564 lset rowidlist $row [list $id]
2565 lset rowoffsets $row 0
2566 makeuparrow $id 0 $row 0
2567 lappend idrowranges($id) $row
2568 lappend rowrangelist $idrowranges($id)
2569 unset idrowranges($id)
2571 lappend rowidlist {}
2572 lappend rowoffsets {}
2576 proc insert_pad {row col npad} {
2577 global rowidlist rowoffsets
2579 set pad [ntimes $npad {}]
2580 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2581 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2582 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2585 proc optimize_rows {row col endrow} {
2586 global rowidlist rowoffsets idrowranges displayorder
2588 for {} {$row < $endrow} {incr row} {
2589 set idlist [lindex $rowidlist $row]
2590 set offs [lindex $rowoffsets $row]
2592 for {} {$col < [llength $offs]} {incr col} {
2593 if {[lindex $idlist $col] eq {}} {
2597 set z [lindex $offs $col]
2598 if {$z eq {}} continue
2600 set x0 [expr {$col + $z}]
2601 set y0 [expr {$row - 1}]
2602 set z0 [lindex $rowoffsets $y0 $x0]
2604 set id [lindex $idlist $col]
2605 set ranges [rowranges $id]
2606 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2610 if {$z < -1 || ($z < 0 && $isarrow)} {
2611 set npad [expr {-1 - $z + $isarrow}]
2612 set offs [incrange $offs $col $npad]
2613 insert_pad $y0 $x0 $npad
2615 optimize_rows $y0 $x0 $row
2617 set z [lindex $offs $col]
2618 set x0 [expr {$col + $z}]
2619 set z0 [lindex $rowoffsets $y0 $x0]
2620 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2621 set npad [expr {$z - 1 + $isarrow}]
2622 set y1 [expr {$row + 1}]
2623 set offs2 [lindex $rowoffsets $y1]
2627 if {$z eq {} || $x1 + $z < $col} continue
2628 if {$x1 + $z > $col} {
2631 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2634 set pad [ntimes $npad {}]
2635 set idlist [eval linsert \$idlist $col $pad]
2636 set tmp [eval linsert \$offs $col $pad]
2638 set offs [incrange $tmp $col [expr {-$npad}]]
2639 set z [lindex $offs $col]
2642 if {$z0 eq {} && !$isarrow} {
2643 # this line links to its first child on row $row-2
2644 set rm2 [expr {$row - 2}]
2645 set id [lindex $displayorder $rm2]
2646 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2648 set z0 [expr {$xc - $x0}]
2651 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2652 insert_pad $y0 $x0 1
2653 set offs [incrange $offs $col 1]
2654 optimize_rows $y0 [expr {$x0 + 1}] $row
2659 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2660 set o [lindex $offs $col]
2662 # check if this is the link to the first child
2663 set id [lindex $idlist $col]
2664 set ranges [rowranges $id]
2665 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2666 # it is, work out offset to child
2667 set y0 [expr {$row - 1}]
2668 set id [lindex $displayorder $y0]
2669 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2671 set o [expr {$x0 - $col}]
2675 if {$o eq {} || $o <= 0} break
2677 if {$o ne {} && [incr col] < [llength $idlist]} {
2678 set y1 [expr {$row + 1}]
2679 set offs2 [lindex $rowoffsets $y1]
2683 if {$z eq {} || $x1 + $z < $col} continue
2684 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2687 set idlist [linsert $idlist $col {}]
2688 set tmp [linsert $offs $col {}]
2690 set offs [incrange $tmp $col -1]
2693 lset rowidlist $row $idlist
2694 lset rowoffsets $row $offs
2700 global canvx0 linespc
2701 return [expr {$canvx0 + $col * $linespc}]
2705 global canvy0 linespc
2706 return [expr {$canvy0 + $row * $linespc}]
2709 proc linewidth {id} {
2710 global thickerline lthickness
2713 if {[info exists thickerline] && $id eq $thickerline} {
2714 set wid [expr {2 * $lthickness}]
2719 proc rowranges {id} {
2720 global phase idrowranges commitrow rowlaidout rowrangelist curview
2724 ([info exists commitrow($curview,$id)]
2725 && $commitrow($curview,$id) < $rowlaidout)} {
2726 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2727 } elseif {[info exists idrowranges($id)]} {
2728 set ranges $idrowranges($id)
2733 proc drawlineseg {id i} {
2734 global rowoffsets rowidlist
2736 global canv colormap linespc
2737 global numcommits commitrow curview
2739 set ranges [rowranges $id]
2741 if {[info exists commitrow($curview,$id)]
2742 && $commitrow($curview,$id) < $numcommits} {
2743 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2747 set startrow [lindex $ranges [expr {2 * $i}]]
2748 set row [lindex $ranges [expr {2 * $i + 1}]]
2749 if {$startrow == $row} return
2752 set col [lsearch -exact [lindex $rowidlist $row] $id]
2754 puts "oops: drawline: id $id not on row $row"
2760 set o [lindex $rowoffsets $row $col]
2763 # changing direction
2764 set x [xc $row $col]
2766 lappend coords $x $y
2772 set x [xc $row $col]
2774 lappend coords $x $y
2776 # draw the link to the first child as part of this line
2778 set child [lindex $displayorder $row]
2779 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2781 set x [xc $row $ccol]
2783 if {$ccol < $col - 1} {
2784 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2785 } elseif {$ccol > $col + 1} {
2786 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2788 lappend coords $x $y
2791 if {[llength $coords] < 4} return
2793 # This line has an arrow at the lower end: check if the arrow is
2794 # on a diagonal segment, and if so, work around the Tk 8.4
2795 # refusal to draw arrows on diagonal lines.
2796 set x0 [lindex $coords 0]
2797 set x1 [lindex $coords 2]
2799 set y0 [lindex $coords 1]
2800 set y1 [lindex $coords 3]
2801 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2802 # we have a nearby vertical segment, just trim off the diag bit
2803 set coords [lrange $coords 2 end]
2805 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2806 set xi [expr {$x0 - $slope * $linespc / 2}]
2807 set yi [expr {$y0 - $linespc / 2}]
2808 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2812 set arrow [expr {2 * ($i > 0) + $downarrow}]
2813 set arrow [lindex {none first last both} $arrow]
2814 set t [$canv create line $coords -width [linewidth $id] \
2815 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2820 proc drawparentlinks {id row col olds} {
2821 global rowidlist canv colormap
2823 set row2 [expr {$row + 1}]
2824 set x [xc $row $col]
2827 set ids [lindex $rowidlist $row2]
2828 # rmx = right-most X coord used
2831 set i [lsearch -exact $ids $p]
2833 puts "oops, parent $p of $id not in list"
2836 set x2 [xc $row2 $i]
2840 set ranges [rowranges $p]
2841 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2842 && $row2 < [lindex $ranges 1]} {
2843 # drawlineseg will do this one for us
2847 # should handle duplicated parents here...
2848 set coords [list $x $y]
2849 if {$i < $col - 1} {
2850 lappend coords [xc $row [expr {$i + 1}]] $y
2851 } elseif {$i > $col + 1} {
2852 lappend coords [xc $row [expr {$i - 1}]] $y
2854 lappend coords $x2 $y2
2855 set t [$canv create line $coords -width [linewidth $p] \
2856 -fill $colormap($p) -tags lines.$p]
2863 proc drawlines {id} {
2864 global colormap canv
2866 global children iddrawn commitrow rowidlist curview
2868 $canv delete lines.$id
2869 set nr [expr {[llength [rowranges $id]] / 2}]
2870 for {set i 0} {$i < $nr} {incr i} {
2871 if {[info exists idrangedrawn($id,$i)]} {
2875 foreach child $children($curview,$id) {
2876 if {[info exists iddrawn($child)]} {
2877 set row $commitrow($curview,$child)
2878 set col [lsearch -exact [lindex $rowidlist $row] $child]
2880 drawparentlinks $child $row $col [list $id]
2886 proc drawcmittext {id row col rmx} {
2887 global linespc canv canv2 canv3 canvy0 fgcolor
2888 global commitlisted commitinfo rowidlist
2889 global rowtextx idpos idtags idheads idotherrefs
2890 global linehtag linentag linedtag
2891 global mainfont canvxmax boldrows boldnamerows fgcolor
2893 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2894 set x [xc $row $col]
2896 set orad [expr {$linespc / 3}]
2897 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2898 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2899 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2901 $canv bind $t <1> {selcanvline {} %x %y}
2902 set xt [xc $row [llength [lindex $rowidlist $row]]]
2906 set rowtextx($row) $xt
2907 set idpos($id) [list $x $xt $y]
2908 if {[info exists idtags($id)] || [info exists idheads($id)]
2909 || [info exists idotherrefs($id)]} {
2910 set xt [drawtags $id $x $xt $y]
2912 set headline [lindex $commitinfo($id) 0]
2913 set name [lindex $commitinfo($id) 1]
2914 set date [lindex $commitinfo($id) 2]
2915 set date [formatdate $date]
2918 set isbold [ishighlighted $row]
2920 lappend boldrows $row
2923 lappend boldnamerows $row
2927 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2928 -text $headline -font $font -tags text]
2929 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2930 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2931 -text $name -font $nfont -tags text]
2932 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2933 -text $date -font $mainfont -tags text]
2934 set xr [expr {$xt + [font measure $mainfont $headline]}]
2935 if {$xr > $canvxmax} {
2941 proc drawcmitrow {row} {
2942 global displayorder rowidlist
2943 global idrangedrawn iddrawn
2944 global commitinfo parentlist numcommits
2945 global filehighlight fhighlights findstring nhighlights
2946 global hlview vhighlights
2947 global highlight_related rhighlights
2949 if {$row >= $numcommits} return
2950 foreach id [lindex $rowidlist $row] {
2951 if {$id eq {}} continue
2953 foreach {s e} [rowranges $id] {
2955 if {$row < $s} continue
2958 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2960 set idrangedrawn($id,$i) 1
2967 set id [lindex $displayorder $row]
2968 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2969 askvhighlight $row $id
2971 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2972 askfilehighlight $row $id
2974 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2975 askfindhighlight $row $id
2977 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2978 askrelhighlight $row $id
2980 if {[info exists iddrawn($id)]} return
2981 set col [lsearch -exact [lindex $rowidlist $row] $id]
2983 puts "oops, row $row id $id not in list"
2986 if {![info exists commitinfo($id)]} {
2990 set olds [lindex $parentlist $row]
2992 set rmx [drawparentlinks $id $row $col $olds]
2996 drawcmittext $id $row $col $rmx
3000 proc drawfrac {f0 f1} {
3001 global numcommits canv
3004 set ymax [lindex [$canv cget -scrollregion] 3]
3005 if {$ymax eq {} || $ymax == 0} return
3006 set y0 [expr {int($f0 * $ymax)}]
3007 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3011 set y1 [expr {int($f1 * $ymax)}]
3012 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3013 if {$endrow >= $numcommits} {
3014 set endrow [expr {$numcommits - 1}]
3016 for {} {$row <= $endrow} {incr row} {
3021 proc drawvisible {} {
3023 eval drawfrac [$canv yview]
3026 proc clear_display {} {
3027 global iddrawn idrangedrawn
3028 global vhighlights fhighlights nhighlights rhighlights
3031 catch {unset iddrawn}
3032 catch {unset idrangedrawn}
3033 catch {unset vhighlights}
3034 catch {unset fhighlights}
3035 catch {unset nhighlights}
3036 catch {unset rhighlights}
3039 proc findcrossings {id} {
3040 global rowidlist parentlist numcommits rowoffsets displayorder
3044 foreach {s e} [rowranges $id] {
3045 if {$e >= $numcommits} {
3046 set e [expr {$numcommits - 1}]
3048 if {$e <= $s} continue
3049 set x [lsearch -exact [lindex $rowidlist $e] $id]
3051 puts "findcrossings: oops, no [shortids $id] in row $e"
3054 for {set row $e} {[incr row -1] >= $s} {} {
3055 set olds [lindex $parentlist $row]
3056 set kid [lindex $displayorder $row]
3057 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3058 if {$kidx < 0} continue
3059 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3061 set px [lsearch -exact $nextrow $p]
3062 if {$px < 0} continue
3063 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3064 if {[lsearch -exact $ccross $p] >= 0} continue
3065 if {$x == $px + ($kidx < $px? -1: 1)} {
3067 } elseif {[lsearch -exact $cross $p] < 0} {
3072 set inc [lindex $rowoffsets $row $x]
3073 if {$inc eq {}} break
3077 return [concat $ccross {{}} $cross]
3080 proc assigncolor {id} {
3081 global colormap colors nextcolor
3082 global commitrow parentlist children children curview
3084 if {[info exists colormap($id)]} return
3085 set ncolors [llength $colors]
3086 if {[info exists children($curview,$id)]} {
3087 set kids $children($curview,$id)
3091 if {[llength $kids] == 1} {
3092 set child [lindex $kids 0]
3093 if {[info exists colormap($child)]
3094 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3095 set colormap($id) $colormap($child)
3101 foreach x [findcrossings $id] {
3103 # delimiter between corner crossings and other crossings
3104 if {[llength $badcolors] >= $ncolors - 1} break
3105 set origbad $badcolors
3107 if {[info exists colormap($x)]
3108 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3109 lappend badcolors $colormap($x)
3112 if {[llength $badcolors] >= $ncolors} {
3113 set badcolors $origbad
3115 set origbad $badcolors
3116 if {[llength $badcolors] < $ncolors - 1} {
3117 foreach child $kids {
3118 if {[info exists colormap($child)]
3119 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3120 lappend badcolors $colormap($child)
3122 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3123 if {[info exists colormap($p)]
3124 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3125 lappend badcolors $colormap($p)
3129 if {[llength $badcolors] >= $ncolors} {
3130 set badcolors $origbad
3133 for {set i 0} {$i <= $ncolors} {incr i} {
3134 set c [lindex $colors $nextcolor]
3135 if {[incr nextcolor] >= $ncolors} {
3138 if {[lsearch -exact $badcolors $c]} break
3140 set colormap($id) $c
3143 proc bindline {t id} {
3146 $canv bind $t <Enter> "lineenter %x %y $id"
3147 $canv bind $t <Motion> "linemotion %x %y $id"
3148 $canv bind $t <Leave> "lineleave $id"
3149 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3152 proc drawtags {id x xt y1} {
3153 global idtags idheads idotherrefs
3154 global linespc lthickness
3155 global canv mainfont commitrow rowtextx curview fgcolor
3160 if {[info exists idtags($id)]} {
3161 set marks $idtags($id)
3162 set ntags [llength $marks]
3164 if {[info exists idheads($id)]} {
3165 set marks [concat $marks $idheads($id)]
3166 set nheads [llength $idheads($id)]
3168 if {[info exists idotherrefs($id)]} {
3169 set marks [concat $marks $idotherrefs($id)]
3175 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3176 set yt [expr {$y1 - 0.5 * $linespc}]
3177 set yb [expr {$yt + $linespc - 1}]
3180 foreach tag $marks {
3181 set wid [font measure $mainfont $tag]
3184 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3186 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3187 -width $lthickness -fill black -tags tag.$id]
3189 foreach tag $marks x $xvals wid $wvals {
3190 set xl [expr {$x + $delta}]
3191 set xr [expr {$x + $delta + $wid + $lthickness}]
3192 if {[incr ntags -1] >= 0} {
3194 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3195 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3196 -width 1 -outline black -fill yellow -tags tag.$id]
3197 $canv bind $t <1> [list showtag $tag 1]
3198 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3200 # draw a head or other ref
3201 if {[incr nheads -1] >= 0} {
3206 set xl [expr {$xl - $delta/2}]
3207 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3208 -width 1 -outline black -fill $col -tags tag.$id
3209 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3210 set rwid [font measure $mainfont $remoteprefix]
3211 set xi [expr {$x + 1}]
3212 set yti [expr {$yt + 1}]
3213 set xri [expr {$x + $rwid}]
3214 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3215 -width 0 -fill "#ffddaa" -tags tag.$id
3218 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3219 -font $mainfont -tags [list tag.$id text]]
3221 $canv bind $t <1> [list showtag $tag 1]
3227 proc xcoord {i level ln} {
3228 global canvx0 xspc1 xspc2
3230 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3231 if {$i > 0 && $i == $level} {
3232 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3233 } elseif {$i > $level} {
3234 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3239 proc show_status {msg} {
3240 global canv mainfont fgcolor
3243 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3244 -tags text -fill $fgcolor
3247 proc finishcommits {} {
3248 global commitidx phase curview
3249 global canv mainfont ctext maincursor textcursor
3250 global findinprogress pending_select
3252 if {$commitidx($curview) > 0} {
3255 show_status "No commits selected"
3258 catch {unset pending_select}
3261 # Don't change the text pane cursor if it is currently the hand cursor,
3262 # showing that we are over a sha1 ID link.
3263 proc settextcursor {c} {
3264 global ctext curtextcursor
3266 if {[$ctext cget -cursor] == $curtextcursor} {
3267 $ctext config -cursor $c
3269 set curtextcursor $c
3272 proc nowbusy {what} {
3275 if {[array names isbusy] eq {}} {
3276 . config -cursor watch
3282 proc notbusy {what} {
3283 global isbusy maincursor textcursor
3285 catch {unset isbusy($what)}
3286 if {[array names isbusy] eq {}} {
3287 . config -cursor $maincursor
3288 settextcursor $textcursor
3295 global canvy0 numcommits linespc
3296 global rowlaidout commitidx curview
3297 global pending_select
3300 layoutrows $rowlaidout $commitidx($curview) 1
3302 optimize_rows $row 0 $commitidx($curview)
3303 showstuff $commitidx($curview)
3304 if {[info exists pending_select]} {
3308 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3309 #puts "overall $drawmsecs ms for $numcommits commits"
3312 proc findmatches {f} {
3313 global findtype foundstring foundstrlen
3314 if {$findtype == "Regexp"} {
3315 set matches [regexp -indices -all -inline $foundstring $f]
3317 if {$findtype == "IgnCase"} {
3318 set str [string tolower $f]
3324 while {[set j [string first $foundstring $str $i]] >= 0} {
3325 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3326 set i [expr {$j + $foundstrlen}]
3333 global findtype findloc findstring markedmatches commitinfo
3334 global numcommits displayorder linehtag linentag linedtag
3335 global mainfont canv canv2 canv3 selectedline
3336 global matchinglines foundstring foundstrlen matchstring
3341 cancel_next_highlight
3343 set matchinglines {}
3344 if {$findtype == "IgnCase"} {
3345 set foundstring [string tolower $findstring]
3347 set foundstring $findstring
3349 set foundstrlen [string length $findstring]
3350 if {$foundstrlen == 0} return
3351 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3352 set matchstring "*$matchstring*"
3353 if {![info exists selectedline]} {
3356 set oldsel $selectedline
3359 set fldtypes {Headline Author Date Committer CDate Comments}
3361 foreach id $displayorder {
3362 set d $commitdata($id)
3364 if {$findtype == "Regexp"} {
3365 set doesmatch [regexp $foundstring $d]
3366 } elseif {$findtype == "IgnCase"} {
3367 set doesmatch [string match -nocase $matchstring $d]
3369 set doesmatch [string match $matchstring $d]
3371 if {!$doesmatch} continue
3372 if {![info exists commitinfo($id)]} {
3375 set info $commitinfo($id)
3377 foreach f $info ty $fldtypes {
3378 if {$findloc != "All fields" && $findloc != $ty} {
3381 set matches [findmatches $f]
3382 if {$matches == {}} continue
3384 if {$ty == "Headline"} {
3386 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3387 } elseif {$ty == "Author"} {
3389 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3390 } elseif {$ty == "Date"} {
3392 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3396 lappend matchinglines $l
3397 if {!$didsel && $l > $oldsel} {
3403 if {$matchinglines == {}} {
3405 } elseif {!$didsel} {
3406 findselectline [lindex $matchinglines 0]
3410 proc findselectline {l} {
3411 global findloc commentend ctext
3413 if {$findloc == "All fields" || $findloc == "Comments"} {
3414 # highlight the matches in the comments
3415 set f [$ctext get 1.0 $commentend]
3416 set matches [findmatches $f]
3417 foreach match $matches {
3418 set start [lindex $match 0]
3419 set end [expr {[lindex $match 1] + 1}]
3420 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3425 proc findnext {restart} {
3426 global matchinglines selectedline
3427 if {![info exists matchinglines]} {
3433 if {![info exists selectedline]} return
3434 foreach l $matchinglines {
3435 if {$l > $selectedline} {
3444 global matchinglines selectedline
3445 if {![info exists matchinglines]} {
3449 if {![info exists selectedline]} return
3451 foreach l $matchinglines {
3452 if {$l >= $selectedline} break
3456 findselectline $prev
3462 proc stopfindproc {{done 0}} {
3463 global findprocpid findprocfile findids
3464 global ctext findoldcursor phase maincursor textcursor
3465 global findinprogress
3467 catch {unset findids}
3468 if {[info exists findprocpid]} {
3470 catch {exec kill $findprocpid}
3472 catch {close $findprocfile}
3475 catch {unset findinprogress}
3479 # mark a commit as matching by putting a yellow background
3480 # behind the headline
3481 proc markheadline {l id} {
3482 global canv mainfont linehtag
3485 set bbox [$canv bbox $linehtag($l)]
3486 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3490 # mark the bits of a headline, author or date that match a find string
3491 proc markmatches {canv l str tag matches font} {
3492 set bbox [$canv bbox $tag]
3493 set x0 [lindex $bbox 0]
3494 set y0 [lindex $bbox 1]
3495 set y1 [lindex $bbox 3]
3496 foreach match $matches {
3497 set start [lindex $match 0]
3498 set end [lindex $match 1]
3499 if {$start > $end} continue
3500 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3501 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3502 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3503 [expr {$x0+$xlen+2}] $y1 \
3504 -outline {} -tags matches -fill yellow]
3509 proc unmarkmatches {} {
3510 global matchinglines findids
3511 allcanvs delete matches
3512 catch {unset matchinglines}
3513 catch {unset findids}
3516 proc selcanvline {w x y} {
3517 global canv canvy0 ctext linespc
3519 set ymax [lindex [$canv cget -scrollregion] 3]
3520 if {$ymax == {}} return
3521 set yfrac [lindex [$canv yview] 0]
3522 set y [expr {$y + $yfrac * $ymax}]
3523 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3528 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3534 proc commit_descriptor {p} {
3536 if {![info exists commitinfo($p)]} {
3540 if {[llength $commitinfo($p)] > 1} {
3541 set l [lindex $commitinfo($p) 0]
3546 # append some text to the ctext widget, and make any SHA1 ID
3547 # that we know about be a clickable link.
3548 proc appendwithlinks {text tags} {
3549 global ctext commitrow linknum curview
3551 set start [$ctext index "end - 1c"]
3552 $ctext insert end $text $tags
3553 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3557 set linkid [string range $text $s $e]
3558 if {![info exists commitrow($curview,$linkid)]} continue
3560 $ctext tag add link "$start + $s c" "$start + $e c"
3561 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3562 $ctext tag bind link$linknum <1> \
3563 [list selectline $commitrow($curview,$linkid) 1]
3566 $ctext tag conf link -foreground blue -underline 1
3567 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3568 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3571 proc viewnextline {dir} {
3575 set ymax [lindex [$canv cget -scrollregion] 3]
3576 set wnow [$canv yview]
3577 set wtop [expr {[lindex $wnow 0] * $ymax}]
3578 set newtop [expr {$wtop + $dir * $linespc}]
3581 } elseif {$newtop > $ymax} {
3584 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3587 # add a list of tag or branch names at position pos
3588 # returns the number of names inserted
3589 proc appendrefs {pos l var} {
3590 global ctext commitrow linknum curview idtags $var
3592 if {[catch {$ctext index $pos}]} {
3597 foreach tag [set $var\($id\)] {
3598 lappend tags [concat $tag $id]
3601 set tags [lsort -index 1 $tags]
3604 set name [lindex $tag 0]
3605 set id [lindex $tag 1]
3608 $ctext insert $pos $sep
3609 $ctext insert $pos $name $lk
3610 $ctext tag conf $lk -foreground blue
3611 if {[info exists commitrow($curview,$id)]} {
3612 $ctext tag bind $lk <1> \
3613 [list selectline $commitrow($curview,$id) 1]
3614 $ctext tag conf $lk -underline 1
3615 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3616 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3620 return [llength $tags]
3623 # called when we have finished computing the nearby tags
3624 proc dispneartags {} {
3625 global selectedline currentid ctext anc_tags desc_tags showneartags
3628 if {![info exists selectedline] || !$showneartags} return
3630 $ctext conf -state normal
3631 if {[info exists desc_heads($id)]} {
3632 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3633 $ctext insert "branch -2c" "es"
3636 if {[info exists anc_tags($id)]} {
3637 appendrefs follows $anc_tags($id) idtags
3639 if {[info exists desc_tags($id)]} {
3640 appendrefs precedes $desc_tags($id) idtags
3642 $ctext conf -state disabled
3645 proc selectline {l isnew} {
3646 global canv canv2 canv3 ctext commitinfo selectedline
3647 global displayorder linehtag linentag linedtag
3648 global canvy0 linespc parentlist childlist
3649 global currentid sha1entry
3650 global commentend idtags linknum
3651 global mergemax numcommits pending_select
3652 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3654 catch {unset pending_select}
3657 cancel_next_highlight
3658 if {$l < 0 || $l >= $numcommits} return
3659 set y [expr {$canvy0 + $l * $linespc}]
3660 set ymax [lindex [$canv cget -scrollregion] 3]
3661 set ytop [expr {$y - $linespc - 1}]
3662 set ybot [expr {$y + $linespc + 1}]
3663 set wnow [$canv yview]
3664 set wtop [expr {[lindex $wnow 0] * $ymax}]
3665 set wbot [expr {[lindex $wnow 1] * $ymax}]
3666 set wh [expr {$wbot - $wtop}]
3668 if {$ytop < $wtop} {
3669 if {$ybot < $wtop} {
3670 set newtop [expr {$y - $wh / 2.0}]
3673 if {$newtop > $wtop - $linespc} {
3674 set newtop [expr {$wtop - $linespc}]
3677 } elseif {$ybot > $wbot} {
3678 if {$ytop > $wbot} {
3679 set newtop [expr {$y - $wh / 2.0}]
3681 set newtop [expr {$ybot - $wh}]
3682 if {$newtop < $wtop + $linespc} {
3683 set newtop [expr {$wtop + $linespc}]
3687 if {$newtop != $wtop} {
3691 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3695 if {![info exists linehtag($l)]} return
3697 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3698 -tags secsel -fill [$canv cget -selectbackground]]
3700 $canv2 delete secsel
3701 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3702 -tags secsel -fill [$canv2 cget -selectbackground]]
3704 $canv3 delete secsel
3705 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3706 -tags secsel -fill [$canv3 cget -selectbackground]]
3710 addtohistory [list selectline $l 0]
3715 set id [lindex $displayorder $l]
3717 $sha1entry delete 0 end
3718 $sha1entry insert 0 $id
3719 $sha1entry selection from 0
3720 $sha1entry selection to end
3723 $ctext conf -state normal
3726 set info $commitinfo($id)
3727 set date [formatdate [lindex $info 2]]
3728 $ctext insert end "Author: [lindex $info 1] $date\n"
3729 set date [formatdate [lindex $info 4]]
3730 $ctext insert end "Committer: [lindex $info 3] $date\n"
3731 if {[info exists idtags($id)]} {
3732 $ctext insert end "Tags:"
3733 foreach tag $idtags($id) {
3734 $ctext insert end " $tag"
3736 $ctext insert end "\n"
3740 set olds [lindex $parentlist $l]
3741 if {[llength $olds] > 1} {
3744 if {$np >= $mergemax} {
3749 $ctext insert end "Parent: " $tag
3750 appendwithlinks [commit_descriptor $p] {}
3755 append headers "Parent: [commit_descriptor $p]"
3759 foreach c [lindex $childlist $l] {
3760 append headers "Child: [commit_descriptor $c]"
3763 # make anything that looks like a SHA1 ID be a clickable link
3764 appendwithlinks $headers {}
3765 if {$showneartags} {
3766 if {![info exists allcommits]} {
3769 $ctext insert end "Branch: "
3770 $ctext mark set branch "end -1c"
3771 $ctext mark gravity branch left
3772 if {[info exists desc_heads($id)]} {
3773 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3774 # turn "Branch" into "Branches"
3775 $ctext insert "branch -2c" "es"
3778 $ctext insert end "\nFollows: "
3779 $ctext mark set follows "end -1c"
3780 $ctext mark gravity follows left
3781 if {[info exists anc_tags($id)]} {
3782 appendrefs follows $anc_tags($id) idtags
3784 $ctext insert end "\nPrecedes: "
3785 $ctext mark set precedes "end -1c"
3786 $ctext mark gravity precedes left
3787 if {[info exists desc_tags($id)]} {
3788 appendrefs precedes $desc_tags($id) idtags
3790 $ctext insert end "\n"
3792 $ctext insert end "\n"
3793 appendwithlinks [lindex $info 5] {comment}
3795 $ctext tag delete Comments
3796 $ctext tag remove found 1.0 end
3797 $ctext conf -state disabled
3798 set commentend [$ctext index "end - 1c"]
3800 init_flist "Comments"
3801 if {$cmitmode eq "tree"} {
3803 } elseif {[llength $olds] <= 1} {
3810 proc selfirstline {} {
3815 proc sellastline {} {
3818 set l [expr {$numcommits - 1}]
3822 proc selnextline {dir} {
3824 if {![info exists selectedline]} return
3825 set l [expr {$selectedline + $dir}]
3830 proc selnextpage {dir} {
3831 global canv linespc selectedline numcommits
3833 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3837 allcanvs yview scroll [expr {$dir * $lpp}] units
3839 if {![info exists selectedline]} return
3840 set l [expr {$selectedline + $dir * $lpp}]
3843 } elseif {$l >= $numcommits} {
3844 set l [expr $numcommits - 1]
3850 proc unselectline {} {
3851 global selectedline currentid
3853 catch {unset selectedline}
3854 catch {unset currentid}
3855 allcanvs delete secsel
3857 cancel_next_highlight
3860 proc reselectline {} {
3863 if {[info exists selectedline]} {
3864 selectline $selectedline 0
3868 proc addtohistory {cmd} {
3869 global history historyindex curview
3871 set elt [list $curview $cmd]
3872 if {$historyindex > 0
3873 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3877 if {$historyindex < [llength $history]} {
3878 set history [lreplace $history $historyindex end $elt]
3880 lappend history $elt
3883 if {$historyindex > 1} {
3884 .ctop.top.bar.leftbut conf -state normal
3886 .ctop.top.bar.leftbut conf -state disabled
3888 .ctop.top.bar.rightbut conf -state disabled
3894 set view [lindex $elt 0]
3895 set cmd [lindex $elt 1]
3896 if {$curview != $view} {
3903 global history historyindex
3905 if {$historyindex > 1} {
3906 incr historyindex -1
3907 godo [lindex $history [expr {$historyindex - 1}]]
3908 .ctop.top.bar.rightbut conf -state normal
3910 if {$historyindex <= 1} {
3911 .ctop.top.bar.leftbut conf -state disabled
3916 global history historyindex
3918 if {$historyindex < [llength $history]} {
3919 set cmd [lindex $history $historyindex]
3922 .ctop.top.bar.leftbut conf -state normal
3924 if {$historyindex >= [llength $history]} {
3925 .ctop.top.bar.rightbut conf -state disabled
3930 global treefilelist treeidlist diffids diffmergeid treepending
3933 catch {unset diffmergeid}
3934 if {![info exists treefilelist($id)]} {
3935 if {![info exists treepending]} {
3936 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3940 set treefilelist($id) {}
3941 set treeidlist($id) {}
3942 fconfigure $gtf -blocking 0
3943 fileevent $gtf readable [list gettreeline $gtf $id]
3950 proc gettreeline {gtf id} {
3951 global treefilelist treeidlist treepending cmitmode diffids
3953 while {[gets $gtf line] >= 0} {
3954 if {[lindex $line 1] ne "blob"} continue
3955 set sha1 [lindex $line 2]
3956 set fname [lindex $line 3]
3957 lappend treefilelist($id) $fname
3958 lappend treeidlist($id) $sha1
3960 if {![eof $gtf]} return
3963 if {$cmitmode ne "tree"} {
3964 if {![info exists diffmergeid]} {
3965 gettreediffs $diffids
3967 } elseif {$id ne $diffids} {
3975 global treefilelist treeidlist diffids
3976 global ctext commentend
3978 set i [lsearch -exact $treefilelist($diffids) $f]
3980 puts "oops, $f not in list for id $diffids"
3983 set blob [lindex $treeidlist($diffids) $i]
3984 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3985 puts "oops, error reading blob $blob: $err"
3988 fconfigure $bf -blocking 0
3989 fileevent $bf readable [list getblobline $bf $diffids]
3990 $ctext config -state normal
3991 clear_ctext $commentend
3992 $ctext insert end "\n"
3993 $ctext insert end "$f\n" filesep
3994 $ctext config -state disabled
3995 $ctext yview $commentend
3998 proc getblobline {bf id} {
3999 global diffids cmitmode ctext
4001 if {$id ne $diffids || $cmitmode ne "tree"} {
4005 $ctext config -state normal
4006 while {[gets $bf line] >= 0} {
4007 $ctext insert end "$line\n"
4010 # delete last newline
4011 $ctext delete "end - 2c" "end - 1c"
4014 $ctext config -state disabled
4017 proc mergediff {id l} {
4018 global diffmergeid diffopts mdifffd
4024 # this doesn't seem to actually affect anything...
4025 set env(GIT_DIFF_OPTS) $diffopts
4026 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4027 if {[catch {set mdf [open $cmd r]} err]} {
4028 error_popup "Error getting merge diffs: $err"
4031 fconfigure $mdf -blocking 0
4032 set mdifffd($id) $mdf
4033 set np [llength [lindex $parentlist $l]]
4034 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4035 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4038 proc getmergediffline {mdf id np} {
4039 global diffmergeid ctext cflist nextupdate mergemax
4040 global difffilestart mdifffd
4042 set n [gets $mdf line]
4049 if {![info exists diffmergeid] || $id != $diffmergeid
4050 || $mdf != $mdifffd($id)} {
4053 $ctext conf -state normal
4054 if {[regexp {^diff --cc (.*)} $line match fname]} {
4055 # start of a new file
4056 $ctext insert end "\n"
4057 set here [$ctext index "end - 1c"]
4058 lappend difffilestart $here
4059 add_flist [list $fname]
4060 set l [expr {(78 - [string length $fname]) / 2}]
4061 set pad [string range "----------------------------------------" 1 $l]
4062 $ctext insert end "$pad $fname $pad\n" filesep
4063 } elseif {[regexp {^@@} $line]} {
4064 $ctext insert end "$line\n" hunksep
4065 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4068 # parse the prefix - one ' ', '-' or '+' for each parent
4073 for {set j 0} {$j < $np} {incr j} {
4074 set c [string range $line $j $j]
4077 } elseif {$c == "-"} {
4079 } elseif {$c == "+"} {
4088 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4089 # line doesn't appear in result, parents in $minuses have the line
4090 set num [lindex $minuses 0]
4091 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4092 # line appears in result, parents in $pluses don't have the line
4093 lappend tags mresult
4094 set num [lindex $spaces 0]
4097 if {$num >= $mergemax} {
4102 $ctext insert end "$line\n" $tags
4104 $ctext conf -state disabled
4105 if {[clock clicks -milliseconds] >= $nextupdate} {
4107 fileevent $mdf readable {}
4109 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4113 proc startdiff {ids} {
4114 global treediffs diffids treepending diffmergeid
4117 catch {unset diffmergeid}
4118 if {![info exists treediffs($ids)]} {
4119 if {![info exists treepending]} {
4127 proc addtocflist {ids} {
4128 global treediffs cflist
4129 add_flist $treediffs($ids)
4133 proc gettreediffs {ids} {
4134 global treediff treepending
4135 set treepending $ids
4138 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4140 fconfigure $gdtf -blocking 0
4141 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4144 proc gettreediffline {gdtf ids} {
4145 global treediff treediffs treepending diffids diffmergeid
4148 set n [gets $gdtf line]
4150 if {![eof $gdtf]} return
4152 set treediffs($ids) $treediff
4154 if {$cmitmode eq "tree"} {
4156 } elseif {$ids != $diffids} {
4157 if {![info exists diffmergeid]} {
4158 gettreediffs $diffids
4165 set file [lindex $line 5]
4166 lappend treediff $file
4169 proc getblobdiffs {ids} {
4170 global diffopts blobdifffd diffids env curdifftag curtagstart
4171 global nextupdate diffinhdr treediffs
4173 set env(GIT_DIFF_OPTS) $diffopts
4174 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4175 if {[catch {set bdf [open $cmd r]} err]} {
4176 puts "error getting diffs: $err"
4180 fconfigure $bdf -blocking 0
4181 set blobdifffd($ids) $bdf
4182 set curdifftag Comments
4184 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4185 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4188 proc setinlist {var i val} {
4191 while {[llength [set $var]] < $i} {
4194 if {[llength [set $var]] == $i} {
4201 proc getblobdiffline {bdf ids} {
4202 global diffids blobdifffd ctext curdifftag curtagstart
4203 global diffnexthead diffnextnote difffilestart
4204 global nextupdate diffinhdr treediffs
4206 set n [gets $bdf line]
4210 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4211 $ctext tag add $curdifftag $curtagstart end
4216 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4219 $ctext conf -state normal
4220 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4221 # start of a new file
4222 $ctext insert end "\n"
4223 $ctext tag add $curdifftag $curtagstart end
4224 set here [$ctext index "end - 1c"]
4225 set curtagstart $here
4227 set i [lsearch -exact $treediffs($ids) $fname]
4229 setinlist difffilestart $i $here
4231 if {$newname ne $fname} {
4232 set i [lsearch -exact $treediffs($ids) $newname]
4234 setinlist difffilestart $i $here
4237 set curdifftag "f:$fname"
4238 $ctext tag delete $curdifftag
4239 set l [expr {(78 - [string length $header]) / 2}]
4240 set pad [string range "----------------------------------------" 1 $l]
4241 $ctext insert end "$pad $header $pad\n" filesep
4243 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4245 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4247 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4248 $line match f1l f1c f2l f2c rest]} {
4249 $ctext insert end "$line\n" hunksep
4252 set x [string range $line 0 0]
4253 if {$x == "-" || $x == "+"} {
4254 set tag [expr {$x == "+"}]
4255 $ctext insert end "$line\n" d$tag
4256 } elseif {$x == " "} {
4257 $ctext insert end "$line\n"
4258 } elseif {$diffinhdr || $x == "\\"} {
4259 # e.g. "\ No newline at end of file"
4260 $ctext insert end "$line\n" filesep
4262 # Something else we don't recognize
4263 if {$curdifftag != "Comments"} {
4264 $ctext insert end "\n"
4265 $ctext tag add $curdifftag $curtagstart end
4266 set curtagstart [$ctext index "end - 1c"]
4267 set curdifftag Comments
4269 $ctext insert end "$line\n" filesep
4272 $ctext conf -state disabled
4273 if {[clock clicks -milliseconds] >= $nextupdate} {
4275 fileevent $bdf readable {}
4277 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4282 global difffilestart ctext
4283 set here [$ctext index @0,0]
4284 foreach loc $difffilestart {
4285 if {[$ctext compare $loc > $here]} {
4291 proc clear_ctext {{first 1.0}} {
4292 global ctext smarktop smarkbot
4294 set l [lindex [split $first .] 0]
4295 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4298 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4301 $ctext delete $first end
4304 proc incrsearch {name ix op} {
4305 global ctext searchstring searchdirn
4307 $ctext tag remove found 1.0 end
4308 if {[catch {$ctext index anchor}]} {
4309 # no anchor set, use start of selection, or of visible area
4310 set sel [$ctext tag ranges sel]
4312 $ctext mark set anchor [lindex $sel 0]
4313 } elseif {$searchdirn eq "-forwards"} {
4314 $ctext mark set anchor @0,0
4316 $ctext mark set anchor @0,[winfo height $ctext]
4319 if {$searchstring ne {}} {
4320 set here [$ctext search $searchdirn -- $searchstring anchor]
4329 global sstring ctext searchstring searchdirn
4332 $sstring icursor end
4333 set searchdirn -forwards
4334 if {$searchstring ne {}} {
4335 set sel [$ctext tag ranges sel]
4337 set start "[lindex $sel 0] + 1c"
4338 } elseif {[catch {set start [$ctext index anchor]}]} {
4341 set match [$ctext search -count mlen -- $searchstring $start]
4342 $ctext tag remove sel 1.0 end
4348 set mend "$match + $mlen c"
4349 $ctext tag add sel $match $mend
4350 $ctext mark unset anchor
4354 proc dosearchback {} {
4355 global sstring ctext searchstring searchdirn
4358 $sstring icursor end
4359 set searchdirn -backwards
4360 if {$searchstring ne {}} {
4361 set sel [$ctext tag ranges sel]
4363 set start [lindex $sel 0]
4364 } elseif {[catch {set start [$ctext index anchor]}]} {
4365 set start @0,[winfo height $ctext]
4367 set match [$ctext search -backwards -count ml -- $searchstring $start]
4368 $ctext tag remove sel 1.0 end
4374 set mend "$match + $ml c"
4375 $ctext tag add sel $match $mend
4376 $ctext mark unset anchor
4380 proc searchmark {first last} {
4381 global ctext searchstring
4385 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4386 if {$match eq {}} break
4387 set mend "$match + $mlen c"
4388 $ctext tag add found $match $mend
4392 proc searchmarkvisible {doall} {
4393 global ctext smarktop smarkbot
4395 set topline [lindex [split [$ctext index @0,0] .] 0]
4396 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4397 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4398 # no overlap with previous
4399 searchmark $topline $botline
4400 set smarktop $topline
4401 set smarkbot $botline
4403 if {$topline < $smarktop} {
4404 searchmark $topline [expr {$smarktop-1}]
4405 set smarktop $topline
4407 if {$botline > $smarkbot} {
4408 searchmark [expr {$smarkbot+1}] $botline
4409 set smarkbot $botline
4414 proc scrolltext {f0 f1} {
4417 .ctop.cdet.left.sb set $f0 $f1
4418 if {$searchstring ne {}} {
4424 global linespc charspc canvx0 canvy0 mainfont
4425 global xspc1 xspc2 lthickness
4427 set linespc [font metrics $mainfont -linespace]
4428 set charspc [font measure $mainfont "m"]
4429 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4430 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4431 set lthickness [expr {int($linespc / 9) + 1}]
4432 set xspc1(0) $linespc
4440 set ymax [lindex [$canv cget -scrollregion] 3]
4441 if {$ymax eq {} || $ymax == 0} return
4442 set span [$canv yview]
4445 allcanvs yview moveto [lindex $span 0]
4447 if {[info exists selectedline]} {
4448 selectline $selectedline 0
4452 proc incrfont {inc} {
4453 global mainfont textfont ctext canv phase
4454 global stopped entries
4456 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4457 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4459 $ctext conf -font $textfont
4460 $ctext tag conf filesep -font [concat $textfont bold]
4461 foreach e $entries {
4462 $e conf -font $mainfont
4464 if {$phase eq "getcommits"} {
4465 $canv itemconf textitems -font $mainfont
4471 global sha1entry sha1string
4472 if {[string length $sha1string] == 40} {
4473 $sha1entry delete 0 end
4477 proc sha1change {n1 n2 op} {
4478 global sha1string currentid sha1but
4479 if {$sha1string == {}
4480 || ([info exists currentid] && $sha1string == $currentid)} {
4485 if {[$sha1but cget -state] == $state} return
4486 if {$state == "normal"} {
4487 $sha1but conf -state normal -relief raised -text "Goto: "
4489 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4493 proc gotocommit {} {
4494 global sha1string currentid commitrow tagids headids
4495 global displayorder numcommits curview
4497 if {$sha1string == {}
4498 || ([info exists currentid] && $sha1string == $currentid)} return
4499 if {[info exists tagids($sha1string)]} {
4500 set id $tagids($sha1string)
4501 } elseif {[info exists headids($sha1string)]} {
4502 set id $headids($sha1string)
4504 set id [string tolower $sha1string]
4505 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4507 foreach i $displayorder {
4508 if {[string match $id* $i]} {
4512 if {$matches ne {}} {
4513 if {[llength $matches] > 1} {
4514 error_popup "Short SHA1 id $id is ambiguous"
4517 set id [lindex $matches 0]
4521 if {[info exists commitrow($curview,$id)]} {
4522 selectline $commitrow($curview,$id) 1
4525 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4530 error_popup "$type $sha1string is not known"
4533 proc lineenter {x y id} {
4534 global hoverx hovery hoverid hovertimer
4535 global commitinfo canv
4537 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4541 if {[info exists hovertimer]} {
4542 after cancel $hovertimer
4544 set hovertimer [after 500 linehover]
4548 proc linemotion {x y id} {
4549 global hoverx hovery hoverid hovertimer
4551 if {[info exists hoverid] && $id == $hoverid} {
4554 if {[info exists hovertimer]} {
4555 after cancel $hovertimer
4557 set hovertimer [after 500 linehover]
4561 proc lineleave {id} {
4562 global hoverid hovertimer canv
4564 if {[info exists hoverid] && $id == $hoverid} {
4566 if {[info exists hovertimer]} {
4567 after cancel $hovertimer
4575 global hoverx hovery hoverid hovertimer
4576 global canv linespc lthickness
4577 global commitinfo mainfont
4579 set text [lindex $commitinfo($hoverid) 0]
4580 set ymax [lindex [$canv cget -scrollregion] 3]
4581 if {$ymax == {}} return
4582 set yfrac [lindex [$canv yview] 0]
4583 set x [expr {$hoverx + 2 * $linespc}]
4584 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4585 set x0 [expr {$x - 2 * $lthickness}]
4586 set y0 [expr {$y - 2 * $lthickness}]
4587 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4588 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4589 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4590 -fill \#ffff80 -outline black -width 1 -tags hover]
4592 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4597 proc clickisonarrow {id y} {
4600 set ranges [rowranges $id]
4601 set thresh [expr {2 * $lthickness + 6}]
4602 set n [expr {[llength $ranges] - 1}]
4603 for {set i 1} {$i < $n} {incr i} {
4604 set row [lindex $ranges $i]
4605 if {abs([yc $row] - $y) < $thresh} {
4612 proc arrowjump {id n y} {
4615 # 1 <-> 2, 3 <-> 4, etc...
4616 set n [expr {(($n - 1) ^ 1) + 1}]
4617 set row [lindex [rowranges $id] $n]
4619 set ymax [lindex [$canv cget -scrollregion] 3]
4620 if {$ymax eq {} || $ymax <= 0} return
4621 set view [$canv yview]
4622 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4623 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4627 allcanvs yview moveto $yfrac
4630 proc lineclick {x y id isnew} {
4631 global ctext commitinfo children canv thickerline curview
4633 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4638 # draw this line thicker than normal
4642 set ymax [lindex [$canv cget -scrollregion] 3]
4643 if {$ymax eq {}} return
4644 set yfrac [lindex [$canv yview] 0]
4645 set y [expr {$y + $yfrac * $ymax}]
4647 set dirn [clickisonarrow $id $y]
4649 arrowjump $id $dirn $y
4654 addtohistory [list lineclick $x $y $id 0]
4656 # fill the details pane with info about this line
4657 $ctext conf -state normal
4659 $ctext tag conf link -foreground blue -underline 1
4660 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4661 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4662 $ctext insert end "Parent:\t"
4663 $ctext insert end $id [list link link0]
4664 $ctext tag bind link0 <1> [list selbyid $id]
4665 set info $commitinfo($id)
4666 $ctext insert end "\n\t[lindex $info 0]\n"
4667 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4668 set date [formatdate [lindex $info 2]]
4669 $ctext insert end "\tDate:\t$date\n"
4670 set kids $children($curview,$id)
4672 $ctext insert end "\nChildren:"
4674 foreach child $kids {
4676 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4677 set info $commitinfo($child)
4678 $ctext insert end "\n\t"
4679 $ctext insert end $child [list link link$i]
4680 $ctext tag bind link$i <1> [list selbyid $child]
4681 $ctext insert end "\n\t[lindex $info 0]"
4682 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4683 set date [formatdate [lindex $info 2]]
4684 $ctext insert end "\n\tDate:\t$date\n"
4687 $ctext conf -state disabled
4691 proc normalline {} {
4693 if {[info exists thickerline]} {
4701 global commitrow curview
4702 if {[info exists commitrow($curview,$id)]} {
4703 selectline $commitrow($curview,$id) 1
4709 if {![info exists startmstime]} {
4710 set startmstime [clock clicks -milliseconds]
4712 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4715 proc rowmenu {x y id} {
4716 global rowctxmenu commitrow selectedline rowmenuid curview
4718 if {![info exists selectedline]
4719 || $commitrow($curview,$id) eq $selectedline} {
4724 $rowctxmenu entryconfigure 0 -state $state
4725 $rowctxmenu entryconfigure 1 -state $state
4726 $rowctxmenu entryconfigure 2 -state $state
4728 tk_popup $rowctxmenu $x $y
4731 proc diffvssel {dirn} {
4732 global rowmenuid selectedline displayorder
4734 if {![info exists selectedline]} return
4736 set oldid [lindex $displayorder $selectedline]
4737 set newid $rowmenuid
4739 set oldid $rowmenuid
4740 set newid [lindex $displayorder $selectedline]
4742 addtohistory [list doseldiff $oldid $newid]
4743 doseldiff $oldid $newid
4746 proc doseldiff {oldid newid} {
4750 $ctext conf -state normal
4753 $ctext insert end "From "
4754 $ctext tag conf link -foreground blue -underline 1
4755 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4756 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4757 $ctext tag bind link0 <1> [list selbyid $oldid]
4758 $ctext insert end $oldid [list link link0]
4759 $ctext insert end "\n "
4760 $ctext insert end [lindex $commitinfo($oldid) 0]
4761 $ctext insert end "\n\nTo "
4762 $ctext tag bind link1 <1> [list selbyid $newid]
4763 $ctext insert end $newid [list link link1]
4764 $ctext insert end "\n "
4765 $ctext insert end [lindex $commitinfo($newid) 0]
4766 $ctext insert end "\n"
4767 $ctext conf -state disabled
4768 $ctext tag delete Comments
4769 $ctext tag remove found 1.0 end
4770 startdiff [list $oldid $newid]
4774 global rowmenuid currentid commitinfo patchtop patchnum
4776 if {![info exists currentid]} return
4777 set oldid $currentid
4778 set oldhead [lindex $commitinfo($oldid) 0]
4779 set newid $rowmenuid
4780 set newhead [lindex $commitinfo($newid) 0]
4783 catch {destroy $top}
4785 label $top.title -text "Generate patch"
4786 grid $top.title - -pady 10
4787 label $top.from -text "From:"
4788 entry $top.fromsha1 -width 40 -relief flat
4789 $top.fromsha1 insert 0 $oldid
4790 $top.fromsha1 conf -state readonly
4791 grid $top.from $top.fromsha1 -sticky w
4792 entry $top.fromhead -width 60 -relief flat
4793 $top.fromhead insert 0 $oldhead
4794 $top.fromhead conf -state readonly
4795 grid x $top.fromhead -sticky w
4796 label $top.to -text "To:"
4797 entry $top.tosha1 -width 40 -relief flat
4798 $top.tosha1 insert 0 $newid
4799 $top.tosha1 conf -state readonly
4800 grid $top.to $top.tosha1 -sticky w
4801 entry $top.tohead -width 60 -relief flat
4802 $top.tohead insert 0 $newhead
4803 $top.tohead conf -state readonly
4804 grid x $top.tohead -sticky w
4805 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4806 grid $top.rev x -pady 10
4807 label $top.flab -text "Output file:"
4808 entry $top.fname -width 60
4809 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4811 grid $top.flab $top.fname -sticky w
4813 button $top.buts.gen -text "Generate" -command mkpatchgo
4814 button $top.buts.can -text "Cancel" -command mkpatchcan
4815 grid $top.buts.gen $top.buts.can
4816 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4817 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4818 grid $top.buts - -pady 10 -sticky ew
4822 proc mkpatchrev {} {
4825 set oldid [$patchtop.fromsha1 get]
4826 set oldhead [$patchtop.fromhead get]
4827 set newid [$patchtop.tosha1 get]
4828 set newhead [$patchtop.tohead get]
4829 foreach e [list fromsha1 fromhead tosha1 tohead] \
4830 v [list $newid $newhead $oldid $oldhead] {
4831 $patchtop.$e conf -state normal
4832 $patchtop.$e delete 0 end
4833 $patchtop.$e insert 0 $v
4834 $patchtop.$e conf -state readonly
4841 set oldid [$patchtop.fromsha1 get]
4842 set newid [$patchtop.tosha1 get]
4843 set fname [$patchtop.fname get]
4844 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4845 error_popup "Error creating patch: $err"
4847 catch {destroy $patchtop}
4851 proc mkpatchcan {} {
4854 catch {destroy $patchtop}
4859 global rowmenuid mktagtop commitinfo
4863 catch {destroy $top}
4865 label $top.title -text "Create tag"
4866 grid $top.title - -pady 10
4867 label $top.id -text "ID:"
4868 entry $top.sha1 -width 40 -relief flat
4869 $top.sha1 insert 0 $rowmenuid
4870 $top.sha1 conf -state readonly
4871 grid $top.id $top.sha1 -sticky w
4872 entry $top.head -width 60 -relief flat
4873 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4874 $top.head conf -state readonly
4875 grid x $top.head -sticky w
4876 label $top.tlab -text "Tag name:"
4877 entry $top.tag -width 60
4878 grid $top.tlab $top.tag -sticky w
4880 button $top.buts.gen -text "Create" -command mktaggo
4881 button $top.buts.can -text "Cancel" -command mktagcan
4882 grid $top.buts.gen $top.buts.can
4883 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4884 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4885 grid $top.buts - -pady 10 -sticky ew
4890 global mktagtop env tagids idtags
4892 set id [$mktagtop.sha1 get]
4893 set tag [$mktagtop.tag get]
4895 error_popup "No tag name specified"
4898 if {[info exists tagids($tag)]} {
4899 error_popup "Tag \"$tag\" already exists"
4904 set fname [file join $dir "refs/tags" $tag]
4905 set f [open $fname w]
4909 error_popup "Error creating tag: $err"
4913 set tagids($tag) $id
4914 lappend idtags($id) $tag
4918 proc redrawtags {id} {
4919 global canv linehtag commitrow idpos selectedline curview
4922 if {![info exists commitrow($curview,$id)]} return
4923 drawcmitrow $commitrow($curview,$id)
4924 $canv delete tag.$id
4925 set xt [eval drawtags $id $idpos($id)]
4926 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4927 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4928 set xr [expr {$xt + [font measure $mainfont $text]}]
4929 if {$xr > $canvxmax} {
4933 if {[info exists selectedline]
4934 && $selectedline == $commitrow($curview,$id)} {
4935 selectline $selectedline 0
4942 catch {destroy $mktagtop}
4951 proc writecommit {} {
4952 global rowmenuid wrcomtop commitinfo wrcomcmd
4954 set top .writecommit
4956 catch {destroy $top}
4958 label $top.title -text "Write commit to file"
4959 grid $top.title - -pady 10
4960 label $top.id -text "ID:"
4961 entry $top.sha1 -width 40 -relief flat
4962 $top.sha1 insert 0 $rowmenuid
4963 $top.sha1 conf -state readonly
4964 grid $top.id $top.sha1 -sticky w
4965 entry $top.head -width 60 -relief flat
4966 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4967 $top.head conf -state readonly
4968 grid x $top.head -sticky w
4969 label $top.clab -text "Command:"
4970 entry $top.cmd -width 60 -textvariable wrcomcmd
4971 grid $top.clab $top.cmd -sticky w -pady 10
4972 label $top.flab -text "Output file:"
4973 entry $top.fname -width 60
4974 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4975 grid $top.flab $top.fname -sticky w
4977 button $top.buts.gen -text "Write" -command wrcomgo
4978 button $top.buts.can -text "Cancel" -command wrcomcan
4979 grid $top.buts.gen $top.buts.can
4980 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4981 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4982 grid $top.buts - -pady 10 -sticky ew
4989 set id [$wrcomtop.sha1 get]
4990 set cmd "echo $id | [$wrcomtop.cmd get]"
4991 set fname [$wrcomtop.fname get]
4992 if {[catch {exec sh -c $cmd >$fname &} err]} {
4993 error_popup "Error writing commit: $err"
4995 catch {destroy $wrcomtop}
5002 catch {destroy $wrcomtop}
5006 # Stuff for finding nearby tags
5007 proc getallcommits {} {
5008 global allcstart allcommits allcfd
5010 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5012 fconfigure $fd -blocking 0
5013 set allcommits "reading"
5018 proc discardallcommits {} {
5019 global allparents allchildren allcommits allcfd
5020 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5022 if {![info exists allcommits]} return
5023 if {$allcommits eq "reading"} {
5024 catch {close $allcfd}
5026 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5027 alldtags tagisdesc desc_heads} {
5032 proc restartgetall {fd} {
5035 fileevent $fd readable [list getallclines $fd]
5036 set allcstart [clock clicks -milliseconds]
5039 proc combine_dtags {l1 l2} {
5040 global tagisdesc notfirstd
5042 set res [lsort -unique [concat $l1 $l2]]
5043 for {set i 0} {$i < [llength $res]} {incr i} {
5044 set x [lindex $res $i]
5045 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5046 set y [lindex $res $j]
5047 if {[info exists tagisdesc($x,$y)]} {
5048 if {$tagisdesc($x,$y) > 0} {
5049 # x is a descendent of y, exclude x
5050 set res [lreplace $res $i $i]
5054 # y is a descendent of x, exclude y
5055 set res [lreplace $res $j $j]
5058 # no relation, keep going
5066 proc combine_atags {l1 l2} {
5069 set res [lsort -unique [concat $l1 $l2]]
5070 for {set i 0} {$i < [llength $res]} {incr i} {
5071 set x [lindex $res $i]
5072 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5073 set y [lindex $res $j]
5074 if {[info exists tagisdesc($x,$y)]} {
5075 if {$tagisdesc($x,$y) < 0} {
5076 # x is an ancestor of y, exclude x
5077 set res [lreplace $res $i $i]
5081 # y is an ancestor of x, exclude y
5082 set res [lreplace $res $j $j]
5085 # no relation, keep going
5093 proc getallclines {fd} {
5094 global allparents allchildren allcommits allcstart
5095 global desc_tags anc_tags idtags alldtags tagisdesc allids
5096 global desc_heads idheads
5098 while {[gets $fd line] >= 0} {
5099 set id [lindex $line 0]
5101 set olds [lrange $line 1 end]
5102 set allparents($id) $olds
5103 if {![info exists allchildren($id)]} {
5104 set allchildren($id) {}
5107 lappend allchildren($p) $id
5109 # compute nearest tagged descendents as we go
5110 # also compute descendent heads
5113 foreach child $allchildren($id) {
5114 if {[info exists idtags($child)]} {
5115 set ctags [list $child]
5117 set ctags $desc_tags($child)
5121 } elseif {$ctags ne $dtags} {
5122 set dtags [combine_dtags $dtags $ctags]
5124 set cheads $desc_heads($child)
5125 if {$dheads eq {}} {
5127 } elseif {$cheads ne $dheads} {
5128 set dheads [lsort -unique [concat $dheads $cheads]]
5131 set desc_tags($id) $dtags
5132 if {[info exists idtags($id)]} {
5134 foreach tag $dtags {
5135 set adt [concat $adt $alldtags($tag)]
5137 set adt [lsort -unique $adt]
5138 set alldtags($id) $adt
5140 set tagisdesc($id,$tag) -1
5141 set tagisdesc($tag,$id) 1
5144 if {[info exists idheads($id)]} {
5147 set desc_heads($id) $dheads
5148 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5149 fileevent $fd readable {}
5150 after idle restartgetall $fd
5155 after idle restartatags [llength $allids]
5156 if {[catch {close $fd} err]} {
5157 error_popup "Error reading full commit graph: $err.\n\
5158 Results may be incomplete."
5163 # walk backward through the tree and compute nearest tagged ancestors
5164 proc restartatags {i} {
5165 global allids allparents idtags anc_tags t0
5167 set t0 [clock clicks -milliseconds]
5168 while {[incr i -1] >= 0} {
5169 set id [lindex $allids $i]
5171 foreach p $allparents($id) {
5172 if {[info exists idtags($p)]} {
5175 set ptags $anc_tags($p)
5179 } elseif {$ptags ne $atags} {
5180 set atags [combine_atags $atags $ptags]
5183 set anc_tags($id) $atags
5184 if {[clock clicks -milliseconds] - $t0 >= 50} {
5185 after idle restartatags $i
5189 set allcommits "done"
5194 proc rereadrefs {} {
5195 global idtags idheads idotherrefs
5197 set refids [concat [array names idtags] \
5198 [array names idheads] [array names idotherrefs]]
5199 foreach id $refids {
5200 if {![info exists ref($id)]} {
5201 set ref($id) [listrefs $id]
5205 set refids [lsort -unique [concat $refids [array names idtags] \
5206 [array names idheads] [array names idotherrefs]]]
5207 foreach id $refids {
5208 set v [listrefs $id]
5209 if {![info exists ref($id)] || $ref($id) != $v} {
5215 proc listrefs {id} {
5216 global idtags idheads idotherrefs
5219 if {[info exists idtags($id)]} {
5223 if {[info exists idheads($id)]} {
5227 if {[info exists idotherrefs($id)]} {
5228 set z $idotherrefs($id)
5230 return [list $x $y $z]
5233 proc showtag {tag isnew} {
5234 global ctext tagcontents tagids linknum
5237 addtohistory [list showtag $tag 0]
5239 $ctext conf -state normal
5242 if {[info exists tagcontents($tag)]} {
5243 set text $tagcontents($tag)
5245 set text "Tag: $tag\nId: $tagids($tag)"
5247 appendwithlinks $text {}
5248 $ctext conf -state disabled
5259 global maxwidth maxgraphpct diffopts
5260 global oldprefs prefstop showneartags
5261 global bgcolor fgcolor ctext diffcolors
5265 if {[winfo exists $top]} {
5269 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5270 set oldprefs($v) [set $v]
5273 wm title $top "Gitk preferences"
5274 label $top.ldisp -text "Commit list display options"
5275 grid $top.ldisp - -sticky w -pady 10
5276 label $top.spacer -text " "
5277 label $top.maxwidthl -text "Maximum graph width (lines)" \
5279 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5280 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5281 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5283 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5284 grid x $top.maxpctl $top.maxpct -sticky w
5286 label $top.ddisp -text "Diff display options"
5287 grid $top.ddisp - -sticky w -pady 10
5288 label $top.diffoptl -text "Options for diff program" \
5290 entry $top.diffopt -width 20 -textvariable diffopts
5291 grid x $top.diffoptl $top.diffopt -sticky w
5293 label $top.ntag.l -text "Display nearby tags" -font optionfont
5294 checkbutton $top.ntag.b -variable showneartags
5295 pack $top.ntag.b $top.ntag.l -side left
5296 grid x $top.ntag -sticky w
5298 label $top.cdisp -text "Colors: press to choose"
5299 grid $top.cdisp - -sticky w -pady 10
5300 label $top.bg -padx 40 -relief sunk -background $bgcolor
5301 button $top.bgbut -text "Background" -font optionfont \
5302 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5303 grid x $top.bgbut $top.bg -sticky w
5304 label $top.fg -padx 40 -relief sunk -background $fgcolor
5305 button $top.fgbut -text "Foreground" -font optionfont \
5306 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5307 grid x $top.fgbut $top.fg -sticky w
5308 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5309 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5310 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5311 [list $ctext tag conf d0 -foreground]]
5312 grid x $top.diffoldbut $top.diffold -sticky w
5313 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5314 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5315 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5316 [list $ctext tag conf d1 -foreground]]
5317 grid x $top.diffnewbut $top.diffnew -sticky w
5318 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5319 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5320 -command [list choosecolor diffcolors 2 $top.hunksep \
5321 "diff hunk header" \
5322 [list $ctext tag conf hunksep -foreground]]
5323 grid x $top.hunksepbut $top.hunksep -sticky w
5326 button $top.buts.ok -text "OK" -command prefsok
5327 button $top.buts.can -text "Cancel" -command prefscan
5328 grid $top.buts.ok $top.buts.can
5329 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5330 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5331 grid $top.buts - - -pady 10 -sticky ew
5334 proc choosecolor {v vi w x cmd} {
5337 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5338 -title "Gitk: choose color for $x"]
5339 if {$c eq {}} return
5340 $w conf -background $c
5349 $w conf -background $c
5357 $w conf -foreground $c
5359 allcanvs itemconf text -fill $c
5360 $canv itemconf circle -outline $c
5364 global maxwidth maxgraphpct diffopts
5365 global oldprefs prefstop showneartags
5367 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5368 set $v $oldprefs($v)
5370 catch {destroy $prefstop}
5375 global maxwidth maxgraphpct
5376 global oldprefs prefstop showneartags
5378 catch {destroy $prefstop}
5380 if {$maxwidth != $oldprefs(maxwidth)
5381 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5383 } elseif {$showneartags != $oldprefs(showneartags)} {
5388 proc formatdate {d} {
5389 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5392 # This list of encoding names and aliases is distilled from
5393 # http://www.iana.org/assignments/character-sets.
5394 # Not all of them are supported by Tcl.
5395 set encoding_aliases {
5396 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5397 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5398 { ISO-10646-UTF-1 csISO10646UTF1 }
5399 { ISO_646.basic:1983 ref csISO646basic1983 }
5400 { INVARIANT csINVARIANT }
5401 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5402 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5403 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5404 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5405 { NATS-DANO iso-ir-9-1 csNATSDANO }
5406 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5407 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5408 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5409 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5410 { ISO-2022-KR csISO2022KR }
5412 { ISO-2022-JP csISO2022JP }
5413 { ISO-2022-JP-2 csISO2022JP2 }
5414 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5416 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5417 { IT iso-ir-15 ISO646-IT csISO15Italian }
5418 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5419 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5420 { greek7-old iso-ir-18 csISO18Greek7Old }
5421 { latin-greek iso-ir-19 csISO19LatinGreek }
5422 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5423 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5424 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5425 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5426 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5427 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5428 { INIS iso-ir-49 csISO49INIS }
5429 { INIS-8 iso-ir-50 csISO50INIS8 }
5430 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5431 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5432 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5433 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5434 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5435 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5437 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5438 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5439 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5440 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5441 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5442 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5443 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5444 { greek7 iso-ir-88 csISO88Greek7 }
5445 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5446 { iso-ir-90 csISO90 }
5447 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5448 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5449 csISO92JISC62991984b }
5450 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5451 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5452 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5453 csISO95JIS62291984handadd }
5454 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5455 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5456 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5457 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5459 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5460 { T.61-7bit iso-ir-102 csISO102T617bit }
5461 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5462 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5463 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5464 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5465 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5466 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5467 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5468 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5469 arabic csISOLatinArabic }
5470 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5471 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5472 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5473 greek greek8 csISOLatinGreek }
5474 { T.101-G2 iso-ir-128 csISO128T101G2 }
5475 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5477 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5478 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5479 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5480 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5481 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5482 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5483 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5484 csISOLatinCyrillic }
5485 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5486 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5487 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5488 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5489 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5490 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5491 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5492 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5493 { ISO_10367-box iso-ir-155 csISO10367Box }
5494 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5495 { latin-lap lap iso-ir-158 csISO158Lap }
5496 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5497 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5500 { JIS_X0201 X0201 csHalfWidthKatakana }
5501 { KSC5636 ISO646-KR csKSC5636 }
5502 { ISO-10646-UCS-2 csUnicode }
5503 { ISO-10646-UCS-4 csUCS4 }
5504 { DEC-MCS dec csDECMCS }
5505 { hp-roman8 roman8 r8 csHPRoman8 }
5506 { macintosh mac csMacintosh }
5507 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5509 { IBM038 EBCDIC-INT cp038 csIBM038 }
5510 { IBM273 CP273 csIBM273 }
5511 { IBM274 EBCDIC-BE CP274 csIBM274 }
5512 { IBM275 EBCDIC-BR cp275 csIBM275 }
5513 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5514 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5515 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5516 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5517 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5518 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5519 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5520 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5521 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5522 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5523 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5524 { IBM437 cp437 437 csPC8CodePage437 }
5525 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5526 { IBM775 cp775 csPC775Baltic }
5527 { IBM850 cp850 850 csPC850Multilingual }
5528 { IBM851 cp851 851 csIBM851 }
5529 { IBM852 cp852 852 csPCp852 }
5530 { IBM855 cp855 855 csIBM855 }
5531 { IBM857 cp857 857 csIBM857 }
5532 { IBM860 cp860 860 csIBM860 }
5533 { IBM861 cp861 861 cp-is csIBM861 }
5534 { IBM862 cp862 862 csPC862LatinHebrew }
5535 { IBM863 cp863 863 csIBM863 }
5536 { IBM864 cp864 csIBM864 }
5537 { IBM865 cp865 865 csIBM865 }
5538 { IBM866 cp866 866 csIBM866 }
5539 { IBM868 CP868 cp-ar csIBM868 }
5540 { IBM869 cp869 869 cp-gr csIBM869 }
5541 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5542 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5543 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5544 { IBM891 cp891 csIBM891 }
5545 { IBM903 cp903 csIBM903 }
5546 { IBM904 cp904 904 csIBBM904 }
5547 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5548 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5549 { IBM1026 CP1026 csIBM1026 }
5550 { EBCDIC-AT-DE csIBMEBCDICATDE }
5551 { EBCDIC-AT-DE-A csEBCDICATDEA }
5552 { EBCDIC-CA-FR csEBCDICCAFR }
5553 { EBCDIC-DK-NO csEBCDICDKNO }
5554 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5555 { EBCDIC-FI-SE csEBCDICFISE }
5556 { EBCDIC-FI-SE-A csEBCDICFISEA }
5557 { EBCDIC-FR csEBCDICFR }
5558 { EBCDIC-IT csEBCDICIT }
5559 { EBCDIC-PT csEBCDICPT }
5560 { EBCDIC-ES csEBCDICES }
5561 { EBCDIC-ES-A csEBCDICESA }
5562 { EBCDIC-ES-S csEBCDICESS }
5563 { EBCDIC-UK csEBCDICUK }
5564 { EBCDIC-US csEBCDICUS }
5565 { UNKNOWN-8BIT csUnknown8BiT }
5566 { MNEMONIC csMnemonic }
5571 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5572 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5573 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5574 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5575 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5576 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5577 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5578 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5579 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5580 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5581 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5582 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5583 { IBM1047 IBM-1047 }
5584 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5585 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5586 { UNICODE-1-1 csUnicode11 }
5589 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5590 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5592 { ISO-8859-15 ISO_8859-15 Latin-9 }
5593 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5594 { GBK CP936 MS936 windows-936 }
5595 { JIS_Encoding csJISEncoding }
5596 { Shift_JIS MS_Kanji csShiftJIS }
5597 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5599 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5600 { ISO-10646-UCS-Basic csUnicodeASCII }
5601 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5602 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5603 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5604 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5605 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5606 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5607 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5608 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5609 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5610 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5611 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5612 { Ventura-US csVenturaUS }
5613 { Ventura-International csVenturaInternational }
5614 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5615 { PC8-Turkish csPC8Turkish }
5616 { IBM-Symbols csIBMSymbols }
5617 { IBM-Thai csIBMThai }
5618 { HP-Legal csHPLegal }
5619 { HP-Pi-font csHPPiFont }
5620 { HP-Math8 csHPMath8 }
5621 { Adobe-Symbol-Encoding csHPPSMath }
5622 { HP-DeskTop csHPDesktop }
5623 { Ventura-Math csVenturaMath }
5624 { Microsoft-Publishing csMicrosoftPublishing }
5625 { Windows-31J csWindows31J }
5630 proc tcl_encoding {enc} {
5631 global encoding_aliases
5632 set names [encoding names]
5633 set lcnames [string tolower $names]
5634 set enc [string tolower $enc]
5635 set i [lsearch -exact $lcnames $enc]
5637 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5638 if {[regsub {^iso[-_]} $enc iso encx]} {
5639 set i [lsearch -exact $lcnames $encx]
5643 foreach l $encoding_aliases {
5644 set ll [string tolower $l]
5645 if {[lsearch -exact $ll $enc] < 0} continue
5646 # look through the aliases for one that tcl knows about
5648 set i [lsearch -exact $lcnames $e]
5650 if {[regsub {^iso[-_]} $e iso ex]} {
5651 set i [lsearch -exact $lcnames $ex]
5660 return [lindex $names $i]
5667 set diffopts "-U 5 -p"
5668 set wrcomcmd "git diff-tree --stdin -p --pretty"
5672 set gitencoding [exec git repo-config --get i18n.commitencoding]
5674 if {$gitencoding == ""} {
5675 set gitencoding "utf-8"
5677 set tclencoding [tcl_encoding $gitencoding]
5678 if {$tclencoding == {}} {
5679 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5682 set mainfont {Helvetica 9}
5683 set textfont {Courier 9}
5684 set uifont {Helvetica 9 bold}
5685 set findmergefiles 0
5693 set cmitmode "patch"
5694 set wrapcomment "none"
5697 set colors {green red blue magenta darkgrey brown orange}
5700 set diffcolors {red "#00a000" blue}
5702 catch {source ~/.gitk}
5704 font create optionfont -family sans-serif -size -12
5708 switch -regexp -- $arg {
5710 "^-d" { set datemode 1 }
5712 lappend revtreeargs $arg
5717 # check that we can find a .git directory somewhere...
5719 if {![file isdirectory $gitdir]} {
5720 show_error {} . "Cannot find the git directory \"$gitdir\"."
5724 set cmdline_files {}
5725 set i [lsearch -exact $revtreeargs "--"]
5727 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5728 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5729 } elseif {$revtreeargs ne {}} {
5731 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5732 set cmdline_files [split $f "\n"]
5733 set n [llength $cmdline_files]
5734 set revtreeargs [lrange $revtreeargs 0 end-$n]
5736 # unfortunately we get both stdout and stderr in $err,
5737 # so look for "fatal:".
5738 set i [string first "fatal:" $err]
5740 set err [string range $err [expr {$i + 6}] end]
5742 show_error {} . "Bad arguments to gitk:\n$err"
5751 set highlight_paths {}
5752 set searchdirn -forwards
5761 set selectedhlview None
5774 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5775 # create a view for the files/dirs specified on the command line
5779 set viewname(1) "Command line"
5780 set viewfiles(1) $cmdline_files
5781 set viewargs(1) $revtreeargs
5784 .bar.view entryconf 2 -state normal
5785 .bar.view entryconf 3 -state normal
5788 if {[info exists permviews]} {
5789 foreach v $permviews {
5792 set viewname($n) [lindex $v 0]
5793 set viewfiles($n) [lindex $v 1]
5794 set viewargs($n) [lindex $v 2]