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 mainhead
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 set thehead [exec git symbolic-ref HEAD]
364 if {[string match "refs/heads/*" $thehead]} {
365 set mainhead [string range $thehead 11 end]
370 proc show_error {w top msg} {
371 message $w.m -text $msg -justify center -aspect 400
372 pack $w.m -side top -fill x -padx 20 -pady 20
373 button $w.ok -text OK -command "destroy $top"
374 pack $w.ok -side bottom -fill x
375 bind $top <Visibility> "grab $top; focus $top"
376 bind $top <Key-Return> "destroy $top"
380 proc error_popup msg {
384 show_error $w $w $msg
388 global canv canv2 canv3 linespc charspc ctext cflist
389 global textfont mainfont uifont
390 global findtype findtypemenu findloc findstring fstring geometry
391 global entries sha1entry sha1string sha1but
392 global maincursor textcursor curtextcursor
393 global rowctxmenu mergemax wrapcomment
394 global highlight_files gdttype
395 global searchstring sstring
396 global bgcolor fgcolor bglist fglist diffcolors
399 .bar add cascade -label "File" -menu .bar.file
400 .bar configure -font $uifont
402 .bar.file add command -label "Update" -command updatecommits
403 .bar.file add command -label "Reread references" -command rereadrefs
404 .bar.file add command -label "Quit" -command doquit
405 .bar.file configure -font $uifont
407 .bar add cascade -label "Edit" -menu .bar.edit
408 .bar.edit add command -label "Preferences" -command doprefs
409 .bar.edit configure -font $uifont
411 menu .bar.view -font $uifont
412 .bar add cascade -label "View" -menu .bar.view
413 .bar.view add command -label "New view..." -command {newview 0}
414 .bar.view add command -label "Edit view..." -command editview \
416 .bar.view add command -label "Delete view" -command delview -state disabled
417 .bar.view add separator
418 .bar.view add radiobutton -label "All files" -command {showview 0} \
419 -variable selectedview -value 0
422 .bar add cascade -label "Help" -menu .bar.help
423 .bar.help add command -label "About gitk" -command about
424 .bar.help add command -label "Key bindings" -command keys
425 .bar.help configure -font $uifont
426 . configure -menu .bar
428 if {![info exists geometry(canv1)]} {
429 set geometry(canv1) [expr {45 * $charspc}]
430 set geometry(canv2) [expr {30 * $charspc}]
431 set geometry(canv3) [expr {15 * $charspc}]
432 set geometry(canvh) [expr {25 * $linespc + 4}]
433 set geometry(ctextw) 80
434 set geometry(ctexth) 30
435 set geometry(cflistw) 30
437 panedwindow .ctop -orient vertical
438 if {[info exists geometry(width)]} {
439 .ctop conf -width $geometry(width) -height $geometry(height)
440 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
441 set geometry(ctexth) [expr {($texth - 8) /
442 [font metrics $textfont -linespace]}]
447 pack .ctop.top.lbar -side bottom -fill x
448 pack .ctop.top.bar -side bottom -fill x
449 set cscroll .ctop.top.csb
450 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
451 pack $cscroll -side right -fill y
452 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
453 pack .ctop.top.clist -side top -fill both -expand 1
455 set canv .ctop.top.clist.canv
456 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
457 -background $bgcolor -bd 0 \
458 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
459 .ctop.top.clist add $canv
460 set canv2 .ctop.top.clist.canv2
461 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
462 -background $bgcolor -bd 0 -yscrollincr $linespc
463 .ctop.top.clist add $canv2
464 set canv3 .ctop.top.clist.canv3
465 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
466 -background $bgcolor -bd 0 -yscrollincr $linespc
467 .ctop.top.clist add $canv3
468 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
469 lappend bglist $canv $canv2 $canv3
471 set sha1entry .ctop.top.bar.sha1
472 set entries $sha1entry
473 set sha1but .ctop.top.bar.sha1label
474 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
475 -command gotocommit -width 8 -font $uifont
476 $sha1but conf -disabledforeground [$sha1but cget -foreground]
477 pack .ctop.top.bar.sha1label -side left
478 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
479 trace add variable sha1string write sha1change
480 pack $sha1entry -side left -pady 2
482 image create bitmap bm-left -data {
483 #define left_width 16
484 #define left_height 16
485 static unsigned char left_bits[] = {
486 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
487 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
488 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
490 image create bitmap bm-right -data {
491 #define right_width 16
492 #define right_height 16
493 static unsigned char right_bits[] = {
494 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
495 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
496 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
498 button .ctop.top.bar.leftbut -image bm-left -command goback \
499 -state disabled -width 26
500 pack .ctop.top.bar.leftbut -side left -fill y
501 button .ctop.top.bar.rightbut -image bm-right -command goforw \
502 -state disabled -width 26
503 pack .ctop.top.bar.rightbut -side left -fill y
505 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
506 pack .ctop.top.bar.findbut -side left
508 set fstring .ctop.top.bar.findstring
509 lappend entries $fstring
510 entry $fstring -width 30 -font $textfont -textvariable findstring
511 trace add variable findstring write find_change
512 pack $fstring -side left -expand 1 -fill x
514 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp]
516 trace add variable findtype write find_change
517 .ctop.top.bar.findtype configure -font $uifont
518 .ctop.top.bar.findtype.menu configure -font $uifont
519 set findloc "All fields"
520 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
521 Comments Author Committer
522 trace add variable findloc write find_change
523 .ctop.top.bar.findloc configure -font $uifont
524 .ctop.top.bar.findloc.menu configure -font $uifont
525 pack .ctop.top.bar.findloc -side right
526 pack .ctop.top.bar.findtype -side right
528 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
530 pack .ctop.top.lbar.flabel -side left -fill y
531 set gdttype "touching paths:"
532 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
533 "adding/removing string:"]
534 trace add variable gdttype write hfiles_change
535 $gm conf -font $uifont
536 .ctop.top.lbar.gdttype conf -font $uifont
537 pack .ctop.top.lbar.gdttype -side left -fill y
538 entry .ctop.top.lbar.fent -width 25 -font $textfont \
539 -textvariable highlight_files
540 trace add variable highlight_files write hfiles_change
541 lappend entries .ctop.top.lbar.fent
542 pack .ctop.top.lbar.fent -side left -fill x -expand 1
543 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
544 pack .ctop.top.lbar.vlabel -side left -fill y
545 global viewhlmenu selectedhlview
546 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
547 $viewhlmenu entryconf 0 -command delvhighlight
548 $viewhlmenu conf -font $uifont
549 .ctop.top.lbar.vhl conf -font $uifont
550 pack .ctop.top.lbar.vhl -side left -fill y
551 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
552 pack .ctop.top.lbar.rlabel -side left -fill y
553 global highlight_related
554 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
555 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
556 $m conf -font $uifont
557 .ctop.top.lbar.relm conf -font $uifont
558 trace add variable highlight_related write vrel_change
559 pack .ctop.top.lbar.relm -side left -fill y
561 panedwindow .ctop.cdet -orient horizontal
563 frame .ctop.cdet.left
564 frame .ctop.cdet.left.bot
565 pack .ctop.cdet.left.bot -side bottom -fill x
566 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
568 pack .ctop.cdet.left.bot.search -side left -padx 5
569 set sstring .ctop.cdet.left.bot.sstring
570 entry $sstring -width 20 -font $textfont -textvariable searchstring
571 lappend entries $sstring
572 trace add variable searchstring write incrsearch
573 pack $sstring -side left -expand 1 -fill x
574 set ctext .ctop.cdet.left.ctext
575 text $ctext -background $bgcolor -foreground $fgcolor \
576 -state disabled -font $textfont \
577 -width $geometry(ctextw) -height $geometry(ctexth) \
578 -yscrollcommand scrolltext -wrap none
579 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
580 pack .ctop.cdet.left.sb -side right -fill y
581 pack $ctext -side left -fill both -expand 1
582 .ctop.cdet add .ctop.cdet.left
583 lappend bglist $ctext
584 lappend fglist $ctext
586 $ctext tag conf comment -wrap $wrapcomment
587 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
588 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
589 $ctext tag conf d0 -fore [lindex $diffcolors 0]
590 $ctext tag conf d1 -fore [lindex $diffcolors 1]
591 $ctext tag conf m0 -fore red
592 $ctext tag conf m1 -fore blue
593 $ctext tag conf m2 -fore green
594 $ctext tag conf m3 -fore purple
595 $ctext tag conf m4 -fore brown
596 $ctext tag conf m5 -fore "#009090"
597 $ctext tag conf m6 -fore magenta
598 $ctext tag conf m7 -fore "#808000"
599 $ctext tag conf m8 -fore "#009000"
600 $ctext tag conf m9 -fore "#ff0080"
601 $ctext tag conf m10 -fore cyan
602 $ctext tag conf m11 -fore "#b07070"
603 $ctext tag conf m12 -fore "#70b0f0"
604 $ctext tag conf m13 -fore "#70f0b0"
605 $ctext tag conf m14 -fore "#f0b070"
606 $ctext tag conf m15 -fore "#ff70b0"
607 $ctext tag conf mmax -fore darkgrey
609 $ctext tag conf mresult -font [concat $textfont bold]
610 $ctext tag conf msep -font [concat $textfont bold]
611 $ctext tag conf found -back yellow
613 frame .ctop.cdet.right
614 frame .ctop.cdet.right.mode
615 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
616 -command reselectline -variable cmitmode -value "patch"
617 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
618 -command reselectline -variable cmitmode -value "tree"
619 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
620 pack .ctop.cdet.right.mode -side top -fill x
621 set cflist .ctop.cdet.right.cfiles
622 set indent [font measure $mainfont "nn"]
623 text $cflist -width $geometry(cflistw) \
624 -background $bgcolor -foreground $fgcolor \
626 -tabs [list $indent [expr {2 * $indent}]] \
627 -yscrollcommand ".ctop.cdet.right.sb set" \
628 -cursor [. cget -cursor] \
629 -spacing1 1 -spacing3 1
630 lappend bglist $cflist
631 lappend fglist $cflist
632 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
633 pack .ctop.cdet.right.sb -side right -fill y
634 pack $cflist -side left -fill both -expand 1
635 $cflist tag configure highlight \
636 -background [$cflist cget -selectbackground]
637 $cflist tag configure bold -font [concat $mainfont bold]
638 .ctop.cdet add .ctop.cdet.right
639 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
641 pack .ctop -side top -fill both -expand 1
643 bindall <1> {selcanvline %W %x %y}
644 #bindall <B1-Motion> {selcanvline %W %x %y}
645 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
646 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
647 bindall <2> "canvscan mark %W %x %y"
648 bindall <B2-Motion> "canvscan dragto %W %x %y"
649 bindkey <Home> selfirstline
650 bindkey <End> sellastline
651 bind . <Key-Up> "selnextline -1"
652 bind . <Key-Down> "selnextline 1"
653 bind . <Shift-Key-Up> "next_highlight -1"
654 bind . <Shift-Key-Down> "next_highlight 1"
655 bindkey <Key-Right> "goforw"
656 bindkey <Key-Left> "goback"
657 bind . <Key-Prior> "selnextpage -1"
658 bind . <Key-Next> "selnextpage 1"
659 bind . <Control-Home> "allcanvs yview moveto 0.0"
660 bind . <Control-End> "allcanvs yview moveto 1.0"
661 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
662 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
663 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
664 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
665 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
666 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
667 bindkey <Key-space> "$ctext yview scroll 1 pages"
668 bindkey p "selnextline -1"
669 bindkey n "selnextline 1"
672 bindkey i "selnextline -1"
673 bindkey k "selnextline 1"
676 bindkey b "$ctext yview scroll -1 pages"
677 bindkey d "$ctext yview scroll 18 units"
678 bindkey u "$ctext yview scroll -18 units"
679 bindkey / {findnext 1}
680 bindkey <Key-Return> {findnext 0}
683 bind . <Control-q> doquit
684 bind . <Control-f> dofind
685 bind . <Control-g> {findnext 0}
686 bind . <Control-r> dosearchback
687 bind . <Control-s> dosearch
688 bind . <Control-equal> {incrfont 1}
689 bind . <Control-KP_Add> {incrfont 1}
690 bind . <Control-minus> {incrfont -1}
691 bind . <Control-KP_Subtract> {incrfont -1}
692 bind . <Destroy> {savestuff %W}
693 bind . <Button-1> "click %W"
694 bind $fstring <Key-Return> dofind
695 bind $sha1entry <Key-Return> gotocommit
696 bind $sha1entry <<PasteSelection>> clearsha1
697 bind $cflist <1> {sel_flist %W %x %y; break}
698 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
699 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
701 set maincursor [. cget -cursor]
702 set textcursor [$ctext cget -cursor]
703 set curtextcursor $textcursor
705 set rowctxmenu .rowctxmenu
706 menu $rowctxmenu -tearoff 0
707 $rowctxmenu add command -label "Diff this -> selected" \
708 -command {diffvssel 0}
709 $rowctxmenu add command -label "Diff selected -> this" \
710 -command {diffvssel 1}
711 $rowctxmenu add command -label "Make patch" -command mkpatch
712 $rowctxmenu add command -label "Create tag" -command mktag
713 $rowctxmenu add command -label "Write commit to file" -command writecommit
716 # mouse-2 makes all windows scan vertically, but only the one
717 # the cursor is in scans horizontally
718 proc canvscan {op w x y} {
719 global canv canv2 canv3
720 foreach c [list $canv $canv2 $canv3] {
729 proc scrollcanv {cscroll f0 f1} {
735 # when we make a key binding for the toplevel, make sure
736 # it doesn't get triggered when that key is pressed in the
737 # find string entry widget.
738 proc bindkey {ev script} {
741 set escript [bind Entry $ev]
742 if {$escript == {}} {
743 set escript [bind Entry <Key>]
746 bind $e $ev "$escript; break"
750 # set the focus back to the toplevel for any click outside
761 global canv canv2 canv3 ctext cflist mainfont textfont uifont
762 global stuffsaved findmergefiles maxgraphpct
763 global maxwidth showneartags
764 global viewname viewfiles viewargs viewperm nextviewnum
765 global cmitmode wrapcomment
766 global colors bgcolor fgcolor diffcolors
768 if {$stuffsaved} return
769 if {![winfo viewable .]} return
771 set f [open "~/.gitk-new" w]
772 puts $f [list set mainfont $mainfont]
773 puts $f [list set textfont $textfont]
774 puts $f [list set uifont $uifont]
775 puts $f [list set findmergefiles $findmergefiles]
776 puts $f [list set maxgraphpct $maxgraphpct]
777 puts $f [list set maxwidth $maxwidth]
778 puts $f [list set cmitmode $cmitmode]
779 puts $f [list set wrapcomment $wrapcomment]
780 puts $f [list set showneartags $showneartags]
781 puts $f [list set bgcolor $bgcolor]
782 puts $f [list set fgcolor $fgcolor]
783 puts $f [list set colors $colors]
784 puts $f [list set diffcolors $diffcolors]
785 puts $f "set geometry(width) [winfo width .ctop]"
786 puts $f "set geometry(height) [winfo height .ctop]"
787 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
788 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
789 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
790 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
791 set wid [expr {([winfo width $ctext] - 8) \
792 / [font measure $textfont "0"]}]
793 puts $f "set geometry(ctextw) $wid"
794 set wid [expr {([winfo width $cflist] - 11) \
795 / [font measure [$cflist cget -font] "0"]}]
796 puts $f "set geometry(cflistw) $wid"
797 puts -nonewline $f "set permviews {"
798 for {set v 0} {$v < $nextviewnum} {incr v} {
800 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
805 file rename -force "~/.gitk-new" "~/.gitk"
810 proc resizeclistpanes {win w} {
812 if {[info exists oldwidth($win)]} {
813 set s0 [$win sash coord 0]
814 set s1 [$win sash coord 1]
816 set sash0 [expr {int($w/2 - 2)}]
817 set sash1 [expr {int($w*5/6 - 2)}]
819 set factor [expr {1.0 * $w / $oldwidth($win)}]
820 set sash0 [expr {int($factor * [lindex $s0 0])}]
821 set sash1 [expr {int($factor * [lindex $s1 0])}]
825 if {$sash1 < $sash0 + 20} {
826 set sash1 [expr {$sash0 + 20}]
828 if {$sash1 > $w - 10} {
829 set sash1 [expr {$w - 10}]
830 if {$sash0 > $sash1 - 20} {
831 set sash0 [expr {$sash1 - 20}]
835 $win sash place 0 $sash0 [lindex $s0 1]
836 $win sash place 1 $sash1 [lindex $s1 1]
838 set oldwidth($win) $w
841 proc resizecdetpanes {win w} {
843 if {[info exists oldwidth($win)]} {
844 set s0 [$win sash coord 0]
846 set sash0 [expr {int($w*3/4 - 2)}]
848 set factor [expr {1.0 * $w / $oldwidth($win)}]
849 set sash0 [expr {int($factor * [lindex $s0 0])}]
853 if {$sash0 > $w - 15} {
854 set sash0 [expr {$w - 15}]
857 $win sash place 0 $sash0 [lindex $s0 1]
859 set oldwidth($win) $w
863 global canv canv2 canv3
869 proc bindall {event action} {
870 global canv canv2 canv3
871 bind $canv $event $action
872 bind $canv2 $event $action
873 bind $canv3 $event $action
878 if {[winfo exists $w]} {
883 wm title $w "About gitk"
885 Gitk - a commit viewer for git
887 Copyright © 2005-2006 Paul Mackerras
889 Use and redistribute under the terms of the GNU General Public License} \
890 -justify center -aspect 400
891 pack $w.m -side top -fill x -padx 20 -pady 20
892 button $w.ok -text Close -command "destroy $w"
893 pack $w.ok -side bottom
898 if {[winfo exists $w]} {
903 wm title $w "Gitk key bindings"
908 <Home> Move to first commit
909 <End> Move to last commit
910 <Up>, p, i Move up one commit
911 <Down>, n, k Move down one commit
912 <Left>, z, j Go back in history list
913 <Right>, x, l Go forward in history list
914 <PageUp> Move up one page in commit list
915 <PageDown> Move down one page in commit list
916 <Ctrl-Home> Scroll to top of commit list
917 <Ctrl-End> Scroll to bottom of commit list
918 <Ctrl-Up> Scroll commit list up one line
919 <Ctrl-Down> Scroll commit list down one line
920 <Ctrl-PageUp> Scroll commit list up one page
921 <Ctrl-PageDown> Scroll commit list down one page
922 <Shift-Up> Move to previous highlighted line
923 <Shift-Down> Move to next highlighted line
924 <Delete>, b Scroll diff view up one page
925 <Backspace> Scroll diff view up one page
926 <Space> Scroll diff view down one page
927 u Scroll diff view up 18 lines
928 d Scroll diff view down 18 lines
930 <Ctrl-G> Move to next find hit
931 <Return> Move to next find hit
932 / Move to next find hit, or redo find
933 ? Move to previous find hit
934 f Scroll diff view to next file
935 <Ctrl-S> Search for next hit in diff view
936 <Ctrl-R> Search for previous hit in diff view
937 <Ctrl-KP+> Increase font size
938 <Ctrl-plus> Increase font size
939 <Ctrl-KP-> Decrease font size
940 <Ctrl-minus> Decrease font size
942 -justify left -bg white -border 2 -relief sunken
943 pack $w.m -side top -fill both
944 button $w.ok -text Close -command "destroy $w"
945 pack $w.ok -side bottom
948 # Procedures for manipulating the file list window at the
949 # bottom right of the overall window.
951 proc treeview {w l openlevs} {
952 global treecontents treediropen treeheight treeparent treeindex
962 set treecontents() {}
963 $w conf -state normal
965 while {[string range $f 0 $prefixend] ne $prefix} {
966 if {$lev <= $openlevs} {
967 $w mark set e:$treeindex($prefix) "end -1c"
968 $w mark gravity e:$treeindex($prefix) left
970 set treeheight($prefix) $ht
971 incr ht [lindex $htstack end]
972 set htstack [lreplace $htstack end end]
973 set prefixend [lindex $prefendstack end]
974 set prefendstack [lreplace $prefendstack end end]
975 set prefix [string range $prefix 0 $prefixend]
978 set tail [string range $f [expr {$prefixend+1}] end]
979 while {[set slash [string first "/" $tail]] >= 0} {
982 lappend prefendstack $prefixend
983 incr prefixend [expr {$slash + 1}]
984 set d [string range $tail 0 $slash]
985 lappend treecontents($prefix) $d
986 set oldprefix $prefix
988 set treecontents($prefix) {}
989 set treeindex($prefix) [incr ix]
990 set treeparent($prefix) $oldprefix
991 set tail [string range $tail [expr {$slash+1}] end]
992 if {$lev <= $openlevs} {
994 set treediropen($prefix) [expr {$lev < $openlevs}]
995 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
996 $w mark set d:$ix "end -1c"
997 $w mark gravity d:$ix left
999 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1001 $w image create end -align center -image $bm -padx 1 \
1003 $w insert end $d [highlight_tag $prefix]
1004 $w mark set s:$ix "end -1c"
1005 $w mark gravity s:$ix left
1010 if {$lev <= $openlevs} {
1013 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1015 $w insert end $tail [highlight_tag $f]
1017 lappend treecontents($prefix) $tail
1020 while {$htstack ne {}} {
1021 set treeheight($prefix) $ht
1022 incr ht [lindex $htstack end]
1023 set htstack [lreplace $htstack end end]
1025 $w conf -state disabled
1028 proc linetoelt {l} {
1029 global treeheight treecontents
1034 foreach e $treecontents($prefix) {
1039 if {[string index $e end] eq "/"} {
1040 set n $treeheight($prefix$e)
1052 proc highlight_tree {y prefix} {
1053 global treeheight treecontents cflist
1055 foreach e $treecontents($prefix) {
1057 if {[highlight_tag $path] ne {}} {
1058 $cflist tag add bold $y.0 "$y.0 lineend"
1061 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1062 set y [highlight_tree $y $path]
1068 proc treeclosedir {w dir} {
1069 global treediropen treeheight treeparent treeindex
1071 set ix $treeindex($dir)
1072 $w conf -state normal
1073 $w delete s:$ix e:$ix
1074 set treediropen($dir) 0
1075 $w image configure a:$ix -image tri-rt
1076 $w conf -state disabled
1077 set n [expr {1 - $treeheight($dir)}]
1078 while {$dir ne {}} {
1079 incr treeheight($dir) $n
1080 set dir $treeparent($dir)
1084 proc treeopendir {w dir} {
1085 global treediropen treeheight treeparent treecontents treeindex
1087 set ix $treeindex($dir)
1088 $w conf -state normal
1089 $w image configure a:$ix -image tri-dn
1090 $w mark set e:$ix s:$ix
1091 $w mark gravity e:$ix right
1094 set n [llength $treecontents($dir)]
1095 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1098 incr treeheight($x) $n
1100 foreach e $treecontents($dir) {
1102 if {[string index $e end] eq "/"} {
1103 set iy $treeindex($de)
1104 $w mark set d:$iy e:$ix
1105 $w mark gravity d:$iy left
1106 $w insert e:$ix $str
1107 set treediropen($de) 0
1108 $w image create e:$ix -align center -image tri-rt -padx 1 \
1110 $w insert e:$ix $e [highlight_tag $de]
1111 $w mark set s:$iy e:$ix
1112 $w mark gravity s:$iy left
1113 set treeheight($de) 1
1115 $w insert e:$ix $str
1116 $w insert e:$ix $e [highlight_tag $de]
1119 $w mark gravity e:$ix left
1120 $w conf -state disabled
1121 set treediropen($dir) 1
1122 set top [lindex [split [$w index @0,0] .] 0]
1123 set ht [$w cget -height]
1124 set l [lindex [split [$w index s:$ix] .] 0]
1127 } elseif {$l + $n + 1 > $top + $ht} {
1128 set top [expr {$l + $n + 2 - $ht}]
1136 proc treeclick {w x y} {
1137 global treediropen cmitmode ctext cflist cflist_top
1139 if {$cmitmode ne "tree"} return
1140 if {![info exists cflist_top]} return
1141 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1142 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1143 $cflist tag add highlight $l.0 "$l.0 lineend"
1149 set e [linetoelt $l]
1150 if {[string index $e end] ne "/"} {
1152 } elseif {$treediropen($e)} {
1159 proc setfilelist {id} {
1160 global treefilelist cflist
1162 treeview $cflist $treefilelist($id) 0
1165 image create bitmap tri-rt -background black -foreground blue -data {
1166 #define tri-rt_width 13
1167 #define tri-rt_height 13
1168 static unsigned char tri-rt_bits[] = {
1169 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1170 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1173 #define tri-rt-mask_width 13
1174 #define tri-rt-mask_height 13
1175 static unsigned char tri-rt-mask_bits[] = {
1176 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1177 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1180 image create bitmap tri-dn -background black -foreground blue -data {
1181 #define tri-dn_width 13
1182 #define tri-dn_height 13
1183 static unsigned char tri-dn_bits[] = {
1184 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1185 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1188 #define tri-dn-mask_width 13
1189 #define tri-dn-mask_height 13
1190 static unsigned char tri-dn-mask_bits[] = {
1191 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1192 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1196 proc init_flist {first} {
1197 global cflist cflist_top selectedline difffilestart
1199 $cflist conf -state normal
1200 $cflist delete 0.0 end
1202 $cflist insert end $first
1204 $cflist tag add highlight 1.0 "1.0 lineend"
1206 catch {unset cflist_top}
1208 $cflist conf -state disabled
1209 set difffilestart {}
1212 proc highlight_tag {f} {
1213 global highlight_paths
1215 foreach p $highlight_paths {
1216 if {[string match $p $f]} {
1223 proc highlight_filelist {} {
1224 global cmitmode cflist
1226 $cflist conf -state normal
1227 if {$cmitmode ne "tree"} {
1228 set end [lindex [split [$cflist index end] .] 0]
1229 for {set l 2} {$l < $end} {incr l} {
1230 set line [$cflist get $l.0 "$l.0 lineend"]
1231 if {[highlight_tag $line] ne {}} {
1232 $cflist tag add bold $l.0 "$l.0 lineend"
1238 $cflist conf -state disabled
1241 proc unhighlight_filelist {} {
1244 $cflist conf -state normal
1245 $cflist tag remove bold 1.0 end
1246 $cflist conf -state disabled
1249 proc add_flist {fl} {
1252 $cflist conf -state normal
1254 $cflist insert end "\n"
1255 $cflist insert end $f [highlight_tag $f]
1257 $cflist conf -state disabled
1260 proc sel_flist {w x y} {
1261 global ctext difffilestart cflist cflist_top cmitmode
1263 if {$cmitmode eq "tree"} return
1264 if {![info exists cflist_top]} return
1265 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1266 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1267 $cflist tag add highlight $l.0 "$l.0 lineend"
1272 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1276 # Functions for adding and removing shell-type quoting
1278 proc shellquote {str} {
1279 if {![string match "*\['\"\\ \t]*" $str]} {
1282 if {![string match "*\['\"\\]*" $str]} {
1285 if {![string match "*'*" $str]} {
1288 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1291 proc shellarglist {l} {
1297 append str [shellquote $a]
1302 proc shelldequote {str} {
1307 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1308 append ret [string range $str $used end]
1309 set used [string length $str]
1312 set first [lindex $first 0]
1313 set ch [string index $str $first]
1314 if {$first > $used} {
1315 append ret [string range $str $used [expr {$first - 1}]]
1318 if {$ch eq " " || $ch eq "\t"} break
1321 set first [string first "'" $str $used]
1323 error "unmatched single-quote"
1325 append ret [string range $str $used [expr {$first - 1}]]
1330 if {$used >= [string length $str]} {
1331 error "trailing backslash"
1333 append ret [string index $str $used]
1338 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1339 error "unmatched double-quote"
1341 set first [lindex $first 0]
1342 set ch [string index $str $first]
1343 if {$first > $used} {
1344 append ret [string range $str $used [expr {$first - 1}]]
1347 if {$ch eq "\""} break
1349 append ret [string index $str $used]
1353 return [list $used $ret]
1356 proc shellsplit {str} {
1359 set str [string trimleft $str]
1360 if {$str eq {}} break
1361 set dq [shelldequote $str]
1362 set n [lindex $dq 0]
1363 set word [lindex $dq 1]
1364 set str [string range $str $n end]
1370 # Code to implement multiple views
1372 proc newview {ishighlight} {
1373 global nextviewnum newviewname newviewperm uifont newishighlight
1374 global newviewargs revtreeargs
1376 set newishighlight $ishighlight
1378 if {[winfo exists $top]} {
1382 set newviewname($nextviewnum) "View $nextviewnum"
1383 set newviewperm($nextviewnum) 0
1384 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1385 vieweditor $top $nextviewnum "Gitk view definition"
1390 global viewname viewperm newviewname newviewperm
1391 global viewargs newviewargs
1393 set top .gitkvedit-$curview
1394 if {[winfo exists $top]} {
1398 set newviewname($curview) $viewname($curview)
1399 set newviewperm($curview) $viewperm($curview)
1400 set newviewargs($curview) [shellarglist $viewargs($curview)]
1401 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1404 proc vieweditor {top n title} {
1405 global newviewname newviewperm viewfiles
1409 wm title $top $title
1410 label $top.nl -text "Name" -font $uifont
1411 entry $top.name -width 20 -textvariable newviewname($n)
1412 grid $top.nl $top.name -sticky w -pady 5
1413 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1414 grid $top.perm - -pady 5 -sticky w
1415 message $top.al -aspect 1000 -font $uifont \
1416 -text "Commits to include (arguments to git rev-list):"
1417 grid $top.al - -sticky w -pady 5
1418 entry $top.args -width 50 -textvariable newviewargs($n) \
1420 grid $top.args - -sticky ew -padx 5
1421 message $top.l -aspect 1000 -font $uifont \
1422 -text "Enter files and directories to include, one per line:"
1423 grid $top.l - -sticky w
1424 text $top.t -width 40 -height 10 -background white
1425 if {[info exists viewfiles($n)]} {
1426 foreach f $viewfiles($n) {
1427 $top.t insert end $f
1428 $top.t insert end "\n"
1430 $top.t delete {end - 1c} end
1431 $top.t mark set insert 0.0
1433 grid $top.t - -sticky ew -padx 5
1435 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1436 button $top.buts.can -text "Cancel" -command [list destroy $top]
1437 grid $top.buts.ok $top.buts.can
1438 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1439 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1440 grid $top.buts - -pady 10 -sticky ew
1444 proc doviewmenu {m first cmd op argv} {
1445 set nmenu [$m index end]
1446 for {set i $first} {$i <= $nmenu} {incr i} {
1447 if {[$m entrycget $i -command] eq $cmd} {
1448 eval $m $op $i $argv
1454 proc allviewmenus {n op args} {
1457 doviewmenu .bar.view 7 [list showview $n] $op $args
1458 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1461 proc newviewok {top n} {
1462 global nextviewnum newviewperm newviewname newishighlight
1463 global viewname viewfiles viewperm selectedview curview
1464 global viewargs newviewargs viewhlmenu
1467 set newargs [shellsplit $newviewargs($n)]
1469 error_popup "Error in commit selection arguments: $err"
1475 foreach f [split [$top.t get 0.0 end] "\n"] {
1476 set ft [string trim $f]
1481 if {![info exists viewfiles($n)]} {
1482 # creating a new view
1484 set viewname($n) $newviewname($n)
1485 set viewperm($n) $newviewperm($n)
1486 set viewfiles($n) $files
1487 set viewargs($n) $newargs
1489 if {!$newishighlight} {
1490 after idle showview $n
1492 after idle addvhighlight $n
1495 # editing an existing view
1496 set viewperm($n) $newviewperm($n)
1497 if {$newviewname($n) ne $viewname($n)} {
1498 set viewname($n) $newviewname($n)
1499 doviewmenu .bar.view 7 [list showview $n] \
1500 entryconf [list -label $viewname($n)]
1501 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1502 entryconf [list -label $viewname($n) -value $viewname($n)]
1504 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1505 set viewfiles($n) $files
1506 set viewargs($n) $newargs
1507 if {$curview == $n} {
1508 after idle updatecommits
1512 catch {destroy $top}
1516 global curview viewdata viewperm hlview selectedhlview
1518 if {$curview == 0} return
1519 if {[info exists hlview] && $hlview == $curview} {
1520 set selectedhlview None
1523 allviewmenus $curview delete
1524 set viewdata($curview) {}
1525 set viewperm($curview) 0
1529 proc addviewmenu {n} {
1530 global viewname viewhlmenu
1532 .bar.view add radiobutton -label $viewname($n) \
1533 -command [list showview $n] -variable selectedview -value $n
1534 $viewhlmenu add radiobutton -label $viewname($n) \
1535 -command [list addvhighlight $n] -variable selectedhlview
1538 proc flatten {var} {
1542 foreach i [array names $var] {
1543 lappend ret $i [set $var\($i\)]
1548 proc unflatten {var l} {
1558 global curview viewdata viewfiles
1559 global displayorder parentlist childlist rowidlist rowoffsets
1560 global colormap rowtextx commitrow nextcolor canvxmax
1561 global numcommits rowrangelist commitlisted idrowranges
1562 global selectedline currentid canv canvy0
1563 global matchinglines treediffs
1564 global pending_select phase
1565 global commitidx rowlaidout rowoptim linesegends
1566 global commfd nextupdate
1568 global vparentlist vchildlist vdisporder vcmitlisted
1569 global hlview selectedhlview
1571 if {$n == $curview} return
1573 if {[info exists selectedline]} {
1574 set selid $currentid
1575 set y [yc $selectedline]
1576 set ymax [lindex [$canv cget -scrollregion] 3]
1577 set span [$canv yview]
1578 set ytop [expr {[lindex $span 0] * $ymax}]
1579 set ybot [expr {[lindex $span 1] * $ymax}]
1580 if {$ytop < $y && $y < $ybot} {
1581 set yscreen [expr {$y - $ytop}]
1583 set yscreen [expr {($ybot - $ytop) / 2}]
1589 if {$curview >= 0} {
1590 set vparentlist($curview) $parentlist
1591 set vchildlist($curview) $childlist
1592 set vdisporder($curview) $displayorder
1593 set vcmitlisted($curview) $commitlisted
1595 set viewdata($curview) \
1596 [list $phase $rowidlist $rowoffsets $rowrangelist \
1597 [flatten idrowranges] [flatten idinlist] \
1598 $rowlaidout $rowoptim $numcommits $linesegends]
1599 } elseif {![info exists viewdata($curview)]
1600 || [lindex $viewdata($curview) 0] ne {}} {
1601 set viewdata($curview) \
1602 [list {} $rowidlist $rowoffsets $rowrangelist]
1605 catch {unset matchinglines}
1606 catch {unset treediffs}
1608 if {[info exists hlview] && $hlview == $n} {
1610 set selectedhlview None
1615 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1616 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1618 if {![info exists viewdata($n)]} {
1619 set pending_select $selid
1625 set phase [lindex $v 0]
1626 set displayorder $vdisporder($n)
1627 set parentlist $vparentlist($n)
1628 set childlist $vchildlist($n)
1629 set commitlisted $vcmitlisted($n)
1630 set rowidlist [lindex $v 1]
1631 set rowoffsets [lindex $v 2]
1632 set rowrangelist [lindex $v 3]
1634 set numcommits [llength $displayorder]
1635 catch {unset idrowranges}
1637 unflatten idrowranges [lindex $v 4]
1638 unflatten idinlist [lindex $v 5]
1639 set rowlaidout [lindex $v 6]
1640 set rowoptim [lindex $v 7]
1641 set numcommits [lindex $v 8]
1642 set linesegends [lindex $v 9]
1645 catch {unset colormap}
1646 catch {unset rowtextx}
1648 set canvxmax [$canv cget -width]
1654 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1655 set row $commitrow($n,$selid)
1656 # try to get the selected row in the same position on the screen
1657 set ymax [lindex [$canv cget -scrollregion] 3]
1658 set ytop [expr {[yc $row] - $yscreen}]
1662 set yf [expr {$ytop * 1.0 / $ymax}]
1664 allcanvs yview moveto $yf
1668 if {$phase eq "getcommits"} {
1669 show_status "Reading commits..."
1671 if {[info exists commfd($n)]} {
1676 } elseif {$numcommits == 0} {
1677 show_status "No commits selected"
1681 # Stuff relating to the highlighting facility
1683 proc ishighlighted {row} {
1684 global vhighlights fhighlights nhighlights rhighlights
1686 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1687 return $nhighlights($row)
1689 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1690 return $vhighlights($row)
1692 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1693 return $fhighlights($row)
1695 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1696 return $rhighlights($row)
1701 proc bolden {row font} {
1702 global canv linehtag selectedline boldrows
1704 lappend boldrows $row
1705 $canv itemconf $linehtag($row) -font $font
1706 if {[info exists selectedline] && $row == $selectedline} {
1708 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1709 -outline {{}} -tags secsel \
1710 -fill [$canv cget -selectbackground]]
1715 proc bolden_name {row font} {
1716 global canv2 linentag selectedline boldnamerows
1718 lappend boldnamerows $row
1719 $canv2 itemconf $linentag($row) -font $font
1720 if {[info exists selectedline] && $row == $selectedline} {
1721 $canv2 delete secsel
1722 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1723 -outline {{}} -tags secsel \
1724 -fill [$canv2 cget -selectbackground]]
1730 global mainfont boldrows
1733 foreach row $boldrows {
1734 if {![ishighlighted $row]} {
1735 bolden $row $mainfont
1737 lappend stillbold $row
1740 set boldrows $stillbold
1743 proc addvhighlight {n} {
1744 global hlview curview viewdata vhl_done vhighlights commitidx
1746 if {[info exists hlview]} {
1750 if {$n != $curview && ![info exists viewdata($n)]} {
1751 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1752 set vparentlist($n) {}
1753 set vchildlist($n) {}
1754 set vdisporder($n) {}
1755 set vcmitlisted($n) {}
1758 set vhl_done $commitidx($hlview)
1759 if {$vhl_done > 0} {
1764 proc delvhighlight {} {
1765 global hlview vhighlights
1767 if {![info exists hlview]} return
1769 catch {unset vhighlights}
1773 proc vhighlightmore {} {
1774 global hlview vhl_done commitidx vhighlights
1775 global displayorder vdisporder curview mainfont
1777 set font [concat $mainfont bold]
1778 set max $commitidx($hlview)
1779 if {$hlview == $curview} {
1780 set disp $displayorder
1782 set disp $vdisporder($hlview)
1784 set vr [visiblerows]
1785 set r0 [lindex $vr 0]
1786 set r1 [lindex $vr 1]
1787 for {set i $vhl_done} {$i < $max} {incr i} {
1788 set id [lindex $disp $i]
1789 if {[info exists commitrow($curview,$id)]} {
1790 set row $commitrow($curview,$id)
1791 if {$r0 <= $row && $row <= $r1} {
1792 if {![highlighted $row]} {
1795 set vhighlights($row) 1
1802 proc askvhighlight {row id} {
1803 global hlview vhighlights commitrow iddrawn mainfont
1805 if {[info exists commitrow($hlview,$id)]} {
1806 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1807 bolden $row [concat $mainfont bold]
1809 set vhighlights($row) 1
1811 set vhighlights($row) 0
1815 proc hfiles_change {name ix op} {
1816 global highlight_files filehighlight fhighlights fh_serial
1817 global mainfont highlight_paths
1819 if {[info exists filehighlight]} {
1820 # delete previous highlights
1821 catch {close $filehighlight}
1823 catch {unset fhighlights}
1825 unhighlight_filelist
1827 set highlight_paths {}
1828 after cancel do_file_hl $fh_serial
1830 if {$highlight_files ne {}} {
1831 after 300 do_file_hl $fh_serial
1835 proc makepatterns {l} {
1838 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1839 if {[string index $ee end] eq "/"} {
1849 proc do_file_hl {serial} {
1850 global highlight_files filehighlight highlight_paths gdttype fhl_list
1852 if {$gdttype eq "touching paths:"} {
1853 if {[catch {set paths [shellsplit $highlight_files]}]} return
1854 set highlight_paths [makepatterns $paths]
1856 set gdtargs [concat -- $paths]
1858 set gdtargs [list "-S$highlight_files"]
1860 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1861 set filehighlight [open $cmd r+]
1862 fconfigure $filehighlight -blocking 0
1863 fileevent $filehighlight readable readfhighlight
1869 proc flushhighlights {} {
1870 global filehighlight fhl_list
1872 if {[info exists filehighlight]} {
1874 puts $filehighlight ""
1875 flush $filehighlight
1879 proc askfilehighlight {row id} {
1880 global filehighlight fhighlights fhl_list
1882 lappend fhl_list $id
1883 set fhighlights($row) -1
1884 puts $filehighlight $id
1887 proc readfhighlight {} {
1888 global filehighlight fhighlights commitrow curview mainfont iddrawn
1891 while {[gets $filehighlight line] >= 0} {
1892 set line [string trim $line]
1893 set i [lsearch -exact $fhl_list $line]
1894 if {$i < 0} continue
1895 for {set j 0} {$j < $i} {incr j} {
1896 set id [lindex $fhl_list $j]
1897 if {[info exists commitrow($curview,$id)]} {
1898 set fhighlights($commitrow($curview,$id)) 0
1901 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1902 if {$line eq {}} continue
1903 if {![info exists commitrow($curview,$line)]} continue
1904 set row $commitrow($curview,$line)
1905 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1906 bolden $row [concat $mainfont bold]
1908 set fhighlights($row) 1
1910 if {[eof $filehighlight]} {
1912 puts "oops, git-diff-tree died"
1913 catch {close $filehighlight}
1919 proc find_change {name ix op} {
1920 global nhighlights mainfont boldnamerows
1921 global findstring findpattern findtype
1923 # delete previous highlights, if any
1924 foreach row $boldnamerows {
1925 bolden_name $row $mainfont
1928 catch {unset nhighlights}
1930 if {$findtype ne "Regexp"} {
1931 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1933 set findpattern "*$e*"
1938 proc askfindhighlight {row id} {
1939 global nhighlights commitinfo iddrawn mainfont
1940 global findstring findtype findloc findpattern
1942 if {![info exists commitinfo($id)]} {
1945 set info $commitinfo($id)
1947 set fldtypes {Headline Author Date Committer CDate Comments}
1948 foreach f $info ty $fldtypes {
1949 if {$findloc ne "All fields" && $findloc ne $ty} {
1952 if {$findtype eq "Regexp"} {
1953 set doesmatch [regexp $findstring $f]
1954 } elseif {$findtype eq "IgnCase"} {
1955 set doesmatch [string match -nocase $findpattern $f]
1957 set doesmatch [string match $findpattern $f]
1960 if {$ty eq "Author"} {
1967 if {[info exists iddrawn($id)]} {
1968 if {$isbold && ![ishighlighted $row]} {
1969 bolden $row [concat $mainfont bold]
1972 bolden_name $row [concat $mainfont bold]
1975 set nhighlights($row) $isbold
1978 proc vrel_change {name ix op} {
1979 global highlight_related
1982 if {$highlight_related ne "None"} {
1983 after idle drawvisible
1987 # prepare for testing whether commits are descendents or ancestors of a
1988 proc rhighlight_sel {a} {
1989 global descendent desc_todo ancestor anc_todo
1990 global highlight_related rhighlights
1992 catch {unset descendent}
1993 set desc_todo [list $a]
1994 catch {unset ancestor}
1995 set anc_todo [list $a]
1996 if {$highlight_related ne "None"} {
1998 after idle drawvisible
2002 proc rhighlight_none {} {
2005 catch {unset rhighlights}
2009 proc is_descendent {a} {
2010 global curview children commitrow descendent desc_todo
2013 set la $commitrow($v,$a)
2017 for {set i 0} {$i < [llength $todo]} {incr i} {
2018 set do [lindex $todo $i]
2019 if {$commitrow($v,$do) < $la} {
2020 lappend leftover $do
2023 foreach nk $children($v,$do) {
2024 if {![info exists descendent($nk)]} {
2025 set descendent($nk) 1
2033 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2037 set descendent($a) 0
2038 set desc_todo $leftover
2041 proc is_ancestor {a} {
2042 global curview parentlist commitrow ancestor anc_todo
2045 set la $commitrow($v,$a)
2049 for {set i 0} {$i < [llength $todo]} {incr i} {
2050 set do [lindex $todo $i]
2051 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2052 lappend leftover $do
2055 foreach np [lindex $parentlist $commitrow($v,$do)] {
2056 if {![info exists ancestor($np)]} {
2065 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2070 set anc_todo $leftover
2073 proc askrelhighlight {row id} {
2074 global descendent highlight_related iddrawn mainfont rhighlights
2075 global selectedline ancestor
2077 if {![info exists selectedline]} return
2079 if {$highlight_related eq "Descendent" ||
2080 $highlight_related eq "Not descendent"} {
2081 if {![info exists descendent($id)]} {
2084 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2087 } elseif {$highlight_related eq "Ancestor" ||
2088 $highlight_related eq "Not ancestor"} {
2089 if {![info exists ancestor($id)]} {
2092 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2096 if {[info exists iddrawn($id)]} {
2097 if {$isbold && ![ishighlighted $row]} {
2098 bolden $row [concat $mainfont bold]
2101 set rhighlights($row) $isbold
2104 proc next_hlcont {} {
2105 global fhl_row fhl_dirn displayorder numcommits
2106 global vhighlights fhighlights nhighlights rhighlights
2107 global hlview filehighlight findstring highlight_related
2109 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2112 if {$row < 0 || $row >= $numcommits} {
2117 set id [lindex $displayorder $row]
2118 if {[info exists hlview]} {
2119 if {![info exists vhighlights($row)]} {
2120 askvhighlight $row $id
2122 if {$vhighlights($row) > 0} break
2124 if {$findstring ne {}} {
2125 if {![info exists nhighlights($row)]} {
2126 askfindhighlight $row $id
2128 if {$nhighlights($row) > 0} break
2130 if {$highlight_related ne "None"} {
2131 if {![info exists rhighlights($row)]} {
2132 askrelhighlight $row $id
2134 if {$rhighlights($row) > 0} break
2136 if {[info exists filehighlight]} {
2137 if {![info exists fhighlights($row)]} {
2138 # ask for a few more while we're at it...
2140 for {set n 0} {$n < 100} {incr n} {
2141 if {![info exists fhighlights($r)]} {
2142 askfilehighlight $r [lindex $displayorder $r]
2145 if {$r < 0 || $r >= $numcommits} break
2149 if {$fhighlights($row) < 0} {
2153 if {$fhighlights($row) > 0} break
2161 proc next_highlight {dirn} {
2162 global selectedline fhl_row fhl_dirn
2163 global hlview filehighlight findstring highlight_related
2165 if {![info exists selectedline]} return
2166 if {!([info exists hlview] || $findstring ne {} ||
2167 $highlight_related ne "None" || [info exists filehighlight])} return
2168 set fhl_row [expr {$selectedline + $dirn}]
2173 proc cancel_next_highlight {} {
2179 # Graph layout functions
2181 proc shortids {ids} {
2184 if {[llength $id] > 1} {
2185 lappend res [shortids $id]
2186 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2187 lappend res [string range $id 0 7]
2195 proc incrange {l x o} {
2198 set e [lindex $l $x]
2200 lset l $x [expr {$e + $o}]
2209 for {} {$n > 0} {incr n -1} {
2215 proc usedinrange {id l1 l2} {
2216 global children commitrow childlist curview
2218 if {[info exists commitrow($curview,$id)]} {
2219 set r $commitrow($curview,$id)
2220 if {$l1 <= $r && $r <= $l2} {
2221 return [expr {$r - $l1 + 1}]
2223 set kids [lindex $childlist $r]
2225 set kids $children($curview,$id)
2228 set r $commitrow($curview,$c)
2229 if {$l1 <= $r && $r <= $l2} {
2230 return [expr {$r - $l1 + 1}]
2236 proc sanity {row {full 0}} {
2237 global rowidlist rowoffsets
2240 set ids [lindex $rowidlist $row]
2243 if {$id eq {}} continue
2244 if {$col < [llength $ids] - 1 &&
2245 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2246 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2248 set o [lindex $rowoffsets $row $col]
2254 if {[lindex $rowidlist $y $x] != $id} {
2255 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2256 puts " id=[shortids $id] check started at row $row"
2257 for {set i $row} {$i >= $y} {incr i -1} {
2258 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2263 set o [lindex $rowoffsets $y $x]
2268 proc makeuparrow {oid x y z} {
2269 global rowidlist rowoffsets uparrowlen idrowranges
2271 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2274 set off0 [lindex $rowoffsets $y]
2275 for {set x0 $x} {1} {incr x0} {
2276 if {$x0 >= [llength $off0]} {
2277 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2280 set z [lindex $off0 $x0]
2286 set z [expr {$x0 - $x}]
2287 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2288 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2290 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2291 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2292 lappend idrowranges($oid) $y
2295 proc initlayout {} {
2296 global rowidlist rowoffsets displayorder commitlisted
2297 global rowlaidout rowoptim
2298 global idinlist rowchk rowrangelist idrowranges
2299 global numcommits canvxmax canv
2301 global parentlist childlist children
2302 global colormap rowtextx
2314 catch {unset idinlist}
2315 catch {unset rowchk}
2318 set canvxmax [$canv cget -width]
2319 catch {unset colormap}
2320 catch {unset rowtextx}
2321 catch {unset idrowranges}
2325 proc setcanvscroll {} {
2326 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2328 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2329 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2330 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2331 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2334 proc visiblerows {} {
2335 global canv numcommits linespc
2337 set ymax [lindex [$canv cget -scrollregion] 3]
2338 if {$ymax eq {} || $ymax == 0} return
2340 set y0 [expr {int([lindex $f 0] * $ymax)}]
2341 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2345 set y1 [expr {int([lindex $f 1] * $ymax)}]
2346 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2347 if {$r1 >= $numcommits} {
2348 set r1 [expr {$numcommits - 1}]
2350 return [list $r0 $r1]
2353 proc layoutmore {} {
2354 global rowlaidout rowoptim commitidx numcommits optim_delay
2355 global uparrowlen curview
2358 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2359 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2360 if {$orow > $rowoptim} {
2361 optimize_rows $rowoptim 0 $orow
2364 set canshow [expr {$rowoptim - $optim_delay}]
2365 if {$canshow > $numcommits} {
2370 proc showstuff {canshow} {
2371 global numcommits commitrow pending_select selectedline
2372 global linesegends idrowranges idrangedrawn curview
2374 if {$numcommits == 0} {
2376 set phase "incrdraw"
2380 set numcommits $canshow
2382 set rows [visiblerows]
2383 set r0 [lindex $rows 0]
2384 set r1 [lindex $rows 1]
2386 for {set r $row} {$r < $canshow} {incr r} {
2387 foreach id [lindex $linesegends [expr {$r+1}]] {
2389 foreach {s e} [rowranges $id] {
2391 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2392 && ![info exists idrangedrawn($id,$i)]} {
2394 set idrangedrawn($id,$i) 1
2399 if {$canshow > $r1} {
2402 while {$row < $canshow} {
2406 if {[info exists pending_select] &&
2407 [info exists commitrow($curview,$pending_select)] &&
2408 $commitrow($curview,$pending_select) < $numcommits} {
2409 selectline $commitrow($curview,$pending_select) 1
2411 if {![info exists selectedline] && ![info exists pending_select]} {
2416 proc layoutrows {row endrow last} {
2417 global rowidlist rowoffsets displayorder
2418 global uparrowlen downarrowlen maxwidth mingaplen
2419 global childlist parentlist
2420 global idrowranges linesegends
2421 global commitidx curview
2422 global idinlist rowchk rowrangelist
2424 set idlist [lindex $rowidlist $row]
2425 set offs [lindex $rowoffsets $row]
2426 while {$row < $endrow} {
2427 set id [lindex $displayorder $row]
2430 foreach p [lindex $parentlist $row] {
2431 if {![info exists idinlist($p)]} {
2433 } elseif {!$idinlist($p)} {
2438 set nev [expr {[llength $idlist] + [llength $newolds]
2439 + [llength $oldolds] - $maxwidth + 1}]
2442 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2443 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2444 set i [lindex $idlist $x]
2445 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2446 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2447 [expr {$row + $uparrowlen + $mingaplen}]]
2449 set idlist [lreplace $idlist $x $x]
2450 set offs [lreplace $offs $x $x]
2451 set offs [incrange $offs $x 1]
2453 set rm1 [expr {$row - 1}]
2455 lappend idrowranges($i) $rm1
2456 if {[incr nev -1] <= 0} break
2459 set rowchk($id) [expr {$row + $r}]
2462 lset rowidlist $row $idlist
2463 lset rowoffsets $row $offs
2465 lappend linesegends $lse
2466 set col [lsearch -exact $idlist $id]
2468 set col [llength $idlist]
2470 lset rowidlist $row $idlist
2472 if {[lindex $childlist $row] ne {}} {
2473 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2477 lset rowoffsets $row $offs
2479 makeuparrow $id $col $row $z
2485 if {[info exists idrowranges($id)]} {
2486 set ranges $idrowranges($id)
2488 unset idrowranges($id)
2490 lappend rowrangelist $ranges
2492 set offs [ntimes [llength $idlist] 0]
2493 set l [llength $newolds]
2494 set idlist [eval lreplace \$idlist $col $col $newolds]
2497 set offs [lrange $offs 0 [expr {$col - 1}]]
2498 foreach x $newolds {
2503 set tmp [expr {[llength $idlist] - [llength $offs]}]
2505 set offs [concat $offs [ntimes $tmp $o]]
2510 foreach i $newolds {
2512 set idrowranges($i) $row
2515 foreach oid $oldolds {
2516 set idinlist($oid) 1
2517 set idlist [linsert $idlist $col $oid]
2518 set offs [linsert $offs $col $o]
2519 makeuparrow $oid $col $row $o
2522 lappend rowidlist $idlist
2523 lappend rowoffsets $offs
2528 proc addextraid {id row} {
2529 global displayorder commitrow commitinfo
2530 global commitidx commitlisted
2531 global parentlist childlist children curview
2533 incr commitidx($curview)
2534 lappend displayorder $id
2535 lappend commitlisted 0
2536 lappend parentlist {}
2537 set commitrow($curview,$id) $row
2539 if {![info exists commitinfo($id)]} {
2540 set commitinfo($id) {"No commit information available"}
2542 if {![info exists children($curview,$id)]} {
2543 set children($curview,$id) {}
2545 lappend childlist $children($curview,$id)
2548 proc layouttail {} {
2549 global rowidlist rowoffsets idinlist commitidx curview
2550 global idrowranges rowrangelist
2552 set row $commitidx($curview)
2553 set idlist [lindex $rowidlist $row]
2554 while {$idlist ne {}} {
2555 set col [expr {[llength $idlist] - 1}]
2556 set id [lindex $idlist $col]
2559 lappend idrowranges($id) $row
2560 lappend rowrangelist $idrowranges($id)
2561 unset idrowranges($id)
2563 set offs [ntimes $col 0]
2564 set idlist [lreplace $idlist $col $col]
2565 lappend rowidlist $idlist
2566 lappend rowoffsets $offs
2569 foreach id [array names idinlist] {
2571 lset rowidlist $row [list $id]
2572 lset rowoffsets $row 0
2573 makeuparrow $id 0 $row 0
2574 lappend idrowranges($id) $row
2575 lappend rowrangelist $idrowranges($id)
2576 unset idrowranges($id)
2578 lappend rowidlist {}
2579 lappend rowoffsets {}
2583 proc insert_pad {row col npad} {
2584 global rowidlist rowoffsets
2586 set pad [ntimes $npad {}]
2587 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2588 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2589 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2592 proc optimize_rows {row col endrow} {
2593 global rowidlist rowoffsets idrowranges displayorder
2595 for {} {$row < $endrow} {incr row} {
2596 set idlist [lindex $rowidlist $row]
2597 set offs [lindex $rowoffsets $row]
2599 for {} {$col < [llength $offs]} {incr col} {
2600 if {[lindex $idlist $col] eq {}} {
2604 set z [lindex $offs $col]
2605 if {$z eq {}} continue
2607 set x0 [expr {$col + $z}]
2608 set y0 [expr {$row - 1}]
2609 set z0 [lindex $rowoffsets $y0 $x0]
2611 set id [lindex $idlist $col]
2612 set ranges [rowranges $id]
2613 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2617 if {$z < -1 || ($z < 0 && $isarrow)} {
2618 set npad [expr {-1 - $z + $isarrow}]
2619 set offs [incrange $offs $col $npad]
2620 insert_pad $y0 $x0 $npad
2622 optimize_rows $y0 $x0 $row
2624 set z [lindex $offs $col]
2625 set x0 [expr {$col + $z}]
2626 set z0 [lindex $rowoffsets $y0 $x0]
2627 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2628 set npad [expr {$z - 1 + $isarrow}]
2629 set y1 [expr {$row + 1}]
2630 set offs2 [lindex $rowoffsets $y1]
2634 if {$z eq {} || $x1 + $z < $col} continue
2635 if {$x1 + $z > $col} {
2638 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2641 set pad [ntimes $npad {}]
2642 set idlist [eval linsert \$idlist $col $pad]
2643 set tmp [eval linsert \$offs $col $pad]
2645 set offs [incrange $tmp $col [expr {-$npad}]]
2646 set z [lindex $offs $col]
2649 if {$z0 eq {} && !$isarrow} {
2650 # this line links to its first child on row $row-2
2651 set rm2 [expr {$row - 2}]
2652 set id [lindex $displayorder $rm2]
2653 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2655 set z0 [expr {$xc - $x0}]
2658 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2659 insert_pad $y0 $x0 1
2660 set offs [incrange $offs $col 1]
2661 optimize_rows $y0 [expr {$x0 + 1}] $row
2666 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2667 set o [lindex $offs $col]
2669 # check if this is the link to the first child
2670 set id [lindex $idlist $col]
2671 set ranges [rowranges $id]
2672 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2673 # it is, work out offset to child
2674 set y0 [expr {$row - 1}]
2675 set id [lindex $displayorder $y0]
2676 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2678 set o [expr {$x0 - $col}]
2682 if {$o eq {} || $o <= 0} break
2684 if {$o ne {} && [incr col] < [llength $idlist]} {
2685 set y1 [expr {$row + 1}]
2686 set offs2 [lindex $rowoffsets $y1]
2690 if {$z eq {} || $x1 + $z < $col} continue
2691 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2694 set idlist [linsert $idlist $col {}]
2695 set tmp [linsert $offs $col {}]
2697 set offs [incrange $tmp $col -1]
2700 lset rowidlist $row $idlist
2701 lset rowoffsets $row $offs
2707 global canvx0 linespc
2708 return [expr {$canvx0 + $col * $linespc}]
2712 global canvy0 linespc
2713 return [expr {$canvy0 + $row * $linespc}]
2716 proc linewidth {id} {
2717 global thickerline lthickness
2720 if {[info exists thickerline] && $id eq $thickerline} {
2721 set wid [expr {2 * $lthickness}]
2726 proc rowranges {id} {
2727 global phase idrowranges commitrow rowlaidout rowrangelist curview
2731 ([info exists commitrow($curview,$id)]
2732 && $commitrow($curview,$id) < $rowlaidout)} {
2733 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2734 } elseif {[info exists idrowranges($id)]} {
2735 set ranges $idrowranges($id)
2740 proc drawlineseg {id i} {
2741 global rowoffsets rowidlist
2743 global canv colormap linespc
2744 global numcommits commitrow curview
2746 set ranges [rowranges $id]
2748 if {[info exists commitrow($curview,$id)]
2749 && $commitrow($curview,$id) < $numcommits} {
2750 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2754 set startrow [lindex $ranges [expr {2 * $i}]]
2755 set row [lindex $ranges [expr {2 * $i + 1}]]
2756 if {$startrow == $row} return
2759 set col [lsearch -exact [lindex $rowidlist $row] $id]
2761 puts "oops: drawline: id $id not on row $row"
2767 set o [lindex $rowoffsets $row $col]
2770 # changing direction
2771 set x [xc $row $col]
2773 lappend coords $x $y
2779 set x [xc $row $col]
2781 lappend coords $x $y
2783 # draw the link to the first child as part of this line
2785 set child [lindex $displayorder $row]
2786 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2788 set x [xc $row $ccol]
2790 if {$ccol < $col - 1} {
2791 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2792 } elseif {$ccol > $col + 1} {
2793 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2795 lappend coords $x $y
2798 if {[llength $coords] < 4} return
2800 # This line has an arrow at the lower end: check if the arrow is
2801 # on a diagonal segment, and if so, work around the Tk 8.4
2802 # refusal to draw arrows on diagonal lines.
2803 set x0 [lindex $coords 0]
2804 set x1 [lindex $coords 2]
2806 set y0 [lindex $coords 1]
2807 set y1 [lindex $coords 3]
2808 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2809 # we have a nearby vertical segment, just trim off the diag bit
2810 set coords [lrange $coords 2 end]
2812 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2813 set xi [expr {$x0 - $slope * $linespc / 2}]
2814 set yi [expr {$y0 - $linespc / 2}]
2815 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2819 set arrow [expr {2 * ($i > 0) + $downarrow}]
2820 set arrow [lindex {none first last both} $arrow]
2821 set t [$canv create line $coords -width [linewidth $id] \
2822 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2827 proc drawparentlinks {id row col olds} {
2828 global rowidlist canv colormap
2830 set row2 [expr {$row + 1}]
2831 set x [xc $row $col]
2834 set ids [lindex $rowidlist $row2]
2835 # rmx = right-most X coord used
2838 set i [lsearch -exact $ids $p]
2840 puts "oops, parent $p of $id not in list"
2843 set x2 [xc $row2 $i]
2847 set ranges [rowranges $p]
2848 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2849 && $row2 < [lindex $ranges 1]} {
2850 # drawlineseg will do this one for us
2854 # should handle duplicated parents here...
2855 set coords [list $x $y]
2856 if {$i < $col - 1} {
2857 lappend coords [xc $row [expr {$i + 1}]] $y
2858 } elseif {$i > $col + 1} {
2859 lappend coords [xc $row [expr {$i - 1}]] $y
2861 lappend coords $x2 $y2
2862 set t [$canv create line $coords -width [linewidth $p] \
2863 -fill $colormap($p) -tags lines.$p]
2870 proc drawlines {id} {
2871 global colormap canv
2873 global children iddrawn commitrow rowidlist curview
2875 $canv delete lines.$id
2876 set nr [expr {[llength [rowranges $id]] / 2}]
2877 for {set i 0} {$i < $nr} {incr i} {
2878 if {[info exists idrangedrawn($id,$i)]} {
2882 foreach child $children($curview,$id) {
2883 if {[info exists iddrawn($child)]} {
2884 set row $commitrow($curview,$child)
2885 set col [lsearch -exact [lindex $rowidlist $row] $child]
2887 drawparentlinks $child $row $col [list $id]
2893 proc drawcmittext {id row col rmx} {
2894 global linespc canv canv2 canv3 canvy0 fgcolor
2895 global commitlisted commitinfo rowidlist
2896 global rowtextx idpos idtags idheads idotherrefs
2897 global linehtag linentag linedtag
2898 global mainfont canvxmax boldrows boldnamerows fgcolor
2900 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2901 set x [xc $row $col]
2903 set orad [expr {$linespc / 3}]
2904 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2905 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2906 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2908 $canv bind $t <1> {selcanvline {} %x %y}
2909 set xt [xc $row [llength [lindex $rowidlist $row]]]
2913 set rowtextx($row) $xt
2914 set idpos($id) [list $x $xt $y]
2915 if {[info exists idtags($id)] || [info exists idheads($id)]
2916 || [info exists idotherrefs($id)]} {
2917 set xt [drawtags $id $x $xt $y]
2919 set headline [lindex $commitinfo($id) 0]
2920 set name [lindex $commitinfo($id) 1]
2921 set date [lindex $commitinfo($id) 2]
2922 set date [formatdate $date]
2925 set isbold [ishighlighted $row]
2927 lappend boldrows $row
2930 lappend boldnamerows $row
2934 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2935 -text $headline -font $font -tags text]
2936 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2937 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2938 -text $name -font $nfont -tags text]
2939 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2940 -text $date -font $mainfont -tags text]
2941 set xr [expr {$xt + [font measure $mainfont $headline]}]
2942 if {$xr > $canvxmax} {
2948 proc drawcmitrow {row} {
2949 global displayorder rowidlist
2950 global idrangedrawn iddrawn
2951 global commitinfo parentlist numcommits
2952 global filehighlight fhighlights findstring nhighlights
2953 global hlview vhighlights
2954 global highlight_related rhighlights
2956 if {$row >= $numcommits} return
2957 foreach id [lindex $rowidlist $row] {
2958 if {$id eq {}} continue
2960 foreach {s e} [rowranges $id] {
2962 if {$row < $s} continue
2965 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2967 set idrangedrawn($id,$i) 1
2974 set id [lindex $displayorder $row]
2975 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2976 askvhighlight $row $id
2978 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2979 askfilehighlight $row $id
2981 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2982 askfindhighlight $row $id
2984 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2985 askrelhighlight $row $id
2987 if {[info exists iddrawn($id)]} return
2988 set col [lsearch -exact [lindex $rowidlist $row] $id]
2990 puts "oops, row $row id $id not in list"
2993 if {![info exists commitinfo($id)]} {
2997 set olds [lindex $parentlist $row]
2999 set rmx [drawparentlinks $id $row $col $olds]
3003 drawcmittext $id $row $col $rmx
3007 proc drawfrac {f0 f1} {
3008 global numcommits canv
3011 set ymax [lindex [$canv cget -scrollregion] 3]
3012 if {$ymax eq {} || $ymax == 0} return
3013 set y0 [expr {int($f0 * $ymax)}]
3014 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3018 set y1 [expr {int($f1 * $ymax)}]
3019 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3020 if {$endrow >= $numcommits} {
3021 set endrow [expr {$numcommits - 1}]
3023 for {} {$row <= $endrow} {incr row} {
3028 proc drawvisible {} {
3030 eval drawfrac [$canv yview]
3033 proc clear_display {} {
3034 global iddrawn idrangedrawn
3035 global vhighlights fhighlights nhighlights rhighlights
3038 catch {unset iddrawn}
3039 catch {unset idrangedrawn}
3040 catch {unset vhighlights}
3041 catch {unset fhighlights}
3042 catch {unset nhighlights}
3043 catch {unset rhighlights}
3046 proc findcrossings {id} {
3047 global rowidlist parentlist numcommits rowoffsets displayorder
3051 foreach {s e} [rowranges $id] {
3052 if {$e >= $numcommits} {
3053 set e [expr {$numcommits - 1}]
3055 if {$e <= $s} continue
3056 set x [lsearch -exact [lindex $rowidlist $e] $id]
3058 puts "findcrossings: oops, no [shortids $id] in row $e"
3061 for {set row $e} {[incr row -1] >= $s} {} {
3062 set olds [lindex $parentlist $row]
3063 set kid [lindex $displayorder $row]
3064 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3065 if {$kidx < 0} continue
3066 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3068 set px [lsearch -exact $nextrow $p]
3069 if {$px < 0} continue
3070 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3071 if {[lsearch -exact $ccross $p] >= 0} continue
3072 if {$x == $px + ($kidx < $px? -1: 1)} {
3074 } elseif {[lsearch -exact $cross $p] < 0} {
3079 set inc [lindex $rowoffsets $row $x]
3080 if {$inc eq {}} break
3084 return [concat $ccross {{}} $cross]
3087 proc assigncolor {id} {
3088 global colormap colors nextcolor
3089 global commitrow parentlist children children curview
3091 if {[info exists colormap($id)]} return
3092 set ncolors [llength $colors]
3093 if {[info exists children($curview,$id)]} {
3094 set kids $children($curview,$id)
3098 if {[llength $kids] == 1} {
3099 set child [lindex $kids 0]
3100 if {[info exists colormap($child)]
3101 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3102 set colormap($id) $colormap($child)
3108 foreach x [findcrossings $id] {
3110 # delimiter between corner crossings and other crossings
3111 if {[llength $badcolors] >= $ncolors - 1} break
3112 set origbad $badcolors
3114 if {[info exists colormap($x)]
3115 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3116 lappend badcolors $colormap($x)
3119 if {[llength $badcolors] >= $ncolors} {
3120 set badcolors $origbad
3122 set origbad $badcolors
3123 if {[llength $badcolors] < $ncolors - 1} {
3124 foreach child $kids {
3125 if {[info exists colormap($child)]
3126 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3127 lappend badcolors $colormap($child)
3129 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3130 if {[info exists colormap($p)]
3131 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3132 lappend badcolors $colormap($p)
3136 if {[llength $badcolors] >= $ncolors} {
3137 set badcolors $origbad
3140 for {set i 0} {$i <= $ncolors} {incr i} {
3141 set c [lindex $colors $nextcolor]
3142 if {[incr nextcolor] >= $ncolors} {
3145 if {[lsearch -exact $badcolors $c]} break
3147 set colormap($id) $c
3150 proc bindline {t id} {
3153 $canv bind $t <Enter> "lineenter %x %y $id"
3154 $canv bind $t <Motion> "linemotion %x %y $id"
3155 $canv bind $t <Leave> "lineleave $id"
3156 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3159 proc drawtags {id x xt y1} {
3160 global idtags idheads idotherrefs mainhead
3161 global linespc lthickness
3162 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3167 if {[info exists idtags($id)]} {
3168 set marks $idtags($id)
3169 set ntags [llength $marks]
3171 if {[info exists idheads($id)]} {
3172 set marks [concat $marks $idheads($id)]
3173 set nheads [llength $idheads($id)]
3175 if {[info exists idotherrefs($id)]} {
3176 set marks [concat $marks $idotherrefs($id)]
3182 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3183 set yt [expr {$y1 - 0.5 * $linespc}]
3184 set yb [expr {$yt + $linespc - 1}]
3188 foreach tag $marks {
3190 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3191 set wid [font measure [concat $mainfont bold] $tag]
3193 set wid [font measure $mainfont $tag]
3197 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3199 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3200 -width $lthickness -fill black -tags tag.$id]
3202 foreach tag $marks x $xvals wid $wvals {
3203 set xl [expr {$x + $delta}]
3204 set xr [expr {$x + $delta + $wid + $lthickness}]
3206 if {[incr ntags -1] >= 0} {
3208 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3209 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3210 -width 1 -outline black -fill yellow -tags tag.$id]
3211 $canv bind $t <1> [list showtag $tag 1]
3212 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3214 # draw a head or other ref
3215 if {[incr nheads -1] >= 0} {
3217 if {$tag eq $mainhead} {
3223 set xl [expr {$xl - $delta/2}]
3224 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3225 -width 1 -outline black -fill $col -tags tag.$id
3226 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3227 set rwid [font measure $mainfont $remoteprefix]
3228 set xi [expr {$x + 1}]
3229 set yti [expr {$yt + 1}]
3230 set xri [expr {$x + $rwid}]
3231 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3232 -width 0 -fill "#ffddaa" -tags tag.$id
3235 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3236 -font $font -tags [list tag.$id text]]
3238 $canv bind $t <1> [list showtag $tag 1]
3244 proc xcoord {i level ln} {
3245 global canvx0 xspc1 xspc2
3247 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3248 if {$i > 0 && $i == $level} {
3249 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3250 } elseif {$i > $level} {
3251 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3256 proc show_status {msg} {
3257 global canv mainfont fgcolor
3260 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3261 -tags text -fill $fgcolor
3264 proc finishcommits {} {
3265 global commitidx phase curview
3266 global canv mainfont ctext maincursor textcursor
3267 global findinprogress pending_select
3269 if {$commitidx($curview) > 0} {
3272 show_status "No commits selected"
3275 catch {unset pending_select}
3278 # Don't change the text pane cursor if it is currently the hand cursor,
3279 # showing that we are over a sha1 ID link.
3280 proc settextcursor {c} {
3281 global ctext curtextcursor
3283 if {[$ctext cget -cursor] == $curtextcursor} {
3284 $ctext config -cursor $c
3286 set curtextcursor $c
3289 proc nowbusy {what} {
3292 if {[array names isbusy] eq {}} {
3293 . config -cursor watch
3299 proc notbusy {what} {
3300 global isbusy maincursor textcursor
3302 catch {unset isbusy($what)}
3303 if {[array names isbusy] eq {}} {
3304 . config -cursor $maincursor
3305 settextcursor $textcursor
3312 global canvy0 numcommits linespc
3313 global rowlaidout commitidx curview
3314 global pending_select
3317 layoutrows $rowlaidout $commitidx($curview) 1
3319 optimize_rows $row 0 $commitidx($curview)
3320 showstuff $commitidx($curview)
3321 if {[info exists pending_select]} {
3325 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3326 #puts "overall $drawmsecs ms for $numcommits commits"
3329 proc findmatches {f} {
3330 global findtype foundstring foundstrlen
3331 if {$findtype == "Regexp"} {
3332 set matches [regexp -indices -all -inline $foundstring $f]
3334 if {$findtype == "IgnCase"} {
3335 set str [string tolower $f]
3341 while {[set j [string first $foundstring $str $i]] >= 0} {
3342 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3343 set i [expr {$j + $foundstrlen}]
3350 global findtype findloc findstring markedmatches commitinfo
3351 global numcommits displayorder linehtag linentag linedtag
3352 global mainfont canv canv2 canv3 selectedline
3353 global matchinglines foundstring foundstrlen matchstring
3358 cancel_next_highlight
3360 set matchinglines {}
3361 if {$findtype == "IgnCase"} {
3362 set foundstring [string tolower $findstring]
3364 set foundstring $findstring
3366 set foundstrlen [string length $findstring]
3367 if {$foundstrlen == 0} return
3368 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3369 set matchstring "*$matchstring*"
3370 if {![info exists selectedline]} {
3373 set oldsel $selectedline
3376 set fldtypes {Headline Author Date Committer CDate Comments}
3378 foreach id $displayorder {
3379 set d $commitdata($id)
3381 if {$findtype == "Regexp"} {
3382 set doesmatch [regexp $foundstring $d]
3383 } elseif {$findtype == "IgnCase"} {
3384 set doesmatch [string match -nocase $matchstring $d]
3386 set doesmatch [string match $matchstring $d]
3388 if {!$doesmatch} continue
3389 if {![info exists commitinfo($id)]} {
3392 set info $commitinfo($id)
3394 foreach f $info ty $fldtypes {
3395 if {$findloc != "All fields" && $findloc != $ty} {
3398 set matches [findmatches $f]
3399 if {$matches == {}} continue
3401 if {$ty == "Headline"} {
3403 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3404 } elseif {$ty == "Author"} {
3406 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3407 } elseif {$ty == "Date"} {
3409 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3413 lappend matchinglines $l
3414 if {!$didsel && $l > $oldsel} {
3420 if {$matchinglines == {}} {
3422 } elseif {!$didsel} {
3423 findselectline [lindex $matchinglines 0]
3427 proc findselectline {l} {
3428 global findloc commentend ctext
3430 if {$findloc == "All fields" || $findloc == "Comments"} {
3431 # highlight the matches in the comments
3432 set f [$ctext get 1.0 $commentend]
3433 set matches [findmatches $f]
3434 foreach match $matches {
3435 set start [lindex $match 0]
3436 set end [expr {[lindex $match 1] + 1}]
3437 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3442 proc findnext {restart} {
3443 global matchinglines selectedline
3444 if {![info exists matchinglines]} {
3450 if {![info exists selectedline]} return
3451 foreach l $matchinglines {
3452 if {$l > $selectedline} {
3461 global matchinglines selectedline
3462 if {![info exists matchinglines]} {
3466 if {![info exists selectedline]} return
3468 foreach l $matchinglines {
3469 if {$l >= $selectedline} break
3473 findselectline $prev
3479 proc stopfindproc {{done 0}} {
3480 global findprocpid findprocfile findids
3481 global ctext findoldcursor phase maincursor textcursor
3482 global findinprogress
3484 catch {unset findids}
3485 if {[info exists findprocpid]} {
3487 catch {exec kill $findprocpid}
3489 catch {close $findprocfile}
3492 catch {unset findinprogress}
3496 # mark a commit as matching by putting a yellow background
3497 # behind the headline
3498 proc markheadline {l id} {
3499 global canv mainfont linehtag
3502 set bbox [$canv bbox $linehtag($l)]
3503 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3507 # mark the bits of a headline, author or date that match a find string
3508 proc markmatches {canv l str tag matches font} {
3509 set bbox [$canv bbox $tag]
3510 set x0 [lindex $bbox 0]
3511 set y0 [lindex $bbox 1]
3512 set y1 [lindex $bbox 3]
3513 foreach match $matches {
3514 set start [lindex $match 0]
3515 set end [lindex $match 1]
3516 if {$start > $end} continue
3517 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3518 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3519 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3520 [expr {$x0+$xlen+2}] $y1 \
3521 -outline {} -tags matches -fill yellow]
3526 proc unmarkmatches {} {
3527 global matchinglines findids
3528 allcanvs delete matches
3529 catch {unset matchinglines}
3530 catch {unset findids}
3533 proc selcanvline {w x y} {
3534 global canv canvy0 ctext linespc
3536 set ymax [lindex [$canv cget -scrollregion] 3]
3537 if {$ymax == {}} return
3538 set yfrac [lindex [$canv yview] 0]
3539 set y [expr {$y + $yfrac * $ymax}]
3540 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3545 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3551 proc commit_descriptor {p} {
3553 if {![info exists commitinfo($p)]} {
3557 if {[llength $commitinfo($p)] > 1} {
3558 set l [lindex $commitinfo($p) 0]
3563 # append some text to the ctext widget, and make any SHA1 ID
3564 # that we know about be a clickable link.
3565 proc appendwithlinks {text tags} {
3566 global ctext commitrow linknum curview
3568 set start [$ctext index "end - 1c"]
3569 $ctext insert end $text $tags
3570 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3574 set linkid [string range $text $s $e]
3575 if {![info exists commitrow($curview,$linkid)]} continue
3577 $ctext tag add link "$start + $s c" "$start + $e c"
3578 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3579 $ctext tag bind link$linknum <1> \
3580 [list selectline $commitrow($curview,$linkid) 1]
3583 $ctext tag conf link -foreground blue -underline 1
3584 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3585 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3588 proc viewnextline {dir} {
3592 set ymax [lindex [$canv cget -scrollregion] 3]
3593 set wnow [$canv yview]
3594 set wtop [expr {[lindex $wnow 0] * $ymax}]
3595 set newtop [expr {$wtop + $dir * $linespc}]
3598 } elseif {$newtop > $ymax} {
3601 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3604 # add a list of tag or branch names at position pos
3605 # returns the number of names inserted
3606 proc appendrefs {pos l var} {
3607 global ctext commitrow linknum curview idtags $var
3609 if {[catch {$ctext index $pos}]} {
3614 foreach tag [set $var\($id\)] {
3615 lappend tags [concat $tag $id]
3618 set tags [lsort -index 1 $tags]
3621 set name [lindex $tag 0]
3622 set id [lindex $tag 1]
3625 $ctext insert $pos $sep
3626 $ctext insert $pos $name $lk
3627 $ctext tag conf $lk -foreground blue
3628 if {[info exists commitrow($curview,$id)]} {
3629 $ctext tag bind $lk <1> \
3630 [list selectline $commitrow($curview,$id) 1]
3631 $ctext tag conf $lk -underline 1
3632 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3633 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3637 return [llength $tags]
3640 # called when we have finished computing the nearby tags
3641 proc dispneartags {} {
3642 global selectedline currentid ctext anc_tags desc_tags showneartags
3645 if {![info exists selectedline] || !$showneartags} return
3647 $ctext conf -state normal
3648 if {[info exists desc_heads($id)]} {
3649 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3650 $ctext insert "branch -2c" "es"
3653 if {[info exists anc_tags($id)]} {
3654 appendrefs follows $anc_tags($id) idtags
3656 if {[info exists desc_tags($id)]} {
3657 appendrefs precedes $desc_tags($id) idtags
3659 $ctext conf -state disabled
3662 proc selectline {l isnew} {
3663 global canv canv2 canv3 ctext commitinfo selectedline
3664 global displayorder linehtag linentag linedtag
3665 global canvy0 linespc parentlist childlist
3666 global currentid sha1entry
3667 global commentend idtags linknum
3668 global mergemax numcommits pending_select
3669 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3671 catch {unset pending_select}
3674 cancel_next_highlight
3675 if {$l < 0 || $l >= $numcommits} return
3676 set y [expr {$canvy0 + $l * $linespc}]
3677 set ymax [lindex [$canv cget -scrollregion] 3]
3678 set ytop [expr {$y - $linespc - 1}]
3679 set ybot [expr {$y + $linespc + 1}]
3680 set wnow [$canv yview]
3681 set wtop [expr {[lindex $wnow 0] * $ymax}]
3682 set wbot [expr {[lindex $wnow 1] * $ymax}]
3683 set wh [expr {$wbot - $wtop}]
3685 if {$ytop < $wtop} {
3686 if {$ybot < $wtop} {
3687 set newtop [expr {$y - $wh / 2.0}]
3690 if {$newtop > $wtop - $linespc} {
3691 set newtop [expr {$wtop - $linespc}]
3694 } elseif {$ybot > $wbot} {
3695 if {$ytop > $wbot} {
3696 set newtop [expr {$y - $wh / 2.0}]
3698 set newtop [expr {$ybot - $wh}]
3699 if {$newtop < $wtop + $linespc} {
3700 set newtop [expr {$wtop + $linespc}]
3704 if {$newtop != $wtop} {
3708 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3712 if {![info exists linehtag($l)]} return
3714 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3715 -tags secsel -fill [$canv cget -selectbackground]]
3717 $canv2 delete secsel
3718 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3719 -tags secsel -fill [$canv2 cget -selectbackground]]
3721 $canv3 delete secsel
3722 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3723 -tags secsel -fill [$canv3 cget -selectbackground]]
3727 addtohistory [list selectline $l 0]
3732 set id [lindex $displayorder $l]
3734 $sha1entry delete 0 end
3735 $sha1entry insert 0 $id
3736 $sha1entry selection from 0
3737 $sha1entry selection to end
3740 $ctext conf -state normal
3743 set info $commitinfo($id)
3744 set date [formatdate [lindex $info 2]]
3745 $ctext insert end "Author: [lindex $info 1] $date\n"
3746 set date [formatdate [lindex $info 4]]
3747 $ctext insert end "Committer: [lindex $info 3] $date\n"
3748 if {[info exists idtags($id)]} {
3749 $ctext insert end "Tags:"
3750 foreach tag $idtags($id) {
3751 $ctext insert end " $tag"
3753 $ctext insert end "\n"
3757 set olds [lindex $parentlist $l]
3758 if {[llength $olds] > 1} {
3761 if {$np >= $mergemax} {
3766 $ctext insert end "Parent: " $tag
3767 appendwithlinks [commit_descriptor $p] {}
3772 append headers "Parent: [commit_descriptor $p]"
3776 foreach c [lindex $childlist $l] {
3777 append headers "Child: [commit_descriptor $c]"
3780 # make anything that looks like a SHA1 ID be a clickable link
3781 appendwithlinks $headers {}
3782 if {$showneartags} {
3783 if {![info exists allcommits]} {
3786 $ctext insert end "Branch: "
3787 $ctext mark set branch "end -1c"
3788 $ctext mark gravity branch left
3789 if {[info exists desc_heads($id)]} {
3790 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3791 # turn "Branch" into "Branches"
3792 $ctext insert "branch -2c" "es"
3795 $ctext insert end "\nFollows: "
3796 $ctext mark set follows "end -1c"
3797 $ctext mark gravity follows left
3798 if {[info exists anc_tags($id)]} {
3799 appendrefs follows $anc_tags($id) idtags
3801 $ctext insert end "\nPrecedes: "
3802 $ctext mark set precedes "end -1c"
3803 $ctext mark gravity precedes left
3804 if {[info exists desc_tags($id)]} {
3805 appendrefs precedes $desc_tags($id) idtags
3807 $ctext insert end "\n"
3809 $ctext insert end "\n"
3810 appendwithlinks [lindex $info 5] {comment}
3812 $ctext tag delete Comments
3813 $ctext tag remove found 1.0 end
3814 $ctext conf -state disabled
3815 set commentend [$ctext index "end - 1c"]
3817 init_flist "Comments"
3818 if {$cmitmode eq "tree"} {
3820 } elseif {[llength $olds] <= 1} {
3827 proc selfirstline {} {
3832 proc sellastline {} {
3835 set l [expr {$numcommits - 1}]
3839 proc selnextline {dir} {
3841 if {![info exists selectedline]} return
3842 set l [expr {$selectedline + $dir}]
3847 proc selnextpage {dir} {
3848 global canv linespc selectedline numcommits
3850 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3854 allcanvs yview scroll [expr {$dir * $lpp}] units
3856 if {![info exists selectedline]} return
3857 set l [expr {$selectedline + $dir * $lpp}]
3860 } elseif {$l >= $numcommits} {
3861 set l [expr $numcommits - 1]
3867 proc unselectline {} {
3868 global selectedline currentid
3870 catch {unset selectedline}
3871 catch {unset currentid}
3872 allcanvs delete secsel
3874 cancel_next_highlight
3877 proc reselectline {} {
3880 if {[info exists selectedline]} {
3881 selectline $selectedline 0
3885 proc addtohistory {cmd} {
3886 global history historyindex curview
3888 set elt [list $curview $cmd]
3889 if {$historyindex > 0
3890 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3894 if {$historyindex < [llength $history]} {
3895 set history [lreplace $history $historyindex end $elt]
3897 lappend history $elt
3900 if {$historyindex > 1} {
3901 .ctop.top.bar.leftbut conf -state normal
3903 .ctop.top.bar.leftbut conf -state disabled
3905 .ctop.top.bar.rightbut conf -state disabled
3911 set view [lindex $elt 0]
3912 set cmd [lindex $elt 1]
3913 if {$curview != $view} {
3920 global history historyindex
3922 if {$historyindex > 1} {
3923 incr historyindex -1
3924 godo [lindex $history [expr {$historyindex - 1}]]
3925 .ctop.top.bar.rightbut conf -state normal
3927 if {$historyindex <= 1} {
3928 .ctop.top.bar.leftbut conf -state disabled
3933 global history historyindex
3935 if {$historyindex < [llength $history]} {
3936 set cmd [lindex $history $historyindex]
3939 .ctop.top.bar.leftbut conf -state normal
3941 if {$historyindex >= [llength $history]} {
3942 .ctop.top.bar.rightbut conf -state disabled
3947 global treefilelist treeidlist diffids diffmergeid treepending
3950 catch {unset diffmergeid}
3951 if {![info exists treefilelist($id)]} {
3952 if {![info exists treepending]} {
3953 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3957 set treefilelist($id) {}
3958 set treeidlist($id) {}
3959 fconfigure $gtf -blocking 0
3960 fileevent $gtf readable [list gettreeline $gtf $id]
3967 proc gettreeline {gtf id} {
3968 global treefilelist treeidlist treepending cmitmode diffids
3970 while {[gets $gtf line] >= 0} {
3971 if {[lindex $line 1] ne "blob"} continue
3972 set sha1 [lindex $line 2]
3973 set fname [lindex $line 3]
3974 lappend treefilelist($id) $fname
3975 lappend treeidlist($id) $sha1
3977 if {![eof $gtf]} return
3980 if {$cmitmode ne "tree"} {
3981 if {![info exists diffmergeid]} {
3982 gettreediffs $diffids
3984 } elseif {$id ne $diffids} {
3992 global treefilelist treeidlist diffids
3993 global ctext commentend
3995 set i [lsearch -exact $treefilelist($diffids) $f]
3997 puts "oops, $f not in list for id $diffids"
4000 set blob [lindex $treeidlist($diffids) $i]
4001 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4002 puts "oops, error reading blob $blob: $err"
4005 fconfigure $bf -blocking 0
4006 fileevent $bf readable [list getblobline $bf $diffids]
4007 $ctext config -state normal
4008 clear_ctext $commentend
4009 $ctext insert end "\n"
4010 $ctext insert end "$f\n" filesep
4011 $ctext config -state disabled
4012 $ctext yview $commentend
4015 proc getblobline {bf id} {
4016 global diffids cmitmode ctext
4018 if {$id ne $diffids || $cmitmode ne "tree"} {
4022 $ctext config -state normal
4023 while {[gets $bf line] >= 0} {
4024 $ctext insert end "$line\n"
4027 # delete last newline
4028 $ctext delete "end - 2c" "end - 1c"
4031 $ctext config -state disabled
4034 proc mergediff {id l} {
4035 global diffmergeid diffopts mdifffd
4041 # this doesn't seem to actually affect anything...
4042 set env(GIT_DIFF_OPTS) $diffopts
4043 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4044 if {[catch {set mdf [open $cmd r]} err]} {
4045 error_popup "Error getting merge diffs: $err"
4048 fconfigure $mdf -blocking 0
4049 set mdifffd($id) $mdf
4050 set np [llength [lindex $parentlist $l]]
4051 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4052 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4055 proc getmergediffline {mdf id np} {
4056 global diffmergeid ctext cflist nextupdate mergemax
4057 global difffilestart mdifffd
4059 set n [gets $mdf line]
4066 if {![info exists diffmergeid] || $id != $diffmergeid
4067 || $mdf != $mdifffd($id)} {
4070 $ctext conf -state normal
4071 if {[regexp {^diff --cc (.*)} $line match fname]} {
4072 # start of a new file
4073 $ctext insert end "\n"
4074 set here [$ctext index "end - 1c"]
4075 lappend difffilestart $here
4076 add_flist [list $fname]
4077 set l [expr {(78 - [string length $fname]) / 2}]
4078 set pad [string range "----------------------------------------" 1 $l]
4079 $ctext insert end "$pad $fname $pad\n" filesep
4080 } elseif {[regexp {^@@} $line]} {
4081 $ctext insert end "$line\n" hunksep
4082 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4085 # parse the prefix - one ' ', '-' or '+' for each parent
4090 for {set j 0} {$j < $np} {incr j} {
4091 set c [string range $line $j $j]
4094 } elseif {$c == "-"} {
4096 } elseif {$c == "+"} {
4105 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4106 # line doesn't appear in result, parents in $minuses have the line
4107 set num [lindex $minuses 0]
4108 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4109 # line appears in result, parents in $pluses don't have the line
4110 lappend tags mresult
4111 set num [lindex $spaces 0]
4114 if {$num >= $mergemax} {
4119 $ctext insert end "$line\n" $tags
4121 $ctext conf -state disabled
4122 if {[clock clicks -milliseconds] >= $nextupdate} {
4124 fileevent $mdf readable {}
4126 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4130 proc startdiff {ids} {
4131 global treediffs diffids treepending diffmergeid
4134 catch {unset diffmergeid}
4135 if {![info exists treediffs($ids)]} {
4136 if {![info exists treepending]} {
4144 proc addtocflist {ids} {
4145 global treediffs cflist
4146 add_flist $treediffs($ids)
4150 proc gettreediffs {ids} {
4151 global treediff treepending
4152 set treepending $ids
4155 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4157 fconfigure $gdtf -blocking 0
4158 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4161 proc gettreediffline {gdtf ids} {
4162 global treediff treediffs treepending diffids diffmergeid
4165 set n [gets $gdtf line]
4167 if {![eof $gdtf]} return
4169 set treediffs($ids) $treediff
4171 if {$cmitmode eq "tree"} {
4173 } elseif {$ids != $diffids} {
4174 if {![info exists diffmergeid]} {
4175 gettreediffs $diffids
4182 set file [lindex $line 5]
4183 lappend treediff $file
4186 proc getblobdiffs {ids} {
4187 global diffopts blobdifffd diffids env curdifftag curtagstart
4188 global nextupdate diffinhdr treediffs
4190 set env(GIT_DIFF_OPTS) $diffopts
4191 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4192 if {[catch {set bdf [open $cmd r]} err]} {
4193 puts "error getting diffs: $err"
4197 fconfigure $bdf -blocking 0
4198 set blobdifffd($ids) $bdf
4199 set curdifftag Comments
4201 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4202 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4205 proc setinlist {var i val} {
4208 while {[llength [set $var]] < $i} {
4211 if {[llength [set $var]] == $i} {
4218 proc getblobdiffline {bdf ids} {
4219 global diffids blobdifffd ctext curdifftag curtagstart
4220 global diffnexthead diffnextnote difffilestart
4221 global nextupdate diffinhdr treediffs
4223 set n [gets $bdf line]
4227 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4228 $ctext tag add $curdifftag $curtagstart end
4233 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4236 $ctext conf -state normal
4237 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4238 # start of a new file
4239 $ctext insert end "\n"
4240 $ctext tag add $curdifftag $curtagstart end
4241 set here [$ctext index "end - 1c"]
4242 set curtagstart $here
4244 set i [lsearch -exact $treediffs($ids) $fname]
4246 setinlist difffilestart $i $here
4248 if {$newname ne $fname} {
4249 set i [lsearch -exact $treediffs($ids) $newname]
4251 setinlist difffilestart $i $here
4254 set curdifftag "f:$fname"
4255 $ctext tag delete $curdifftag
4256 set l [expr {(78 - [string length $header]) / 2}]
4257 set pad [string range "----------------------------------------" 1 $l]
4258 $ctext insert end "$pad $header $pad\n" filesep
4260 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4262 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4264 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4265 $line match f1l f1c f2l f2c rest]} {
4266 $ctext insert end "$line\n" hunksep
4269 set x [string range $line 0 0]
4270 if {$x == "-" || $x == "+"} {
4271 set tag [expr {$x == "+"}]
4272 $ctext insert end "$line\n" d$tag
4273 } elseif {$x == " "} {
4274 $ctext insert end "$line\n"
4275 } elseif {$diffinhdr || $x == "\\"} {
4276 # e.g. "\ No newline at end of file"
4277 $ctext insert end "$line\n" filesep
4279 # Something else we don't recognize
4280 if {$curdifftag != "Comments"} {
4281 $ctext insert end "\n"
4282 $ctext tag add $curdifftag $curtagstart end
4283 set curtagstart [$ctext index "end - 1c"]
4284 set curdifftag Comments
4286 $ctext insert end "$line\n" filesep
4289 $ctext conf -state disabled
4290 if {[clock clicks -milliseconds] >= $nextupdate} {
4292 fileevent $bdf readable {}
4294 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4299 global difffilestart ctext
4300 set here [$ctext index @0,0]
4301 foreach loc $difffilestart {
4302 if {[$ctext compare $loc > $here]} {
4308 proc clear_ctext {{first 1.0}} {
4309 global ctext smarktop smarkbot
4311 set l [lindex [split $first .] 0]
4312 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4315 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4318 $ctext delete $first end
4321 proc incrsearch {name ix op} {
4322 global ctext searchstring searchdirn
4324 $ctext tag remove found 1.0 end
4325 if {[catch {$ctext index anchor}]} {
4326 # no anchor set, use start of selection, or of visible area
4327 set sel [$ctext tag ranges sel]
4329 $ctext mark set anchor [lindex $sel 0]
4330 } elseif {$searchdirn eq "-forwards"} {
4331 $ctext mark set anchor @0,0
4333 $ctext mark set anchor @0,[winfo height $ctext]
4336 if {$searchstring ne {}} {
4337 set here [$ctext search $searchdirn -- $searchstring anchor]
4346 global sstring ctext searchstring searchdirn
4349 $sstring icursor end
4350 set searchdirn -forwards
4351 if {$searchstring ne {}} {
4352 set sel [$ctext tag ranges sel]
4354 set start "[lindex $sel 0] + 1c"
4355 } elseif {[catch {set start [$ctext index anchor]}]} {
4358 set match [$ctext search -count mlen -- $searchstring $start]
4359 $ctext tag remove sel 1.0 end
4365 set mend "$match + $mlen c"
4366 $ctext tag add sel $match $mend
4367 $ctext mark unset anchor
4371 proc dosearchback {} {
4372 global sstring ctext searchstring searchdirn
4375 $sstring icursor end
4376 set searchdirn -backwards
4377 if {$searchstring ne {}} {
4378 set sel [$ctext tag ranges sel]
4380 set start [lindex $sel 0]
4381 } elseif {[catch {set start [$ctext index anchor]}]} {
4382 set start @0,[winfo height $ctext]
4384 set match [$ctext search -backwards -count ml -- $searchstring $start]
4385 $ctext tag remove sel 1.0 end
4391 set mend "$match + $ml c"
4392 $ctext tag add sel $match $mend
4393 $ctext mark unset anchor
4397 proc searchmark {first last} {
4398 global ctext searchstring
4402 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4403 if {$match eq {}} break
4404 set mend "$match + $mlen c"
4405 $ctext tag add found $match $mend
4409 proc searchmarkvisible {doall} {
4410 global ctext smarktop smarkbot
4412 set topline [lindex [split [$ctext index @0,0] .] 0]
4413 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4414 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4415 # no overlap with previous
4416 searchmark $topline $botline
4417 set smarktop $topline
4418 set smarkbot $botline
4420 if {$topline < $smarktop} {
4421 searchmark $topline [expr {$smarktop-1}]
4422 set smarktop $topline
4424 if {$botline > $smarkbot} {
4425 searchmark [expr {$smarkbot+1}] $botline
4426 set smarkbot $botline
4431 proc scrolltext {f0 f1} {
4434 .ctop.cdet.left.sb set $f0 $f1
4435 if {$searchstring ne {}} {
4441 global linespc charspc canvx0 canvy0 mainfont
4442 global xspc1 xspc2 lthickness
4444 set linespc [font metrics $mainfont -linespace]
4445 set charspc [font measure $mainfont "m"]
4446 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4447 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4448 set lthickness [expr {int($linespc / 9) + 1}]
4449 set xspc1(0) $linespc
4457 set ymax [lindex [$canv cget -scrollregion] 3]
4458 if {$ymax eq {} || $ymax == 0} return
4459 set span [$canv yview]
4462 allcanvs yview moveto [lindex $span 0]
4464 if {[info exists selectedline]} {
4465 selectline $selectedline 0
4469 proc incrfont {inc} {
4470 global mainfont textfont ctext canv phase
4471 global stopped entries
4473 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4474 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4476 $ctext conf -font $textfont
4477 $ctext tag conf filesep -font [concat $textfont bold]
4478 foreach e $entries {
4479 $e conf -font $mainfont
4481 if {$phase eq "getcommits"} {
4482 $canv itemconf textitems -font $mainfont
4488 global sha1entry sha1string
4489 if {[string length $sha1string] == 40} {
4490 $sha1entry delete 0 end
4494 proc sha1change {n1 n2 op} {
4495 global sha1string currentid sha1but
4496 if {$sha1string == {}
4497 || ([info exists currentid] && $sha1string == $currentid)} {
4502 if {[$sha1but cget -state] == $state} return
4503 if {$state == "normal"} {
4504 $sha1but conf -state normal -relief raised -text "Goto: "
4506 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4510 proc gotocommit {} {
4511 global sha1string currentid commitrow tagids headids
4512 global displayorder numcommits curview
4514 if {$sha1string == {}
4515 || ([info exists currentid] && $sha1string == $currentid)} return
4516 if {[info exists tagids($sha1string)]} {
4517 set id $tagids($sha1string)
4518 } elseif {[info exists headids($sha1string)]} {
4519 set id $headids($sha1string)
4521 set id [string tolower $sha1string]
4522 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4524 foreach i $displayorder {
4525 if {[string match $id* $i]} {
4529 if {$matches ne {}} {
4530 if {[llength $matches] > 1} {
4531 error_popup "Short SHA1 id $id is ambiguous"
4534 set id [lindex $matches 0]
4538 if {[info exists commitrow($curview,$id)]} {
4539 selectline $commitrow($curview,$id) 1
4542 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4547 error_popup "$type $sha1string is not known"
4550 proc lineenter {x y id} {
4551 global hoverx hovery hoverid hovertimer
4552 global commitinfo canv
4554 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4558 if {[info exists hovertimer]} {
4559 after cancel $hovertimer
4561 set hovertimer [after 500 linehover]
4565 proc linemotion {x y id} {
4566 global hoverx hovery hoverid hovertimer
4568 if {[info exists hoverid] && $id == $hoverid} {
4571 if {[info exists hovertimer]} {
4572 after cancel $hovertimer
4574 set hovertimer [after 500 linehover]
4578 proc lineleave {id} {
4579 global hoverid hovertimer canv
4581 if {[info exists hoverid] && $id == $hoverid} {
4583 if {[info exists hovertimer]} {
4584 after cancel $hovertimer
4592 global hoverx hovery hoverid hovertimer
4593 global canv linespc lthickness
4594 global commitinfo mainfont
4596 set text [lindex $commitinfo($hoverid) 0]
4597 set ymax [lindex [$canv cget -scrollregion] 3]
4598 if {$ymax == {}} return
4599 set yfrac [lindex [$canv yview] 0]
4600 set x [expr {$hoverx + 2 * $linespc}]
4601 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4602 set x0 [expr {$x - 2 * $lthickness}]
4603 set y0 [expr {$y - 2 * $lthickness}]
4604 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4605 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4606 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4607 -fill \#ffff80 -outline black -width 1 -tags hover]
4609 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4614 proc clickisonarrow {id y} {
4617 set ranges [rowranges $id]
4618 set thresh [expr {2 * $lthickness + 6}]
4619 set n [expr {[llength $ranges] - 1}]
4620 for {set i 1} {$i < $n} {incr i} {
4621 set row [lindex $ranges $i]
4622 if {abs([yc $row] - $y) < $thresh} {
4629 proc arrowjump {id n y} {
4632 # 1 <-> 2, 3 <-> 4, etc...
4633 set n [expr {(($n - 1) ^ 1) + 1}]
4634 set row [lindex [rowranges $id] $n]
4636 set ymax [lindex [$canv cget -scrollregion] 3]
4637 if {$ymax eq {} || $ymax <= 0} return
4638 set view [$canv yview]
4639 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4640 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4644 allcanvs yview moveto $yfrac
4647 proc lineclick {x y id isnew} {
4648 global ctext commitinfo children canv thickerline curview
4650 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4655 # draw this line thicker than normal
4659 set ymax [lindex [$canv cget -scrollregion] 3]
4660 if {$ymax eq {}} return
4661 set yfrac [lindex [$canv yview] 0]
4662 set y [expr {$y + $yfrac * $ymax}]
4664 set dirn [clickisonarrow $id $y]
4666 arrowjump $id $dirn $y
4671 addtohistory [list lineclick $x $y $id 0]
4673 # fill the details pane with info about this line
4674 $ctext conf -state normal
4676 $ctext tag conf link -foreground blue -underline 1
4677 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4678 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4679 $ctext insert end "Parent:\t"
4680 $ctext insert end $id [list link link0]
4681 $ctext tag bind link0 <1> [list selbyid $id]
4682 set info $commitinfo($id)
4683 $ctext insert end "\n\t[lindex $info 0]\n"
4684 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4685 set date [formatdate [lindex $info 2]]
4686 $ctext insert end "\tDate:\t$date\n"
4687 set kids $children($curview,$id)
4689 $ctext insert end "\nChildren:"
4691 foreach child $kids {
4693 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4694 set info $commitinfo($child)
4695 $ctext insert end "\n\t"
4696 $ctext insert end $child [list link link$i]
4697 $ctext tag bind link$i <1> [list selbyid $child]
4698 $ctext insert end "\n\t[lindex $info 0]"
4699 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4700 set date [formatdate [lindex $info 2]]
4701 $ctext insert end "\n\tDate:\t$date\n"
4704 $ctext conf -state disabled
4708 proc normalline {} {
4710 if {[info exists thickerline]} {
4718 global commitrow curview
4719 if {[info exists commitrow($curview,$id)]} {
4720 selectline $commitrow($curview,$id) 1
4726 if {![info exists startmstime]} {
4727 set startmstime [clock clicks -milliseconds]
4729 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4732 proc rowmenu {x y id} {
4733 global rowctxmenu commitrow selectedline rowmenuid curview
4735 if {![info exists selectedline]
4736 || $commitrow($curview,$id) eq $selectedline} {
4741 $rowctxmenu entryconfigure 0 -state $state
4742 $rowctxmenu entryconfigure 1 -state $state
4743 $rowctxmenu entryconfigure 2 -state $state
4745 tk_popup $rowctxmenu $x $y
4748 proc diffvssel {dirn} {
4749 global rowmenuid selectedline displayorder
4751 if {![info exists selectedline]} return
4753 set oldid [lindex $displayorder $selectedline]
4754 set newid $rowmenuid
4756 set oldid $rowmenuid
4757 set newid [lindex $displayorder $selectedline]
4759 addtohistory [list doseldiff $oldid $newid]
4760 doseldiff $oldid $newid
4763 proc doseldiff {oldid newid} {
4767 $ctext conf -state normal
4770 $ctext insert end "From "
4771 $ctext tag conf link -foreground blue -underline 1
4772 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4773 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4774 $ctext tag bind link0 <1> [list selbyid $oldid]
4775 $ctext insert end $oldid [list link link0]
4776 $ctext insert end "\n "
4777 $ctext insert end [lindex $commitinfo($oldid) 0]
4778 $ctext insert end "\n\nTo "
4779 $ctext tag bind link1 <1> [list selbyid $newid]
4780 $ctext insert end $newid [list link link1]
4781 $ctext insert end "\n "
4782 $ctext insert end [lindex $commitinfo($newid) 0]
4783 $ctext insert end "\n"
4784 $ctext conf -state disabled
4785 $ctext tag delete Comments
4786 $ctext tag remove found 1.0 end
4787 startdiff [list $oldid $newid]
4791 global rowmenuid currentid commitinfo patchtop patchnum
4793 if {![info exists currentid]} return
4794 set oldid $currentid
4795 set oldhead [lindex $commitinfo($oldid) 0]
4796 set newid $rowmenuid
4797 set newhead [lindex $commitinfo($newid) 0]
4800 catch {destroy $top}
4802 label $top.title -text "Generate patch"
4803 grid $top.title - -pady 10
4804 label $top.from -text "From:"
4805 entry $top.fromsha1 -width 40 -relief flat
4806 $top.fromsha1 insert 0 $oldid
4807 $top.fromsha1 conf -state readonly
4808 grid $top.from $top.fromsha1 -sticky w
4809 entry $top.fromhead -width 60 -relief flat
4810 $top.fromhead insert 0 $oldhead
4811 $top.fromhead conf -state readonly
4812 grid x $top.fromhead -sticky w
4813 label $top.to -text "To:"
4814 entry $top.tosha1 -width 40 -relief flat
4815 $top.tosha1 insert 0 $newid
4816 $top.tosha1 conf -state readonly
4817 grid $top.to $top.tosha1 -sticky w
4818 entry $top.tohead -width 60 -relief flat
4819 $top.tohead insert 0 $newhead
4820 $top.tohead conf -state readonly
4821 grid x $top.tohead -sticky w
4822 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4823 grid $top.rev x -pady 10
4824 label $top.flab -text "Output file:"
4825 entry $top.fname -width 60
4826 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4828 grid $top.flab $top.fname -sticky w
4830 button $top.buts.gen -text "Generate" -command mkpatchgo
4831 button $top.buts.can -text "Cancel" -command mkpatchcan
4832 grid $top.buts.gen $top.buts.can
4833 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4834 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4835 grid $top.buts - -pady 10 -sticky ew
4839 proc mkpatchrev {} {
4842 set oldid [$patchtop.fromsha1 get]
4843 set oldhead [$patchtop.fromhead get]
4844 set newid [$patchtop.tosha1 get]
4845 set newhead [$patchtop.tohead get]
4846 foreach e [list fromsha1 fromhead tosha1 tohead] \
4847 v [list $newid $newhead $oldid $oldhead] {
4848 $patchtop.$e conf -state normal
4849 $patchtop.$e delete 0 end
4850 $patchtop.$e insert 0 $v
4851 $patchtop.$e conf -state readonly
4858 set oldid [$patchtop.fromsha1 get]
4859 set newid [$patchtop.tosha1 get]
4860 set fname [$patchtop.fname get]
4861 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4862 error_popup "Error creating patch: $err"
4864 catch {destroy $patchtop}
4868 proc mkpatchcan {} {
4871 catch {destroy $patchtop}
4876 global rowmenuid mktagtop commitinfo
4880 catch {destroy $top}
4882 label $top.title -text "Create tag"
4883 grid $top.title - -pady 10
4884 label $top.id -text "ID:"
4885 entry $top.sha1 -width 40 -relief flat
4886 $top.sha1 insert 0 $rowmenuid
4887 $top.sha1 conf -state readonly
4888 grid $top.id $top.sha1 -sticky w
4889 entry $top.head -width 60 -relief flat
4890 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4891 $top.head conf -state readonly
4892 grid x $top.head -sticky w
4893 label $top.tlab -text "Tag name:"
4894 entry $top.tag -width 60
4895 grid $top.tlab $top.tag -sticky w
4897 button $top.buts.gen -text "Create" -command mktaggo
4898 button $top.buts.can -text "Cancel" -command mktagcan
4899 grid $top.buts.gen $top.buts.can
4900 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4901 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4902 grid $top.buts - -pady 10 -sticky ew
4907 global mktagtop env tagids idtags
4909 set id [$mktagtop.sha1 get]
4910 set tag [$mktagtop.tag get]
4912 error_popup "No tag name specified"
4915 if {[info exists tagids($tag)]} {
4916 error_popup "Tag \"$tag\" already exists"
4921 set fname [file join $dir "refs/tags" $tag]
4922 set f [open $fname w]
4926 error_popup "Error creating tag: $err"
4930 set tagids($tag) $id
4931 lappend idtags($id) $tag
4935 proc redrawtags {id} {
4936 global canv linehtag commitrow idpos selectedline curview
4937 global mainfont canvxmax
4939 if {![info exists commitrow($curview,$id)]} return
4940 drawcmitrow $commitrow($curview,$id)
4941 $canv delete tag.$id
4942 set xt [eval drawtags $id $idpos($id)]
4943 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4944 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4945 set xr [expr {$xt + [font measure $mainfont $text]}]
4946 if {$xr > $canvxmax} {
4950 if {[info exists selectedline]
4951 && $selectedline == $commitrow($curview,$id)} {
4952 selectline $selectedline 0
4959 catch {destroy $mktagtop}
4968 proc writecommit {} {
4969 global rowmenuid wrcomtop commitinfo wrcomcmd
4971 set top .writecommit
4973 catch {destroy $top}
4975 label $top.title -text "Write commit to file"
4976 grid $top.title - -pady 10
4977 label $top.id -text "ID:"
4978 entry $top.sha1 -width 40 -relief flat
4979 $top.sha1 insert 0 $rowmenuid
4980 $top.sha1 conf -state readonly
4981 grid $top.id $top.sha1 -sticky w
4982 entry $top.head -width 60 -relief flat
4983 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4984 $top.head conf -state readonly
4985 grid x $top.head -sticky w
4986 label $top.clab -text "Command:"
4987 entry $top.cmd -width 60 -textvariable wrcomcmd
4988 grid $top.clab $top.cmd -sticky w -pady 10
4989 label $top.flab -text "Output file:"
4990 entry $top.fname -width 60
4991 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4992 grid $top.flab $top.fname -sticky w
4994 button $top.buts.gen -text "Write" -command wrcomgo
4995 button $top.buts.can -text "Cancel" -command wrcomcan
4996 grid $top.buts.gen $top.buts.can
4997 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4998 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4999 grid $top.buts - -pady 10 -sticky ew
5006 set id [$wrcomtop.sha1 get]
5007 set cmd "echo $id | [$wrcomtop.cmd get]"
5008 set fname [$wrcomtop.fname get]
5009 if {[catch {exec sh -c $cmd >$fname &} err]} {
5010 error_popup "Error writing commit: $err"
5012 catch {destroy $wrcomtop}
5019 catch {destroy $wrcomtop}
5023 # Stuff for finding nearby tags
5024 proc getallcommits {} {
5025 global allcstart allcommits allcfd
5027 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5029 fconfigure $fd -blocking 0
5030 set allcommits "reading"
5035 proc discardallcommits {} {
5036 global allparents allchildren allcommits allcfd
5037 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5039 if {![info exists allcommits]} return
5040 if {$allcommits eq "reading"} {
5041 catch {close $allcfd}
5043 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5044 alldtags tagisdesc desc_heads} {
5049 proc restartgetall {fd} {
5052 fileevent $fd readable [list getallclines $fd]
5053 set allcstart [clock clicks -milliseconds]
5056 proc combine_dtags {l1 l2} {
5057 global tagisdesc notfirstd
5059 set res [lsort -unique [concat $l1 $l2]]
5060 for {set i 0} {$i < [llength $res]} {incr i} {
5061 set x [lindex $res $i]
5062 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5063 set y [lindex $res $j]
5064 if {[info exists tagisdesc($x,$y)]} {
5065 if {$tagisdesc($x,$y) > 0} {
5066 # x is a descendent of y, exclude x
5067 set res [lreplace $res $i $i]
5071 # y is a descendent of x, exclude y
5072 set res [lreplace $res $j $j]
5075 # no relation, keep going
5083 proc combine_atags {l1 l2} {
5086 set res [lsort -unique [concat $l1 $l2]]
5087 for {set i 0} {$i < [llength $res]} {incr i} {
5088 set x [lindex $res $i]
5089 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5090 set y [lindex $res $j]
5091 if {[info exists tagisdesc($x,$y)]} {
5092 if {$tagisdesc($x,$y) < 0} {
5093 # x is an ancestor of y, exclude x
5094 set res [lreplace $res $i $i]
5098 # y is an ancestor of x, exclude y
5099 set res [lreplace $res $j $j]
5102 # no relation, keep going
5110 proc getallclines {fd} {
5111 global allparents allchildren allcommits allcstart
5112 global desc_tags anc_tags idtags alldtags tagisdesc allids
5113 global desc_heads idheads
5115 while {[gets $fd line] >= 0} {
5116 set id [lindex $line 0]
5118 set olds [lrange $line 1 end]
5119 set allparents($id) $olds
5120 if {![info exists allchildren($id)]} {
5121 set allchildren($id) {}
5124 lappend allchildren($p) $id
5126 # compute nearest tagged descendents as we go
5127 # also compute descendent heads
5130 foreach child $allchildren($id) {
5131 if {[info exists idtags($child)]} {
5132 set ctags [list $child]
5134 set ctags $desc_tags($child)
5138 } elseif {$ctags ne $dtags} {
5139 set dtags [combine_dtags $dtags $ctags]
5141 set cheads $desc_heads($child)
5142 if {$dheads eq {}} {
5144 } elseif {$cheads ne $dheads} {
5145 set dheads [lsort -unique [concat $dheads $cheads]]
5148 set desc_tags($id) $dtags
5149 if {[info exists idtags($id)]} {
5151 foreach tag $dtags {
5152 set adt [concat $adt $alldtags($tag)]
5154 set adt [lsort -unique $adt]
5155 set alldtags($id) $adt
5157 set tagisdesc($id,$tag) -1
5158 set tagisdesc($tag,$id) 1
5161 if {[info exists idheads($id)]} {
5164 set desc_heads($id) $dheads
5165 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5166 fileevent $fd readable {}
5167 after idle restartgetall $fd
5172 after idle restartatags [llength $allids]
5173 if {[catch {close $fd} err]} {
5174 error_popup "Error reading full commit graph: $err.\n\
5175 Results may be incomplete."
5180 # walk backward through the tree and compute nearest tagged ancestors
5181 proc restartatags {i} {
5182 global allids allparents idtags anc_tags t0
5184 set t0 [clock clicks -milliseconds]
5185 while {[incr i -1] >= 0} {
5186 set id [lindex $allids $i]
5188 foreach p $allparents($id) {
5189 if {[info exists idtags($p)]} {
5192 set ptags $anc_tags($p)
5196 } elseif {$ptags ne $atags} {
5197 set atags [combine_atags $atags $ptags]
5200 set anc_tags($id) $atags
5201 if {[clock clicks -milliseconds] - $t0 >= 50} {
5202 after idle restartatags $i
5206 set allcommits "done"
5211 proc rereadrefs {} {
5212 global idtags idheads idotherrefs
5214 set refids [concat [array names idtags] \
5215 [array names idheads] [array names idotherrefs]]
5216 foreach id $refids {
5217 if {![info exists ref($id)]} {
5218 set ref($id) [listrefs $id]
5222 set refids [lsort -unique [concat $refids [array names idtags] \
5223 [array names idheads] [array names idotherrefs]]]
5224 foreach id $refids {
5225 set v [listrefs $id]
5226 if {![info exists ref($id)] || $ref($id) != $v} {
5232 proc listrefs {id} {
5233 global idtags idheads idotherrefs
5236 if {[info exists idtags($id)]} {
5240 if {[info exists idheads($id)]} {
5244 if {[info exists idotherrefs($id)]} {
5245 set z $idotherrefs($id)
5247 return [list $x $y $z]
5250 proc showtag {tag isnew} {
5251 global ctext tagcontents tagids linknum
5254 addtohistory [list showtag $tag 0]
5256 $ctext conf -state normal
5259 if {[info exists tagcontents($tag)]} {
5260 set text $tagcontents($tag)
5262 set text "Tag: $tag\nId: $tagids($tag)"
5264 appendwithlinks $text {}
5265 $ctext conf -state disabled
5276 global maxwidth maxgraphpct diffopts
5277 global oldprefs prefstop showneartags
5278 global bgcolor fgcolor ctext diffcolors
5282 if {[winfo exists $top]} {
5286 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5287 set oldprefs($v) [set $v]
5290 wm title $top "Gitk preferences"
5291 label $top.ldisp -text "Commit list display options"
5292 grid $top.ldisp - -sticky w -pady 10
5293 label $top.spacer -text " "
5294 label $top.maxwidthl -text "Maximum graph width (lines)" \
5296 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5297 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5298 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5300 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5301 grid x $top.maxpctl $top.maxpct -sticky w
5303 label $top.ddisp -text "Diff display options"
5304 grid $top.ddisp - -sticky w -pady 10
5305 label $top.diffoptl -text "Options for diff program" \
5307 entry $top.diffopt -width 20 -textvariable diffopts
5308 grid x $top.diffoptl $top.diffopt -sticky w
5310 label $top.ntag.l -text "Display nearby tags" -font optionfont
5311 checkbutton $top.ntag.b -variable showneartags
5312 pack $top.ntag.b $top.ntag.l -side left
5313 grid x $top.ntag -sticky w
5315 label $top.cdisp -text "Colors: press to choose"
5316 grid $top.cdisp - -sticky w -pady 10
5317 label $top.bg -padx 40 -relief sunk -background $bgcolor
5318 button $top.bgbut -text "Background" -font optionfont \
5319 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5320 grid x $top.bgbut $top.bg -sticky w
5321 label $top.fg -padx 40 -relief sunk -background $fgcolor
5322 button $top.fgbut -text "Foreground" -font optionfont \
5323 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5324 grid x $top.fgbut $top.fg -sticky w
5325 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5326 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5327 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5328 [list $ctext tag conf d0 -foreground]]
5329 grid x $top.diffoldbut $top.diffold -sticky w
5330 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5331 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5332 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5333 [list $ctext tag conf d1 -foreground]]
5334 grid x $top.diffnewbut $top.diffnew -sticky w
5335 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5336 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5337 -command [list choosecolor diffcolors 2 $top.hunksep \
5338 "diff hunk header" \
5339 [list $ctext tag conf hunksep -foreground]]
5340 grid x $top.hunksepbut $top.hunksep -sticky w
5343 button $top.buts.ok -text "OK" -command prefsok
5344 button $top.buts.can -text "Cancel" -command prefscan
5345 grid $top.buts.ok $top.buts.can
5346 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5347 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5348 grid $top.buts - - -pady 10 -sticky ew
5351 proc choosecolor {v vi w x cmd} {
5354 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5355 -title "Gitk: choose color for $x"]
5356 if {$c eq {}} return
5357 $w conf -background $c
5366 $w conf -background $c
5374 $w conf -foreground $c
5376 allcanvs itemconf text -fill $c
5377 $canv itemconf circle -outline $c
5381 global maxwidth maxgraphpct diffopts
5382 global oldprefs prefstop showneartags
5384 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5385 set $v $oldprefs($v)
5387 catch {destroy $prefstop}
5392 global maxwidth maxgraphpct
5393 global oldprefs prefstop showneartags
5395 catch {destroy $prefstop}
5397 if {$maxwidth != $oldprefs(maxwidth)
5398 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5400 } elseif {$showneartags != $oldprefs(showneartags)} {
5405 proc formatdate {d} {
5406 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5409 # This list of encoding names and aliases is distilled from
5410 # http://www.iana.org/assignments/character-sets.
5411 # Not all of them are supported by Tcl.
5412 set encoding_aliases {
5413 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5414 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5415 { ISO-10646-UTF-1 csISO10646UTF1 }
5416 { ISO_646.basic:1983 ref csISO646basic1983 }
5417 { INVARIANT csINVARIANT }
5418 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5419 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5420 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5421 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5422 { NATS-DANO iso-ir-9-1 csNATSDANO }
5423 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5424 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5425 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5426 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5427 { ISO-2022-KR csISO2022KR }
5429 { ISO-2022-JP csISO2022JP }
5430 { ISO-2022-JP-2 csISO2022JP2 }
5431 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5433 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5434 { IT iso-ir-15 ISO646-IT csISO15Italian }
5435 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5436 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5437 { greek7-old iso-ir-18 csISO18Greek7Old }
5438 { latin-greek iso-ir-19 csISO19LatinGreek }
5439 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5440 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5441 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5442 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5443 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5444 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5445 { INIS iso-ir-49 csISO49INIS }
5446 { INIS-8 iso-ir-50 csISO50INIS8 }
5447 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5448 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5449 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5450 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5451 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5452 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5454 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5455 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5456 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5457 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5458 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5459 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5460 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5461 { greek7 iso-ir-88 csISO88Greek7 }
5462 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5463 { iso-ir-90 csISO90 }
5464 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5465 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5466 csISO92JISC62991984b }
5467 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5468 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5469 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5470 csISO95JIS62291984handadd }
5471 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5472 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5473 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5474 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5476 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5477 { T.61-7bit iso-ir-102 csISO102T617bit }
5478 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5479 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5480 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5481 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5482 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5483 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5484 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5485 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5486 arabic csISOLatinArabic }
5487 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5488 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5489 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5490 greek greek8 csISOLatinGreek }
5491 { T.101-G2 iso-ir-128 csISO128T101G2 }
5492 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5494 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5495 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5496 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5497 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5498 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5499 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5500 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5501 csISOLatinCyrillic }
5502 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5503 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5504 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5505 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5506 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5507 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5508 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5509 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5510 { ISO_10367-box iso-ir-155 csISO10367Box }
5511 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5512 { latin-lap lap iso-ir-158 csISO158Lap }
5513 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5514 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5517 { JIS_X0201 X0201 csHalfWidthKatakana }
5518 { KSC5636 ISO646-KR csKSC5636 }
5519 { ISO-10646-UCS-2 csUnicode }
5520 { ISO-10646-UCS-4 csUCS4 }
5521 { DEC-MCS dec csDECMCS }
5522 { hp-roman8 roman8 r8 csHPRoman8 }
5523 { macintosh mac csMacintosh }
5524 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5526 { IBM038 EBCDIC-INT cp038 csIBM038 }
5527 { IBM273 CP273 csIBM273 }
5528 { IBM274 EBCDIC-BE CP274 csIBM274 }
5529 { IBM275 EBCDIC-BR cp275 csIBM275 }
5530 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5531 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5532 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5533 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5534 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5535 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5536 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5537 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5538 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5539 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5540 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5541 { IBM437 cp437 437 csPC8CodePage437 }
5542 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5543 { IBM775 cp775 csPC775Baltic }
5544 { IBM850 cp850 850 csPC850Multilingual }
5545 { IBM851 cp851 851 csIBM851 }
5546 { IBM852 cp852 852 csPCp852 }
5547 { IBM855 cp855 855 csIBM855 }
5548 { IBM857 cp857 857 csIBM857 }
5549 { IBM860 cp860 860 csIBM860 }
5550 { IBM861 cp861 861 cp-is csIBM861 }
5551 { IBM862 cp862 862 csPC862LatinHebrew }
5552 { IBM863 cp863 863 csIBM863 }
5553 { IBM864 cp864 csIBM864 }
5554 { IBM865 cp865 865 csIBM865 }
5555 { IBM866 cp866 866 csIBM866 }
5556 { IBM868 CP868 cp-ar csIBM868 }
5557 { IBM869 cp869 869 cp-gr csIBM869 }
5558 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5559 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5560 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5561 { IBM891 cp891 csIBM891 }
5562 { IBM903 cp903 csIBM903 }
5563 { IBM904 cp904 904 csIBBM904 }
5564 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5565 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5566 { IBM1026 CP1026 csIBM1026 }
5567 { EBCDIC-AT-DE csIBMEBCDICATDE }
5568 { EBCDIC-AT-DE-A csEBCDICATDEA }
5569 { EBCDIC-CA-FR csEBCDICCAFR }
5570 { EBCDIC-DK-NO csEBCDICDKNO }
5571 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5572 { EBCDIC-FI-SE csEBCDICFISE }
5573 { EBCDIC-FI-SE-A csEBCDICFISEA }
5574 { EBCDIC-FR csEBCDICFR }
5575 { EBCDIC-IT csEBCDICIT }
5576 { EBCDIC-PT csEBCDICPT }
5577 { EBCDIC-ES csEBCDICES }
5578 { EBCDIC-ES-A csEBCDICESA }
5579 { EBCDIC-ES-S csEBCDICESS }
5580 { EBCDIC-UK csEBCDICUK }
5581 { EBCDIC-US csEBCDICUS }
5582 { UNKNOWN-8BIT csUnknown8BiT }
5583 { MNEMONIC csMnemonic }
5588 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5589 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5590 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5591 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5592 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5593 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5594 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5595 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5596 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5597 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5598 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5599 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5600 { IBM1047 IBM-1047 }
5601 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5602 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5603 { UNICODE-1-1 csUnicode11 }
5606 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5607 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5609 { ISO-8859-15 ISO_8859-15 Latin-9 }
5610 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5611 { GBK CP936 MS936 windows-936 }
5612 { JIS_Encoding csJISEncoding }
5613 { Shift_JIS MS_Kanji csShiftJIS }
5614 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5616 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5617 { ISO-10646-UCS-Basic csUnicodeASCII }
5618 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5619 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5620 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5621 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5622 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5623 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5624 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5625 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5626 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5627 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5628 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5629 { Ventura-US csVenturaUS }
5630 { Ventura-International csVenturaInternational }
5631 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5632 { PC8-Turkish csPC8Turkish }
5633 { IBM-Symbols csIBMSymbols }
5634 { IBM-Thai csIBMThai }
5635 { HP-Legal csHPLegal }
5636 { HP-Pi-font csHPPiFont }
5637 { HP-Math8 csHPMath8 }
5638 { Adobe-Symbol-Encoding csHPPSMath }
5639 { HP-DeskTop csHPDesktop }
5640 { Ventura-Math csVenturaMath }
5641 { Microsoft-Publishing csMicrosoftPublishing }
5642 { Windows-31J csWindows31J }
5647 proc tcl_encoding {enc} {
5648 global encoding_aliases
5649 set names [encoding names]
5650 set lcnames [string tolower $names]
5651 set enc [string tolower $enc]
5652 set i [lsearch -exact $lcnames $enc]
5654 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5655 if {[regsub {^iso[-_]} $enc iso encx]} {
5656 set i [lsearch -exact $lcnames $encx]
5660 foreach l $encoding_aliases {
5661 set ll [string tolower $l]
5662 if {[lsearch -exact $ll $enc] < 0} continue
5663 # look through the aliases for one that tcl knows about
5665 set i [lsearch -exact $lcnames $e]
5667 if {[regsub {^iso[-_]} $e iso ex]} {
5668 set i [lsearch -exact $lcnames $ex]
5677 return [lindex $names $i]
5684 set diffopts "-U 5 -p"
5685 set wrcomcmd "git diff-tree --stdin -p --pretty"
5689 set gitencoding [exec git repo-config --get i18n.commitencoding]
5691 if {$gitencoding == ""} {
5692 set gitencoding "utf-8"
5694 set tclencoding [tcl_encoding $gitencoding]
5695 if {$tclencoding == {}} {
5696 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5699 set mainfont {Helvetica 9}
5700 set textfont {Courier 9}
5701 set uifont {Helvetica 9 bold}
5702 set findmergefiles 0
5710 set cmitmode "patch"
5711 set wrapcomment "none"
5714 set colors {green red blue magenta darkgrey brown orange}
5717 set diffcolors {red "#00a000" blue}
5719 catch {source ~/.gitk}
5721 font create optionfont -family sans-serif -size -12
5725 switch -regexp -- $arg {
5727 "^-d" { set datemode 1 }
5729 lappend revtreeargs $arg
5734 # check that we can find a .git directory somewhere...
5736 if {![file isdirectory $gitdir]} {
5737 show_error {} . "Cannot find the git directory \"$gitdir\"."
5741 set cmdline_files {}
5742 set i [lsearch -exact $revtreeargs "--"]
5744 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5745 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5746 } elseif {$revtreeargs ne {}} {
5748 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5749 set cmdline_files [split $f "\n"]
5750 set n [llength $cmdline_files]
5751 set revtreeargs [lrange $revtreeargs 0 end-$n]
5753 # unfortunately we get both stdout and stderr in $err,
5754 # so look for "fatal:".
5755 set i [string first "fatal:" $err]
5757 set err [string range $err [expr {$i + 6}] end]
5759 show_error {} . "Bad arguments to gitk:\n$err"
5768 set highlight_paths {}
5769 set searchdirn -forwards
5778 set selectedhlview None
5791 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5792 # create a view for the files/dirs specified on the command line
5796 set viewname(1) "Command line"
5797 set viewfiles(1) $cmdline_files
5798 set viewargs(1) $revtreeargs
5801 .bar.view entryconf 2 -state normal
5802 .bar.view entryconf 3 -state normal
5805 if {[info exists permviews]} {
5806 foreach v $permviews {
5809 set viewname($n) [lindex $v 0]
5810 set viewfiles($n) [lindex $v 1]
5811 set viewargs($n) [lindex $v 2]