gitk: Fix a couple of buglets in the branch head menu items
[git.git] / gitk
blob596f605868811df9454f3f889294bd76c8792ffd
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005-2006 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.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
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}]
26 set ncmupdate 1
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"
33 if {$datemode} {
34 set order "--date-order"
36 if {[catch {
37 set fd [open [concat | git rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git rev-list: $err"
41 exit 1
43 set commfd($view) $fd
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]
50 nowbusy $view
53 proc stop_rev_list {} {
54 global commfd curview
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
58 catch {
59 set pid [pid $fd]
60 exec kill $pid
62 catch {close $fd}
63 unset commfd($curview)
66 proc getcommits {} {
67 global phase canv mainfont curview
69 set phase getcommits
70 initlayout
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
82 set stuff [read $fd]
83 if {$stuff == {}} {
84 if {![eof $fd]} return
85 global viewname
86 unset commfd($view)
87 notbusy $view
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {[catch {close $fd} err]} {
91 set fv {}
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"} {
99 append err \
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
103 } else {
104 set err "Error reading commits$fv: $err"
106 error_popup $err
108 if {$view == $curview} {
109 after idle finishcommits
111 return
113 set start 0
114 set gotsome 0
115 while 1 {
116 set i [string first "\0" $stuff $start]
117 if {$i < 0} {
118 append leftover($view) [string range $stuff $start end]
119 break
121 if {$start == 0} {
122 set cmit $leftover($view)
123 append cmit [string range $stuff 0 [expr {$i - 1}]]
124 set leftover($view) {}
125 } else {
126 set cmit [string range $stuff $start [expr {$i - 1}]]
128 set start [expr {$i + 1}]
129 set j [string first "\n" $cmit]
130 set ok 0
131 set listed 1
132 if {$j >= 0} {
133 set ids [string range $cmit 0 [expr {$j - 1}]]
134 if {[string range $ids 0 0] == "-"} {
135 set listed 0
136 set ids [string range $ids 1 end]
138 set ok 1
139 foreach id $ids {
140 if {[string length $id] != 40} {
141 set ok 0
142 break
146 if {!$ok} {
147 set shortcmit $cmit
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}"
152 exit 1
154 set id [lindex $ids 0]
155 if {$listed} {
156 set olds [lrange $ids 1 end]
157 set i 0
158 foreach p $olds {
159 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160 lappend children($view,$p) $id
162 incr i
164 } else {
165 set olds {}
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
178 } else {
179 lappend vparentlist($view) $olds
180 lappend vchildlist($view) $children($view,$id)
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) $listed
184 set gotsome 1
186 if {$gotsome} {
187 if {$view == $curview} {
188 layoutmore
189 } elseif {[info exists hlview] && $view == $hlview} {
190 vhighlightmore
193 if {[clock clicks -milliseconds] >= $nextupdate} {
194 doupdate
198 proc doupdate {} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
204 update
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}]
210 } else {
211 set ncmupdate [expr {$numcommits + 100}]
213 foreach v [array names commfd] {
214 set fd $commfd($v)
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
228 if {$phase ne {}} {
229 stop_rev_list
230 set phase {}
232 set n $curview
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
237 set curview -1
238 catch {unset selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
241 discardallcommits
242 readrefs
243 showview $n
246 proc parsecommit {id contents listed} {
247 global commitinfo cdate
249 set inhdr 1
250 set comment {}
251 set headline {}
252 set auname {}
253 set audate {}
254 set comname {}
255 set comdate {}
256 set hdrend [string first "\n\n" $contents]
257 if {$hdrend < 0} {
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]
273 set headline {}
274 # take the first line of the comment as the headline
275 set i [string first "\n" $comment]
276 if {$i >= 0} {
277 set headline [string trim [string range $comment 0 $i]]
278 } else {
279 set headline $comment
281 if {!$listed} {
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
284 set newcomment {}
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
304 } else {
305 readcommit $id
306 if {![info exists commitinfo($id)]} {
307 set commitinfo($id) {"No commit information available"}
310 return 1
313 proc readrefs {} {
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs mainhead
317 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
318 catch {unset $v}
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 \
323 match id path]} {
324 continue
326 if {[regexp {^remotes/.*/HEAD$} $path match]} {
327 continue
329 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
330 set type others
331 set name $path
333 if {[regexp {^remotes/} $path match]} {
334 set type heads
336 if {$type == "tags"} {
337 set tagids($name) $id
338 lappend idtags($id) $name
339 set obj {}
340 set type {}
341 set tag {}
342 catch {
343 set commit [exec git rev-parse "$id^0"]
344 if {$commit != $id} {
345 set tagids($name) $commit
346 lappend idtags($commit) $name
349 catch {
350 set tagcontents($name) [exec git cat-file tag $id]
352 } elseif { $type == "heads" } {
353 set headids($name) $id
354 lappend idheads($id) $name
355 } else {
356 set otherrefids($name) $id
357 lappend idotherrefs($id) $name
360 close $refd
361 set mainhead {}
362 catch {
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"
377 tkwait window $top
380 proc error_popup msg {
381 set w .error
382 toplevel $w
383 wm transient $w .
384 show_error $w $w $msg
387 proc confirm_popup msg {
388 global confirm_ok
389 set confirm_ok 0
390 set w .confirm
391 toplevel $w
392 wm transient $w .
393 message $w.m -text $msg -justify center -aspect 400
394 pack $w.m -side top -fill x -padx 20 -pady 20
395 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
396 pack $w.ok -side left -fill x
397 button $w.cancel -text Cancel -command "destroy $w"
398 pack $w.cancel -side right -fill x
399 bind $w <Visibility> "grab $w; focus $w"
400 tkwait window $w
401 return $confirm_ok
404 proc makewindow {} {
405 global canv canv2 canv3 linespc charspc ctext cflist
406 global textfont mainfont uifont
407 global findtype findtypemenu findloc findstring fstring geometry
408 global entries sha1entry sha1string sha1but
409 global maincursor textcursor curtextcursor
410 global rowctxmenu mergemax wrapcomment
411 global highlight_files gdttype
412 global searchstring sstring
413 global bgcolor fgcolor bglist fglist diffcolors
414 global headctxmenu
416 menu .bar
417 .bar add cascade -label "File" -menu .bar.file
418 .bar configure -font $uifont
419 menu .bar.file
420 .bar.file add command -label "Update" -command updatecommits
421 .bar.file add command -label "Reread references" -command rereadrefs
422 .bar.file add command -label "Quit" -command doquit
423 .bar.file configure -font $uifont
424 menu .bar.edit
425 .bar add cascade -label "Edit" -menu .bar.edit
426 .bar.edit add command -label "Preferences" -command doprefs
427 .bar.edit configure -font $uifont
429 menu .bar.view -font $uifont
430 .bar add cascade -label "View" -menu .bar.view
431 .bar.view add command -label "New view..." -command {newview 0}
432 .bar.view add command -label "Edit view..." -command editview \
433 -state disabled
434 .bar.view add command -label "Delete view" -command delview -state disabled
435 .bar.view add separator
436 .bar.view add radiobutton -label "All files" -command {showview 0} \
437 -variable selectedview -value 0
439 menu .bar.help
440 .bar add cascade -label "Help" -menu .bar.help
441 .bar.help add command -label "About gitk" -command about
442 .bar.help add command -label "Key bindings" -command keys
443 .bar.help configure -font $uifont
444 . configure -menu .bar
446 if {![info exists geometry(canv1)]} {
447 set geometry(canv1) [expr {45 * $charspc}]
448 set geometry(canv2) [expr {30 * $charspc}]
449 set geometry(canv3) [expr {15 * $charspc}]
450 set geometry(canvh) [expr {25 * $linespc + 4}]
451 set geometry(ctextw) 80
452 set geometry(ctexth) 30
453 set geometry(cflistw) 30
455 panedwindow .ctop -orient vertical
456 if {[info exists geometry(width)]} {
457 .ctop conf -width $geometry(width) -height $geometry(height)
458 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
459 set geometry(ctexth) [expr {($texth - 8) /
460 [font metrics $textfont -linespace]}]
462 frame .ctop.top
463 frame .ctop.top.bar
464 frame .ctop.top.lbar
465 pack .ctop.top.lbar -side bottom -fill x
466 pack .ctop.top.bar -side bottom -fill x
467 set cscroll .ctop.top.csb
468 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
469 pack $cscroll -side right -fill y
470 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
471 pack .ctop.top.clist -side top -fill both -expand 1
472 .ctop add .ctop.top
473 set canv .ctop.top.clist.canv
474 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
475 -background $bgcolor -bd 0 \
476 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
477 .ctop.top.clist add $canv
478 set canv2 .ctop.top.clist.canv2
479 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
480 -background $bgcolor -bd 0 -yscrollincr $linespc
481 .ctop.top.clist add $canv2
482 set canv3 .ctop.top.clist.canv3
483 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
484 -background $bgcolor -bd 0 -yscrollincr $linespc
485 .ctop.top.clist add $canv3
486 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
487 lappend bglist $canv $canv2 $canv3
489 set sha1entry .ctop.top.bar.sha1
490 set entries $sha1entry
491 set sha1but .ctop.top.bar.sha1label
492 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
493 -command gotocommit -width 8 -font $uifont
494 $sha1but conf -disabledforeground [$sha1but cget -foreground]
495 pack .ctop.top.bar.sha1label -side left
496 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
497 trace add variable sha1string write sha1change
498 pack $sha1entry -side left -pady 2
500 image create bitmap bm-left -data {
501 #define left_width 16
502 #define left_height 16
503 static unsigned char left_bits[] = {
504 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
505 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
506 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
508 image create bitmap bm-right -data {
509 #define right_width 16
510 #define right_height 16
511 static unsigned char right_bits[] = {
512 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
513 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
514 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
516 button .ctop.top.bar.leftbut -image bm-left -command goback \
517 -state disabled -width 26
518 pack .ctop.top.bar.leftbut -side left -fill y
519 button .ctop.top.bar.rightbut -image bm-right -command goforw \
520 -state disabled -width 26
521 pack .ctop.top.bar.rightbut -side left -fill y
523 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
524 pack .ctop.top.bar.findbut -side left
525 set findstring {}
526 set fstring .ctop.top.bar.findstring
527 lappend entries $fstring
528 entry $fstring -width 30 -font $textfont -textvariable findstring
529 trace add variable findstring write find_change
530 pack $fstring -side left -expand 1 -fill x
531 set findtype Exact
532 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
533 findtype Exact IgnCase Regexp]
534 trace add variable findtype write find_change
535 .ctop.top.bar.findtype configure -font $uifont
536 .ctop.top.bar.findtype.menu configure -font $uifont
537 set findloc "All fields"
538 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
539 Comments Author Committer
540 trace add variable findloc write find_change
541 .ctop.top.bar.findloc configure -font $uifont
542 .ctop.top.bar.findloc.menu configure -font $uifont
543 pack .ctop.top.bar.findloc -side right
544 pack .ctop.top.bar.findtype -side right
546 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
547 -font $uifont
548 pack .ctop.top.lbar.flabel -side left -fill y
549 set gdttype "touching paths:"
550 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
551 "adding/removing string:"]
552 trace add variable gdttype write hfiles_change
553 $gm conf -font $uifont
554 .ctop.top.lbar.gdttype conf -font $uifont
555 pack .ctop.top.lbar.gdttype -side left -fill y
556 entry .ctop.top.lbar.fent -width 25 -font $textfont \
557 -textvariable highlight_files
558 trace add variable highlight_files write hfiles_change
559 lappend entries .ctop.top.lbar.fent
560 pack .ctop.top.lbar.fent -side left -fill x -expand 1
561 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
562 pack .ctop.top.lbar.vlabel -side left -fill y
563 global viewhlmenu selectedhlview
564 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
565 $viewhlmenu entryconf 0 -command delvhighlight
566 $viewhlmenu conf -font $uifont
567 .ctop.top.lbar.vhl conf -font $uifont
568 pack .ctop.top.lbar.vhl -side left -fill y
569 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
570 pack .ctop.top.lbar.rlabel -side left -fill y
571 global highlight_related
572 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
573 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
574 $m conf -font $uifont
575 .ctop.top.lbar.relm conf -font $uifont
576 trace add variable highlight_related write vrel_change
577 pack .ctop.top.lbar.relm -side left -fill y
579 panedwindow .ctop.cdet -orient horizontal
580 .ctop add .ctop.cdet
581 frame .ctop.cdet.left
582 frame .ctop.cdet.left.bot
583 pack .ctop.cdet.left.bot -side bottom -fill x
584 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
585 -font $uifont
586 pack .ctop.cdet.left.bot.search -side left -padx 5
587 set sstring .ctop.cdet.left.bot.sstring
588 entry $sstring -width 20 -font $textfont -textvariable searchstring
589 lappend entries $sstring
590 trace add variable searchstring write incrsearch
591 pack $sstring -side left -expand 1 -fill x
592 set ctext .ctop.cdet.left.ctext
593 text $ctext -background $bgcolor -foreground $fgcolor \
594 -state disabled -font $textfont \
595 -width $geometry(ctextw) -height $geometry(ctexth) \
596 -yscrollcommand scrolltext -wrap none
597 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
598 pack .ctop.cdet.left.sb -side right -fill y
599 pack $ctext -side left -fill both -expand 1
600 .ctop.cdet add .ctop.cdet.left
601 lappend bglist $ctext
602 lappend fglist $ctext
604 $ctext tag conf comment -wrap $wrapcomment
605 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
606 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
607 $ctext tag conf d0 -fore [lindex $diffcolors 0]
608 $ctext tag conf d1 -fore [lindex $diffcolors 1]
609 $ctext tag conf m0 -fore red
610 $ctext tag conf m1 -fore blue
611 $ctext tag conf m2 -fore green
612 $ctext tag conf m3 -fore purple
613 $ctext tag conf m4 -fore brown
614 $ctext tag conf m5 -fore "#009090"
615 $ctext tag conf m6 -fore magenta
616 $ctext tag conf m7 -fore "#808000"
617 $ctext tag conf m8 -fore "#009000"
618 $ctext tag conf m9 -fore "#ff0080"
619 $ctext tag conf m10 -fore cyan
620 $ctext tag conf m11 -fore "#b07070"
621 $ctext tag conf m12 -fore "#70b0f0"
622 $ctext tag conf m13 -fore "#70f0b0"
623 $ctext tag conf m14 -fore "#f0b070"
624 $ctext tag conf m15 -fore "#ff70b0"
625 $ctext tag conf mmax -fore darkgrey
626 set mergemax 16
627 $ctext tag conf mresult -font [concat $textfont bold]
628 $ctext tag conf msep -font [concat $textfont bold]
629 $ctext tag conf found -back yellow
631 frame .ctop.cdet.right
632 frame .ctop.cdet.right.mode
633 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
634 -command reselectline -variable cmitmode -value "patch"
635 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
636 -command reselectline -variable cmitmode -value "tree"
637 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
638 pack .ctop.cdet.right.mode -side top -fill x
639 set cflist .ctop.cdet.right.cfiles
640 set indent [font measure $mainfont "nn"]
641 text $cflist -width $geometry(cflistw) \
642 -background $bgcolor -foreground $fgcolor \
643 -font $mainfont \
644 -tabs [list $indent [expr {2 * $indent}]] \
645 -yscrollcommand ".ctop.cdet.right.sb set" \
646 -cursor [. cget -cursor] \
647 -spacing1 1 -spacing3 1
648 lappend bglist $cflist
649 lappend fglist $cflist
650 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
651 pack .ctop.cdet.right.sb -side right -fill y
652 pack $cflist -side left -fill both -expand 1
653 $cflist tag configure highlight \
654 -background [$cflist cget -selectbackground]
655 $cflist tag configure bold -font [concat $mainfont bold]
656 .ctop.cdet add .ctop.cdet.right
657 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
659 pack .ctop -side top -fill both -expand 1
661 bindall <1> {selcanvline %W %x %y}
662 #bindall <B1-Motion> {selcanvline %W %x %y}
663 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
664 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
665 bindall <2> "canvscan mark %W %x %y"
666 bindall <B2-Motion> "canvscan dragto %W %x %y"
667 bindkey <Home> selfirstline
668 bindkey <End> sellastline
669 bind . <Key-Up> "selnextline -1"
670 bind . <Key-Down> "selnextline 1"
671 bind . <Shift-Key-Up> "next_highlight -1"
672 bind . <Shift-Key-Down> "next_highlight 1"
673 bindkey <Key-Right> "goforw"
674 bindkey <Key-Left> "goback"
675 bind . <Key-Prior> "selnextpage -1"
676 bind . <Key-Next> "selnextpage 1"
677 bind . <Control-Home> "allcanvs yview moveto 0.0"
678 bind . <Control-End> "allcanvs yview moveto 1.0"
679 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
680 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
681 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
682 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
683 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
684 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
685 bindkey <Key-space> "$ctext yview scroll 1 pages"
686 bindkey p "selnextline -1"
687 bindkey n "selnextline 1"
688 bindkey z "goback"
689 bindkey x "goforw"
690 bindkey i "selnextline -1"
691 bindkey k "selnextline 1"
692 bindkey j "goback"
693 bindkey l "goforw"
694 bindkey b "$ctext yview scroll -1 pages"
695 bindkey d "$ctext yview scroll 18 units"
696 bindkey u "$ctext yview scroll -18 units"
697 bindkey / {findnext 1}
698 bindkey <Key-Return> {findnext 0}
699 bindkey ? findprev
700 bindkey f nextfile
701 bind . <Control-q> doquit
702 bind . <Control-f> dofind
703 bind . <Control-g> {findnext 0}
704 bind . <Control-r> dosearchback
705 bind . <Control-s> dosearch
706 bind . <Control-equal> {incrfont 1}
707 bind . <Control-KP_Add> {incrfont 1}
708 bind . <Control-minus> {incrfont -1}
709 bind . <Control-KP_Subtract> {incrfont -1}
710 bind . <Destroy> {savestuff %W}
711 bind . <Button-1> "click %W"
712 bind $fstring <Key-Return> dofind
713 bind $sha1entry <Key-Return> gotocommit
714 bind $sha1entry <<PasteSelection>> clearsha1
715 bind $cflist <1> {sel_flist %W %x %y; break}
716 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
717 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
719 set maincursor [. cget -cursor]
720 set textcursor [$ctext cget -cursor]
721 set curtextcursor $textcursor
723 set rowctxmenu .rowctxmenu
724 menu $rowctxmenu -tearoff 0
725 $rowctxmenu add command -label "Diff this -> selected" \
726 -command {diffvssel 0}
727 $rowctxmenu add command -label "Diff selected -> this" \
728 -command {diffvssel 1}
729 $rowctxmenu add command -label "Make patch" -command mkpatch
730 $rowctxmenu add command -label "Create tag" -command mktag
731 $rowctxmenu add command -label "Write commit to file" -command writecommit
732 $rowctxmenu add command -label "Create new branch" -command mkbranch
734 set headctxmenu .headctxmenu
735 menu $headctxmenu -tearoff 0
736 $headctxmenu add command -label "Check out this branch" \
737 -command cobranch
738 $headctxmenu add command -label "Remove this branch" \
739 -command rmbranch
742 # mouse-2 makes all windows scan vertically, but only the one
743 # the cursor is in scans horizontally
744 proc canvscan {op w x y} {
745 global canv canv2 canv3
746 foreach c [list $canv $canv2 $canv3] {
747 if {$c == $w} {
748 $c scan $op $x $y
749 } else {
750 $c scan $op 0 $y
755 proc scrollcanv {cscroll f0 f1} {
756 $cscroll set $f0 $f1
757 drawfrac $f0 $f1
758 flushhighlights
761 # when we make a key binding for the toplevel, make sure
762 # it doesn't get triggered when that key is pressed in the
763 # find string entry widget.
764 proc bindkey {ev script} {
765 global entries
766 bind . $ev $script
767 set escript [bind Entry $ev]
768 if {$escript == {}} {
769 set escript [bind Entry <Key>]
771 foreach e $entries {
772 bind $e $ev "$escript; break"
776 # set the focus back to the toplevel for any click outside
777 # the entry widgets
778 proc click {w} {
779 global entries
780 foreach e $entries {
781 if {$w == $e} return
783 focus .
786 proc savestuff {w} {
787 global canv canv2 canv3 ctext cflist mainfont textfont uifont
788 global stuffsaved findmergefiles maxgraphpct
789 global maxwidth showneartags
790 global viewname viewfiles viewargs viewperm nextviewnum
791 global cmitmode wrapcomment
792 global colors bgcolor fgcolor diffcolors
794 if {$stuffsaved} return
795 if {![winfo viewable .]} return
796 catch {
797 set f [open "~/.gitk-new" w]
798 puts $f [list set mainfont $mainfont]
799 puts $f [list set textfont $textfont]
800 puts $f [list set uifont $uifont]
801 puts $f [list set findmergefiles $findmergefiles]
802 puts $f [list set maxgraphpct $maxgraphpct]
803 puts $f [list set maxwidth $maxwidth]
804 puts $f [list set cmitmode $cmitmode]
805 puts $f [list set wrapcomment $wrapcomment]
806 puts $f [list set showneartags $showneartags]
807 puts $f [list set bgcolor $bgcolor]
808 puts $f [list set fgcolor $fgcolor]
809 puts $f [list set colors $colors]
810 puts $f [list set diffcolors $diffcolors]
811 puts $f "set geometry(width) [winfo width .ctop]"
812 puts $f "set geometry(height) [winfo height .ctop]"
813 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
814 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
815 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
816 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
817 set wid [expr {([winfo width $ctext] - 8) \
818 / [font measure $textfont "0"]}]
819 puts $f "set geometry(ctextw) $wid"
820 set wid [expr {([winfo width $cflist] - 11) \
821 / [font measure [$cflist cget -font] "0"]}]
822 puts $f "set geometry(cflistw) $wid"
823 puts -nonewline $f "set permviews {"
824 for {set v 0} {$v < $nextviewnum} {incr v} {
825 if {$viewperm($v)} {
826 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
829 puts $f "}"
830 close $f
831 file rename -force "~/.gitk-new" "~/.gitk"
833 set stuffsaved 1
836 proc resizeclistpanes {win w} {
837 global oldwidth
838 if {[info exists oldwidth($win)]} {
839 set s0 [$win sash coord 0]
840 set s1 [$win sash coord 1]
841 if {$w < 60} {
842 set sash0 [expr {int($w/2 - 2)}]
843 set sash1 [expr {int($w*5/6 - 2)}]
844 } else {
845 set factor [expr {1.0 * $w / $oldwidth($win)}]
846 set sash0 [expr {int($factor * [lindex $s0 0])}]
847 set sash1 [expr {int($factor * [lindex $s1 0])}]
848 if {$sash0 < 30} {
849 set sash0 30
851 if {$sash1 < $sash0 + 20} {
852 set sash1 [expr {$sash0 + 20}]
854 if {$sash1 > $w - 10} {
855 set sash1 [expr {$w - 10}]
856 if {$sash0 > $sash1 - 20} {
857 set sash0 [expr {$sash1 - 20}]
861 $win sash place 0 $sash0 [lindex $s0 1]
862 $win sash place 1 $sash1 [lindex $s1 1]
864 set oldwidth($win) $w
867 proc resizecdetpanes {win w} {
868 global oldwidth
869 if {[info exists oldwidth($win)]} {
870 set s0 [$win sash coord 0]
871 if {$w < 60} {
872 set sash0 [expr {int($w*3/4 - 2)}]
873 } else {
874 set factor [expr {1.0 * $w / $oldwidth($win)}]
875 set sash0 [expr {int($factor * [lindex $s0 0])}]
876 if {$sash0 < 45} {
877 set sash0 45
879 if {$sash0 > $w - 15} {
880 set sash0 [expr {$w - 15}]
883 $win sash place 0 $sash0 [lindex $s0 1]
885 set oldwidth($win) $w
888 proc allcanvs args {
889 global canv canv2 canv3
890 eval $canv $args
891 eval $canv2 $args
892 eval $canv3 $args
895 proc bindall {event action} {
896 global canv canv2 canv3
897 bind $canv $event $action
898 bind $canv2 $event $action
899 bind $canv3 $event $action
902 proc about {} {
903 set w .about
904 if {[winfo exists $w]} {
905 raise $w
906 return
908 toplevel $w
909 wm title $w "About gitk"
910 message $w.m -text {
911 Gitk - a commit viewer for git
913 Copyright © 2005-2006 Paul Mackerras
915 Use and redistribute under the terms of the GNU General Public License} \
916 -justify center -aspect 400
917 pack $w.m -side top -fill x -padx 20 -pady 20
918 button $w.ok -text Close -command "destroy $w"
919 pack $w.ok -side bottom
922 proc keys {} {
923 set w .keys
924 if {[winfo exists $w]} {
925 raise $w
926 return
928 toplevel $w
929 wm title $w "Gitk key bindings"
930 message $w.m -text {
931 Gitk key bindings:
933 <Ctrl-Q> Quit
934 <Home> Move to first commit
935 <End> Move to last commit
936 <Up>, p, i Move up one commit
937 <Down>, n, k Move down one commit
938 <Left>, z, j Go back in history list
939 <Right>, x, l Go forward in history list
940 <PageUp> Move up one page in commit list
941 <PageDown> Move down one page in commit list
942 <Ctrl-Home> Scroll to top of commit list
943 <Ctrl-End> Scroll to bottom of commit list
944 <Ctrl-Up> Scroll commit list up one line
945 <Ctrl-Down> Scroll commit list down one line
946 <Ctrl-PageUp> Scroll commit list up one page
947 <Ctrl-PageDown> Scroll commit list down one page
948 <Shift-Up> Move to previous highlighted line
949 <Shift-Down> Move to next highlighted line
950 <Delete>, b Scroll diff view up one page
951 <Backspace> Scroll diff view up one page
952 <Space> Scroll diff view down one page
953 u Scroll diff view up 18 lines
954 d Scroll diff view down 18 lines
955 <Ctrl-F> Find
956 <Ctrl-G> Move to next find hit
957 <Return> Move to next find hit
958 / Move to next find hit, or redo find
959 ? Move to previous find hit
960 f Scroll diff view to next file
961 <Ctrl-S> Search for next hit in diff view
962 <Ctrl-R> Search for previous hit in diff view
963 <Ctrl-KP+> Increase font size
964 <Ctrl-plus> Increase font size
965 <Ctrl-KP-> Decrease font size
966 <Ctrl-minus> Decrease font size
968 -justify left -bg white -border 2 -relief sunken
969 pack $w.m -side top -fill both
970 button $w.ok -text Close -command "destroy $w"
971 pack $w.ok -side bottom
974 # Procedures for manipulating the file list window at the
975 # bottom right of the overall window.
977 proc treeview {w l openlevs} {
978 global treecontents treediropen treeheight treeparent treeindex
980 set ix 0
981 set treeindex() 0
982 set lev 0
983 set prefix {}
984 set prefixend -1
985 set prefendstack {}
986 set htstack {}
987 set ht 0
988 set treecontents() {}
989 $w conf -state normal
990 foreach f $l {
991 while {[string range $f 0 $prefixend] ne $prefix} {
992 if {$lev <= $openlevs} {
993 $w mark set e:$treeindex($prefix) "end -1c"
994 $w mark gravity e:$treeindex($prefix) left
996 set treeheight($prefix) $ht
997 incr ht [lindex $htstack end]
998 set htstack [lreplace $htstack end end]
999 set prefixend [lindex $prefendstack end]
1000 set prefendstack [lreplace $prefendstack end end]
1001 set prefix [string range $prefix 0 $prefixend]
1002 incr lev -1
1004 set tail [string range $f [expr {$prefixend+1}] end]
1005 while {[set slash [string first "/" $tail]] >= 0} {
1006 lappend htstack $ht
1007 set ht 0
1008 lappend prefendstack $prefixend
1009 incr prefixend [expr {$slash + 1}]
1010 set d [string range $tail 0 $slash]
1011 lappend treecontents($prefix) $d
1012 set oldprefix $prefix
1013 append prefix $d
1014 set treecontents($prefix) {}
1015 set treeindex($prefix) [incr ix]
1016 set treeparent($prefix) $oldprefix
1017 set tail [string range $tail [expr {$slash+1}] end]
1018 if {$lev <= $openlevs} {
1019 set ht 1
1020 set treediropen($prefix) [expr {$lev < $openlevs}]
1021 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1022 $w mark set d:$ix "end -1c"
1023 $w mark gravity d:$ix left
1024 set str "\n"
1025 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1026 $w insert end $str
1027 $w image create end -align center -image $bm -padx 1 \
1028 -name a:$ix
1029 $w insert end $d [highlight_tag $prefix]
1030 $w mark set s:$ix "end -1c"
1031 $w mark gravity s:$ix left
1033 incr lev
1035 if {$tail ne {}} {
1036 if {$lev <= $openlevs} {
1037 incr ht
1038 set str "\n"
1039 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1040 $w insert end $str
1041 $w insert end $tail [highlight_tag $f]
1043 lappend treecontents($prefix) $tail
1046 while {$htstack ne {}} {
1047 set treeheight($prefix) $ht
1048 incr ht [lindex $htstack end]
1049 set htstack [lreplace $htstack end end]
1051 $w conf -state disabled
1054 proc linetoelt {l} {
1055 global treeheight treecontents
1057 set y 2
1058 set prefix {}
1059 while {1} {
1060 foreach e $treecontents($prefix) {
1061 if {$y == $l} {
1062 return "$prefix$e"
1064 set n 1
1065 if {[string index $e end] eq "/"} {
1066 set n $treeheight($prefix$e)
1067 if {$y + $n > $l} {
1068 append prefix $e
1069 incr y
1070 break
1073 incr y $n
1078 proc highlight_tree {y prefix} {
1079 global treeheight treecontents cflist
1081 foreach e $treecontents($prefix) {
1082 set path $prefix$e
1083 if {[highlight_tag $path] ne {}} {
1084 $cflist tag add bold $y.0 "$y.0 lineend"
1086 incr y
1087 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1088 set y [highlight_tree $y $path]
1091 return $y
1094 proc treeclosedir {w dir} {
1095 global treediropen treeheight treeparent treeindex
1097 set ix $treeindex($dir)
1098 $w conf -state normal
1099 $w delete s:$ix e:$ix
1100 set treediropen($dir) 0
1101 $w image configure a:$ix -image tri-rt
1102 $w conf -state disabled
1103 set n [expr {1 - $treeheight($dir)}]
1104 while {$dir ne {}} {
1105 incr treeheight($dir) $n
1106 set dir $treeparent($dir)
1110 proc treeopendir {w dir} {
1111 global treediropen treeheight treeparent treecontents treeindex
1113 set ix $treeindex($dir)
1114 $w conf -state normal
1115 $w image configure a:$ix -image tri-dn
1116 $w mark set e:$ix s:$ix
1117 $w mark gravity e:$ix right
1118 set lev 0
1119 set str "\n"
1120 set n [llength $treecontents($dir)]
1121 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1122 incr lev
1123 append str "\t"
1124 incr treeheight($x) $n
1126 foreach e $treecontents($dir) {
1127 set de $dir$e
1128 if {[string index $e end] eq "/"} {
1129 set iy $treeindex($de)
1130 $w mark set d:$iy e:$ix
1131 $w mark gravity d:$iy left
1132 $w insert e:$ix $str
1133 set treediropen($de) 0
1134 $w image create e:$ix -align center -image tri-rt -padx 1 \
1135 -name a:$iy
1136 $w insert e:$ix $e [highlight_tag $de]
1137 $w mark set s:$iy e:$ix
1138 $w mark gravity s:$iy left
1139 set treeheight($de) 1
1140 } else {
1141 $w insert e:$ix $str
1142 $w insert e:$ix $e [highlight_tag $de]
1145 $w mark gravity e:$ix left
1146 $w conf -state disabled
1147 set treediropen($dir) 1
1148 set top [lindex [split [$w index @0,0] .] 0]
1149 set ht [$w cget -height]
1150 set l [lindex [split [$w index s:$ix] .] 0]
1151 if {$l < $top} {
1152 $w yview $l.0
1153 } elseif {$l + $n + 1 > $top + $ht} {
1154 set top [expr {$l + $n + 2 - $ht}]
1155 if {$l < $top} {
1156 set top $l
1158 $w yview $top.0
1162 proc treeclick {w x y} {
1163 global treediropen cmitmode ctext cflist cflist_top
1165 if {$cmitmode ne "tree"} return
1166 if {![info exists cflist_top]} return
1167 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1168 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1169 $cflist tag add highlight $l.0 "$l.0 lineend"
1170 set cflist_top $l
1171 if {$l == 1} {
1172 $ctext yview 1.0
1173 return
1175 set e [linetoelt $l]
1176 if {[string index $e end] ne "/"} {
1177 showfile $e
1178 } elseif {$treediropen($e)} {
1179 treeclosedir $w $e
1180 } else {
1181 treeopendir $w $e
1185 proc setfilelist {id} {
1186 global treefilelist cflist
1188 treeview $cflist $treefilelist($id) 0
1191 image create bitmap tri-rt -background black -foreground blue -data {
1192 #define tri-rt_width 13
1193 #define tri-rt_height 13
1194 static unsigned char tri-rt_bits[] = {
1195 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1196 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1197 0x00, 0x00};
1198 } -maskdata {
1199 #define tri-rt-mask_width 13
1200 #define tri-rt-mask_height 13
1201 static unsigned char tri-rt-mask_bits[] = {
1202 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1203 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1204 0x08, 0x00};
1206 image create bitmap tri-dn -background black -foreground blue -data {
1207 #define tri-dn_width 13
1208 #define tri-dn_height 13
1209 static unsigned char tri-dn_bits[] = {
1210 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1211 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1212 0x00, 0x00};
1213 } -maskdata {
1214 #define tri-dn-mask_width 13
1215 #define tri-dn-mask_height 13
1216 static unsigned char tri-dn-mask_bits[] = {
1217 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1218 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1219 0x00, 0x00};
1222 proc init_flist {first} {
1223 global cflist cflist_top selectedline difffilestart
1225 $cflist conf -state normal
1226 $cflist delete 0.0 end
1227 if {$first ne {}} {
1228 $cflist insert end $first
1229 set cflist_top 1
1230 $cflist tag add highlight 1.0 "1.0 lineend"
1231 } else {
1232 catch {unset cflist_top}
1234 $cflist conf -state disabled
1235 set difffilestart {}
1238 proc highlight_tag {f} {
1239 global highlight_paths
1241 foreach p $highlight_paths {
1242 if {[string match $p $f]} {
1243 return "bold"
1246 return {}
1249 proc highlight_filelist {} {
1250 global cmitmode cflist
1252 $cflist conf -state normal
1253 if {$cmitmode ne "tree"} {
1254 set end [lindex [split [$cflist index end] .] 0]
1255 for {set l 2} {$l < $end} {incr l} {
1256 set line [$cflist get $l.0 "$l.0 lineend"]
1257 if {[highlight_tag $line] ne {}} {
1258 $cflist tag add bold $l.0 "$l.0 lineend"
1261 } else {
1262 highlight_tree 2 {}
1264 $cflist conf -state disabled
1267 proc unhighlight_filelist {} {
1268 global cflist
1270 $cflist conf -state normal
1271 $cflist tag remove bold 1.0 end
1272 $cflist conf -state disabled
1275 proc add_flist {fl} {
1276 global cflist
1278 $cflist conf -state normal
1279 foreach f $fl {
1280 $cflist insert end "\n"
1281 $cflist insert end $f [highlight_tag $f]
1283 $cflist conf -state disabled
1286 proc sel_flist {w x y} {
1287 global ctext difffilestart cflist cflist_top cmitmode
1289 if {$cmitmode eq "tree"} return
1290 if {![info exists cflist_top]} return
1291 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1292 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1293 $cflist tag add highlight $l.0 "$l.0 lineend"
1294 set cflist_top $l
1295 if {$l == 1} {
1296 $ctext yview 1.0
1297 } else {
1298 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1302 # Functions for adding and removing shell-type quoting
1304 proc shellquote {str} {
1305 if {![string match "*\['\"\\ \t]*" $str]} {
1306 return $str
1308 if {![string match "*\['\"\\]*" $str]} {
1309 return "\"$str\""
1311 if {![string match "*'*" $str]} {
1312 return "'$str'"
1314 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1317 proc shellarglist {l} {
1318 set str {}
1319 foreach a $l {
1320 if {$str ne {}} {
1321 append str " "
1323 append str [shellquote $a]
1325 return $str
1328 proc shelldequote {str} {
1329 set ret {}
1330 set used -1
1331 while {1} {
1332 incr used
1333 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1334 append ret [string range $str $used end]
1335 set used [string length $str]
1336 break
1338 set first [lindex $first 0]
1339 set ch [string index $str $first]
1340 if {$first > $used} {
1341 append ret [string range $str $used [expr {$first - 1}]]
1342 set used $first
1344 if {$ch eq " " || $ch eq "\t"} break
1345 incr used
1346 if {$ch eq "'"} {
1347 set first [string first "'" $str $used]
1348 if {$first < 0} {
1349 error "unmatched single-quote"
1351 append ret [string range $str $used [expr {$first - 1}]]
1352 set used $first
1353 continue
1355 if {$ch eq "\\"} {
1356 if {$used >= [string length $str]} {
1357 error "trailing backslash"
1359 append ret [string index $str $used]
1360 continue
1362 # here ch == "\""
1363 while {1} {
1364 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1365 error "unmatched double-quote"
1367 set first [lindex $first 0]
1368 set ch [string index $str $first]
1369 if {$first > $used} {
1370 append ret [string range $str $used [expr {$first - 1}]]
1371 set used $first
1373 if {$ch eq "\""} break
1374 incr used
1375 append ret [string index $str $used]
1376 incr used
1379 return [list $used $ret]
1382 proc shellsplit {str} {
1383 set l {}
1384 while {1} {
1385 set str [string trimleft $str]
1386 if {$str eq {}} break
1387 set dq [shelldequote $str]
1388 set n [lindex $dq 0]
1389 set word [lindex $dq 1]
1390 set str [string range $str $n end]
1391 lappend l $word
1393 return $l
1396 # Code to implement multiple views
1398 proc newview {ishighlight} {
1399 global nextviewnum newviewname newviewperm uifont newishighlight
1400 global newviewargs revtreeargs
1402 set newishighlight $ishighlight
1403 set top .gitkview
1404 if {[winfo exists $top]} {
1405 raise $top
1406 return
1408 set newviewname($nextviewnum) "View $nextviewnum"
1409 set newviewperm($nextviewnum) 0
1410 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1411 vieweditor $top $nextviewnum "Gitk view definition"
1414 proc editview {} {
1415 global curview
1416 global viewname viewperm newviewname newviewperm
1417 global viewargs newviewargs
1419 set top .gitkvedit-$curview
1420 if {[winfo exists $top]} {
1421 raise $top
1422 return
1424 set newviewname($curview) $viewname($curview)
1425 set newviewperm($curview) $viewperm($curview)
1426 set newviewargs($curview) [shellarglist $viewargs($curview)]
1427 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1430 proc vieweditor {top n title} {
1431 global newviewname newviewperm viewfiles
1432 global uifont
1434 toplevel $top
1435 wm title $top $title
1436 label $top.nl -text "Name" -font $uifont
1437 entry $top.name -width 20 -textvariable newviewname($n)
1438 grid $top.nl $top.name -sticky w -pady 5
1439 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1440 grid $top.perm - -pady 5 -sticky w
1441 message $top.al -aspect 1000 -font $uifont \
1442 -text "Commits to include (arguments to git rev-list):"
1443 grid $top.al - -sticky w -pady 5
1444 entry $top.args -width 50 -textvariable newviewargs($n) \
1445 -background white
1446 grid $top.args - -sticky ew -padx 5
1447 message $top.l -aspect 1000 -font $uifont \
1448 -text "Enter files and directories to include, one per line:"
1449 grid $top.l - -sticky w
1450 text $top.t -width 40 -height 10 -background white
1451 if {[info exists viewfiles($n)]} {
1452 foreach f $viewfiles($n) {
1453 $top.t insert end $f
1454 $top.t insert end "\n"
1456 $top.t delete {end - 1c} end
1457 $top.t mark set insert 0.0
1459 grid $top.t - -sticky ew -padx 5
1460 frame $top.buts
1461 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1462 button $top.buts.can -text "Cancel" -command [list destroy $top]
1463 grid $top.buts.ok $top.buts.can
1464 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1465 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1466 grid $top.buts - -pady 10 -sticky ew
1467 focus $top.t
1470 proc doviewmenu {m first cmd op argv} {
1471 set nmenu [$m index end]
1472 for {set i $first} {$i <= $nmenu} {incr i} {
1473 if {[$m entrycget $i -command] eq $cmd} {
1474 eval $m $op $i $argv
1475 break
1480 proc allviewmenus {n op args} {
1481 global viewhlmenu
1483 doviewmenu .bar.view 7 [list showview $n] $op $args
1484 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1487 proc newviewok {top n} {
1488 global nextviewnum newviewperm newviewname newishighlight
1489 global viewname viewfiles viewperm selectedview curview
1490 global viewargs newviewargs viewhlmenu
1492 if {[catch {
1493 set newargs [shellsplit $newviewargs($n)]
1494 } err]} {
1495 error_popup "Error in commit selection arguments: $err"
1496 wm raise $top
1497 focus $top
1498 return
1500 set files {}
1501 foreach f [split [$top.t get 0.0 end] "\n"] {
1502 set ft [string trim $f]
1503 if {$ft ne {}} {
1504 lappend files $ft
1507 if {![info exists viewfiles($n)]} {
1508 # creating a new view
1509 incr nextviewnum
1510 set viewname($n) $newviewname($n)
1511 set viewperm($n) $newviewperm($n)
1512 set viewfiles($n) $files
1513 set viewargs($n) $newargs
1514 addviewmenu $n
1515 if {!$newishighlight} {
1516 after idle showview $n
1517 } else {
1518 after idle addvhighlight $n
1520 } else {
1521 # editing an existing view
1522 set viewperm($n) $newviewperm($n)
1523 if {$newviewname($n) ne $viewname($n)} {
1524 set viewname($n) $newviewname($n)
1525 doviewmenu .bar.view 7 [list showview $n] \
1526 entryconf [list -label $viewname($n)]
1527 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1528 entryconf [list -label $viewname($n) -value $viewname($n)]
1530 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1531 set viewfiles($n) $files
1532 set viewargs($n) $newargs
1533 if {$curview == $n} {
1534 after idle updatecommits
1538 catch {destroy $top}
1541 proc delview {} {
1542 global curview viewdata viewperm hlview selectedhlview
1544 if {$curview == 0} return
1545 if {[info exists hlview] && $hlview == $curview} {
1546 set selectedhlview None
1547 unset hlview
1549 allviewmenus $curview delete
1550 set viewdata($curview) {}
1551 set viewperm($curview) 0
1552 showview 0
1555 proc addviewmenu {n} {
1556 global viewname viewhlmenu
1558 .bar.view add radiobutton -label $viewname($n) \
1559 -command [list showview $n] -variable selectedview -value $n
1560 $viewhlmenu add radiobutton -label $viewname($n) \
1561 -command [list addvhighlight $n] -variable selectedhlview
1564 proc flatten {var} {
1565 global $var
1567 set ret {}
1568 foreach i [array names $var] {
1569 lappend ret $i [set $var\($i\)]
1571 return $ret
1574 proc unflatten {var l} {
1575 global $var
1577 catch {unset $var}
1578 foreach {i v} $l {
1579 set $var\($i\) $v
1583 proc showview {n} {
1584 global curview viewdata viewfiles
1585 global displayorder parentlist childlist rowidlist rowoffsets
1586 global colormap rowtextx commitrow nextcolor canvxmax
1587 global numcommits rowrangelist commitlisted idrowranges
1588 global selectedline currentid canv canvy0
1589 global matchinglines treediffs
1590 global pending_select phase
1591 global commitidx rowlaidout rowoptim linesegends
1592 global commfd nextupdate
1593 global selectedview
1594 global vparentlist vchildlist vdisporder vcmitlisted
1595 global hlview selectedhlview
1597 if {$n == $curview} return
1598 set selid {}
1599 if {[info exists selectedline]} {
1600 set selid $currentid
1601 set y [yc $selectedline]
1602 set ymax [lindex [$canv cget -scrollregion] 3]
1603 set span [$canv yview]
1604 set ytop [expr {[lindex $span 0] * $ymax}]
1605 set ybot [expr {[lindex $span 1] * $ymax}]
1606 if {$ytop < $y && $y < $ybot} {
1607 set yscreen [expr {$y - $ytop}]
1608 } else {
1609 set yscreen [expr {($ybot - $ytop) / 2}]
1612 unselectline
1613 normalline
1614 stopfindproc
1615 if {$curview >= 0} {
1616 set vparentlist($curview) $parentlist
1617 set vchildlist($curview) $childlist
1618 set vdisporder($curview) $displayorder
1619 set vcmitlisted($curview) $commitlisted
1620 if {$phase ne {}} {
1621 set viewdata($curview) \
1622 [list $phase $rowidlist $rowoffsets $rowrangelist \
1623 [flatten idrowranges] [flatten idinlist] \
1624 $rowlaidout $rowoptim $numcommits $linesegends]
1625 } elseif {![info exists viewdata($curview)]
1626 || [lindex $viewdata($curview) 0] ne {}} {
1627 set viewdata($curview) \
1628 [list {} $rowidlist $rowoffsets $rowrangelist]
1631 catch {unset matchinglines}
1632 catch {unset treediffs}
1633 clear_display
1634 if {[info exists hlview] && $hlview == $n} {
1635 unset hlview
1636 set selectedhlview None
1639 set curview $n
1640 set selectedview $n
1641 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1642 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1644 if {![info exists viewdata($n)]} {
1645 set pending_select $selid
1646 getcommits
1647 return
1650 set v $viewdata($n)
1651 set phase [lindex $v 0]
1652 set displayorder $vdisporder($n)
1653 set parentlist $vparentlist($n)
1654 set childlist $vchildlist($n)
1655 set commitlisted $vcmitlisted($n)
1656 set rowidlist [lindex $v 1]
1657 set rowoffsets [lindex $v 2]
1658 set rowrangelist [lindex $v 3]
1659 if {$phase eq {}} {
1660 set numcommits [llength $displayorder]
1661 catch {unset idrowranges}
1662 } else {
1663 unflatten idrowranges [lindex $v 4]
1664 unflatten idinlist [lindex $v 5]
1665 set rowlaidout [lindex $v 6]
1666 set rowoptim [lindex $v 7]
1667 set numcommits [lindex $v 8]
1668 set linesegends [lindex $v 9]
1671 catch {unset colormap}
1672 catch {unset rowtextx}
1673 set nextcolor 0
1674 set canvxmax [$canv cget -width]
1675 set curview $n
1676 set row 0
1677 setcanvscroll
1678 set yf 0
1679 set row 0
1680 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1681 set row $commitrow($n,$selid)
1682 # try to get the selected row in the same position on the screen
1683 set ymax [lindex [$canv cget -scrollregion] 3]
1684 set ytop [expr {[yc $row] - $yscreen}]
1685 if {$ytop < 0} {
1686 set ytop 0
1688 set yf [expr {$ytop * 1.0 / $ymax}]
1690 allcanvs yview moveto $yf
1691 drawvisible
1692 selectline $row 0
1693 if {$phase ne {}} {
1694 if {$phase eq "getcommits"} {
1695 show_status "Reading commits..."
1697 if {[info exists commfd($n)]} {
1698 layoutmore
1699 } else {
1700 finishcommits
1702 } elseif {$numcommits == 0} {
1703 show_status "No commits selected"
1707 # Stuff relating to the highlighting facility
1709 proc ishighlighted {row} {
1710 global vhighlights fhighlights nhighlights rhighlights
1712 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1713 return $nhighlights($row)
1715 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1716 return $vhighlights($row)
1718 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1719 return $fhighlights($row)
1721 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1722 return $rhighlights($row)
1724 return 0
1727 proc bolden {row font} {
1728 global canv linehtag selectedline boldrows
1730 lappend boldrows $row
1731 $canv itemconf $linehtag($row) -font $font
1732 if {[info exists selectedline] && $row == $selectedline} {
1733 $canv delete secsel
1734 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1735 -outline {{}} -tags secsel \
1736 -fill [$canv cget -selectbackground]]
1737 $canv lower $t
1741 proc bolden_name {row font} {
1742 global canv2 linentag selectedline boldnamerows
1744 lappend boldnamerows $row
1745 $canv2 itemconf $linentag($row) -font $font
1746 if {[info exists selectedline] && $row == $selectedline} {
1747 $canv2 delete secsel
1748 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1749 -outline {{}} -tags secsel \
1750 -fill [$canv2 cget -selectbackground]]
1751 $canv2 lower $t
1755 proc unbolden {} {
1756 global mainfont boldrows
1758 set stillbold {}
1759 foreach row $boldrows {
1760 if {![ishighlighted $row]} {
1761 bolden $row $mainfont
1762 } else {
1763 lappend stillbold $row
1766 set boldrows $stillbold
1769 proc addvhighlight {n} {
1770 global hlview curview viewdata vhl_done vhighlights commitidx
1772 if {[info exists hlview]} {
1773 delvhighlight
1775 set hlview $n
1776 if {$n != $curview && ![info exists viewdata($n)]} {
1777 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1778 set vparentlist($n) {}
1779 set vchildlist($n) {}
1780 set vdisporder($n) {}
1781 set vcmitlisted($n) {}
1782 start_rev_list $n
1784 set vhl_done $commitidx($hlview)
1785 if {$vhl_done > 0} {
1786 drawvisible
1790 proc delvhighlight {} {
1791 global hlview vhighlights
1793 if {![info exists hlview]} return
1794 unset hlview
1795 catch {unset vhighlights}
1796 unbolden
1799 proc vhighlightmore {} {
1800 global hlview vhl_done commitidx vhighlights
1801 global displayorder vdisporder curview mainfont
1803 set font [concat $mainfont bold]
1804 set max $commitidx($hlview)
1805 if {$hlview == $curview} {
1806 set disp $displayorder
1807 } else {
1808 set disp $vdisporder($hlview)
1810 set vr [visiblerows]
1811 set r0 [lindex $vr 0]
1812 set r1 [lindex $vr 1]
1813 for {set i $vhl_done} {$i < $max} {incr i} {
1814 set id [lindex $disp $i]
1815 if {[info exists commitrow($curview,$id)]} {
1816 set row $commitrow($curview,$id)
1817 if {$r0 <= $row && $row <= $r1} {
1818 if {![highlighted $row]} {
1819 bolden $row $font
1821 set vhighlights($row) 1
1825 set vhl_done $max
1828 proc askvhighlight {row id} {
1829 global hlview vhighlights commitrow iddrawn mainfont
1831 if {[info exists commitrow($hlview,$id)]} {
1832 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1833 bolden $row [concat $mainfont bold]
1835 set vhighlights($row) 1
1836 } else {
1837 set vhighlights($row) 0
1841 proc hfiles_change {name ix op} {
1842 global highlight_files filehighlight fhighlights fh_serial
1843 global mainfont highlight_paths
1845 if {[info exists filehighlight]} {
1846 # delete previous highlights
1847 catch {close $filehighlight}
1848 unset filehighlight
1849 catch {unset fhighlights}
1850 unbolden
1851 unhighlight_filelist
1853 set highlight_paths {}
1854 after cancel do_file_hl $fh_serial
1855 incr fh_serial
1856 if {$highlight_files ne {}} {
1857 after 300 do_file_hl $fh_serial
1861 proc makepatterns {l} {
1862 set ret {}
1863 foreach e $l {
1864 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1865 if {[string index $ee end] eq "/"} {
1866 lappend ret "$ee*"
1867 } else {
1868 lappend ret $ee
1869 lappend ret "$ee/*"
1872 return $ret
1875 proc do_file_hl {serial} {
1876 global highlight_files filehighlight highlight_paths gdttype fhl_list
1878 if {$gdttype eq "touching paths:"} {
1879 if {[catch {set paths [shellsplit $highlight_files]}]} return
1880 set highlight_paths [makepatterns $paths]
1881 highlight_filelist
1882 set gdtargs [concat -- $paths]
1883 } else {
1884 set gdtargs [list "-S$highlight_files"]
1886 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1887 set filehighlight [open $cmd r+]
1888 fconfigure $filehighlight -blocking 0
1889 fileevent $filehighlight readable readfhighlight
1890 set fhl_list {}
1891 drawvisible
1892 flushhighlights
1895 proc flushhighlights {} {
1896 global filehighlight fhl_list
1898 if {[info exists filehighlight]} {
1899 lappend fhl_list {}
1900 puts $filehighlight ""
1901 flush $filehighlight
1905 proc askfilehighlight {row id} {
1906 global filehighlight fhighlights fhl_list
1908 lappend fhl_list $id
1909 set fhighlights($row) -1
1910 puts $filehighlight $id
1913 proc readfhighlight {} {
1914 global filehighlight fhighlights commitrow curview mainfont iddrawn
1915 global fhl_list
1917 while {[gets $filehighlight line] >= 0} {
1918 set line [string trim $line]
1919 set i [lsearch -exact $fhl_list $line]
1920 if {$i < 0} continue
1921 for {set j 0} {$j < $i} {incr j} {
1922 set id [lindex $fhl_list $j]
1923 if {[info exists commitrow($curview,$id)]} {
1924 set fhighlights($commitrow($curview,$id)) 0
1927 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1928 if {$line eq {}} continue
1929 if {![info exists commitrow($curview,$line)]} continue
1930 set row $commitrow($curview,$line)
1931 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1932 bolden $row [concat $mainfont bold]
1934 set fhighlights($row) 1
1936 if {[eof $filehighlight]} {
1937 # strange...
1938 puts "oops, git-diff-tree died"
1939 catch {close $filehighlight}
1940 unset filehighlight
1942 next_hlcont
1945 proc find_change {name ix op} {
1946 global nhighlights mainfont boldnamerows
1947 global findstring findpattern findtype
1949 # delete previous highlights, if any
1950 foreach row $boldnamerows {
1951 bolden_name $row $mainfont
1953 set boldnamerows {}
1954 catch {unset nhighlights}
1955 unbolden
1956 if {$findtype ne "Regexp"} {
1957 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1958 $findstring]
1959 set findpattern "*$e*"
1961 drawvisible
1964 proc askfindhighlight {row id} {
1965 global nhighlights commitinfo iddrawn mainfont
1966 global findstring findtype findloc findpattern
1968 if {![info exists commitinfo($id)]} {
1969 getcommit $id
1971 set info $commitinfo($id)
1972 set isbold 0
1973 set fldtypes {Headline Author Date Committer CDate Comments}
1974 foreach f $info ty $fldtypes {
1975 if {$findloc ne "All fields" && $findloc ne $ty} {
1976 continue
1978 if {$findtype eq "Regexp"} {
1979 set doesmatch [regexp $findstring $f]
1980 } elseif {$findtype eq "IgnCase"} {
1981 set doesmatch [string match -nocase $findpattern $f]
1982 } else {
1983 set doesmatch [string match $findpattern $f]
1985 if {$doesmatch} {
1986 if {$ty eq "Author"} {
1987 set isbold 2
1988 } else {
1989 set isbold 1
1993 if {[info exists iddrawn($id)]} {
1994 if {$isbold && ![ishighlighted $row]} {
1995 bolden $row [concat $mainfont bold]
1997 if {$isbold >= 2} {
1998 bolden_name $row [concat $mainfont bold]
2001 set nhighlights($row) $isbold
2004 proc vrel_change {name ix op} {
2005 global highlight_related
2007 rhighlight_none
2008 if {$highlight_related ne "None"} {
2009 after idle drawvisible
2013 # prepare for testing whether commits are descendents or ancestors of a
2014 proc rhighlight_sel {a} {
2015 global descendent desc_todo ancestor anc_todo
2016 global highlight_related rhighlights
2018 catch {unset descendent}
2019 set desc_todo [list $a]
2020 catch {unset ancestor}
2021 set anc_todo [list $a]
2022 if {$highlight_related ne "None"} {
2023 rhighlight_none
2024 after idle drawvisible
2028 proc rhighlight_none {} {
2029 global rhighlights
2031 catch {unset rhighlights}
2032 unbolden
2035 proc is_descendent {a} {
2036 global curview children commitrow descendent desc_todo
2038 set v $curview
2039 set la $commitrow($v,$a)
2040 set todo $desc_todo
2041 set leftover {}
2042 set done 0
2043 for {set i 0} {$i < [llength $todo]} {incr i} {
2044 set do [lindex $todo $i]
2045 if {$commitrow($v,$do) < $la} {
2046 lappend leftover $do
2047 continue
2049 foreach nk $children($v,$do) {
2050 if {![info exists descendent($nk)]} {
2051 set descendent($nk) 1
2052 lappend todo $nk
2053 if {$nk eq $a} {
2054 set done 1
2058 if {$done} {
2059 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2060 return
2063 set descendent($a) 0
2064 set desc_todo $leftover
2067 proc is_ancestor {a} {
2068 global curview parentlist commitrow ancestor anc_todo
2070 set v $curview
2071 set la $commitrow($v,$a)
2072 set todo $anc_todo
2073 set leftover {}
2074 set done 0
2075 for {set i 0} {$i < [llength $todo]} {incr i} {
2076 set do [lindex $todo $i]
2077 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2078 lappend leftover $do
2079 continue
2081 foreach np [lindex $parentlist $commitrow($v,$do)] {
2082 if {![info exists ancestor($np)]} {
2083 set ancestor($np) 1
2084 lappend todo $np
2085 if {$np eq $a} {
2086 set done 1
2090 if {$done} {
2091 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2092 return
2095 set ancestor($a) 0
2096 set anc_todo $leftover
2099 proc askrelhighlight {row id} {
2100 global descendent highlight_related iddrawn mainfont rhighlights
2101 global selectedline ancestor
2103 if {![info exists selectedline]} return
2104 set isbold 0
2105 if {$highlight_related eq "Descendent" ||
2106 $highlight_related eq "Not descendent"} {
2107 if {![info exists descendent($id)]} {
2108 is_descendent $id
2110 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2111 set isbold 1
2113 } elseif {$highlight_related eq "Ancestor" ||
2114 $highlight_related eq "Not ancestor"} {
2115 if {![info exists ancestor($id)]} {
2116 is_ancestor $id
2118 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2119 set isbold 1
2122 if {[info exists iddrawn($id)]} {
2123 if {$isbold && ![ishighlighted $row]} {
2124 bolden $row [concat $mainfont bold]
2127 set rhighlights($row) $isbold
2130 proc next_hlcont {} {
2131 global fhl_row fhl_dirn displayorder numcommits
2132 global vhighlights fhighlights nhighlights rhighlights
2133 global hlview filehighlight findstring highlight_related
2135 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2136 set row $fhl_row
2137 while {1} {
2138 if {$row < 0 || $row >= $numcommits} {
2139 bell
2140 set fhl_dirn 0
2141 return
2143 set id [lindex $displayorder $row]
2144 if {[info exists hlview]} {
2145 if {![info exists vhighlights($row)]} {
2146 askvhighlight $row $id
2148 if {$vhighlights($row) > 0} break
2150 if {$findstring ne {}} {
2151 if {![info exists nhighlights($row)]} {
2152 askfindhighlight $row $id
2154 if {$nhighlights($row) > 0} break
2156 if {$highlight_related ne "None"} {
2157 if {![info exists rhighlights($row)]} {
2158 askrelhighlight $row $id
2160 if {$rhighlights($row) > 0} break
2162 if {[info exists filehighlight]} {
2163 if {![info exists fhighlights($row)]} {
2164 # ask for a few more while we're at it...
2165 set r $row
2166 for {set n 0} {$n < 100} {incr n} {
2167 if {![info exists fhighlights($r)]} {
2168 askfilehighlight $r [lindex $displayorder $r]
2170 incr r $fhl_dirn
2171 if {$r < 0 || $r >= $numcommits} break
2173 flushhighlights
2175 if {$fhighlights($row) < 0} {
2176 set fhl_row $row
2177 return
2179 if {$fhighlights($row) > 0} break
2181 incr row $fhl_dirn
2183 set fhl_dirn 0
2184 selectline $row 1
2187 proc next_highlight {dirn} {
2188 global selectedline fhl_row fhl_dirn
2189 global hlview filehighlight findstring highlight_related
2191 if {![info exists selectedline]} return
2192 if {!([info exists hlview] || $findstring ne {} ||
2193 $highlight_related ne "None" || [info exists filehighlight])} return
2194 set fhl_row [expr {$selectedline + $dirn}]
2195 set fhl_dirn $dirn
2196 next_hlcont
2199 proc cancel_next_highlight {} {
2200 global fhl_dirn
2202 set fhl_dirn 0
2205 # Graph layout functions
2207 proc shortids {ids} {
2208 set res {}
2209 foreach id $ids {
2210 if {[llength $id] > 1} {
2211 lappend res [shortids $id]
2212 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2213 lappend res [string range $id 0 7]
2214 } else {
2215 lappend res $id
2218 return $res
2221 proc incrange {l x o} {
2222 set n [llength $l]
2223 while {$x < $n} {
2224 set e [lindex $l $x]
2225 if {$e ne {}} {
2226 lset l $x [expr {$e + $o}]
2228 incr x
2230 return $l
2233 proc ntimes {n o} {
2234 set ret {}
2235 for {} {$n > 0} {incr n -1} {
2236 lappend ret $o
2238 return $ret
2241 proc usedinrange {id l1 l2} {
2242 global children commitrow childlist curview
2244 if {[info exists commitrow($curview,$id)]} {
2245 set r $commitrow($curview,$id)
2246 if {$l1 <= $r && $r <= $l2} {
2247 return [expr {$r - $l1 + 1}]
2249 set kids [lindex $childlist $r]
2250 } else {
2251 set kids $children($curview,$id)
2253 foreach c $kids {
2254 set r $commitrow($curview,$c)
2255 if {$l1 <= $r && $r <= $l2} {
2256 return [expr {$r - $l1 + 1}]
2259 return 0
2262 proc sanity {row {full 0}} {
2263 global rowidlist rowoffsets
2265 set col -1
2266 set ids [lindex $rowidlist $row]
2267 foreach id $ids {
2268 incr col
2269 if {$id eq {}} continue
2270 if {$col < [llength $ids] - 1 &&
2271 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2272 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2274 set o [lindex $rowoffsets $row $col]
2275 set y $row
2276 set x $col
2277 while {$o ne {}} {
2278 incr y -1
2279 incr x $o
2280 if {[lindex $rowidlist $y $x] != $id} {
2281 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2282 puts " id=[shortids $id] check started at row $row"
2283 for {set i $row} {$i >= $y} {incr i -1} {
2284 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2286 break
2288 if {!$full} break
2289 set o [lindex $rowoffsets $y $x]
2294 proc makeuparrow {oid x y z} {
2295 global rowidlist rowoffsets uparrowlen idrowranges
2297 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2298 incr y -1
2299 incr x $z
2300 set off0 [lindex $rowoffsets $y]
2301 for {set x0 $x} {1} {incr x0} {
2302 if {$x0 >= [llength $off0]} {
2303 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2304 break
2306 set z [lindex $off0 $x0]
2307 if {$z ne {}} {
2308 incr x0 $z
2309 break
2312 set z [expr {$x0 - $x}]
2313 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2314 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2316 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2317 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2318 lappend idrowranges($oid) $y
2321 proc initlayout {} {
2322 global rowidlist rowoffsets displayorder commitlisted
2323 global rowlaidout rowoptim
2324 global idinlist rowchk rowrangelist idrowranges
2325 global numcommits canvxmax canv
2326 global nextcolor
2327 global parentlist childlist children
2328 global colormap rowtextx
2329 global linesegends
2331 set numcommits 0
2332 set displayorder {}
2333 set commitlisted {}
2334 set parentlist {}
2335 set childlist {}
2336 set rowrangelist {}
2337 set nextcolor 0
2338 set rowidlist {{}}
2339 set rowoffsets {{}}
2340 catch {unset idinlist}
2341 catch {unset rowchk}
2342 set rowlaidout 0
2343 set rowoptim 0
2344 set canvxmax [$canv cget -width]
2345 catch {unset colormap}
2346 catch {unset rowtextx}
2347 catch {unset idrowranges}
2348 set linesegends {}
2351 proc setcanvscroll {} {
2352 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2354 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2355 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2356 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2357 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2360 proc visiblerows {} {
2361 global canv numcommits linespc
2363 set ymax [lindex [$canv cget -scrollregion] 3]
2364 if {$ymax eq {} || $ymax == 0} return
2365 set f [$canv yview]
2366 set y0 [expr {int([lindex $f 0] * $ymax)}]
2367 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2368 if {$r0 < 0} {
2369 set r0 0
2371 set y1 [expr {int([lindex $f 1] * $ymax)}]
2372 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2373 if {$r1 >= $numcommits} {
2374 set r1 [expr {$numcommits - 1}]
2376 return [list $r0 $r1]
2379 proc layoutmore {} {
2380 global rowlaidout rowoptim commitidx numcommits optim_delay
2381 global uparrowlen curview
2383 set row $rowlaidout
2384 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2385 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2386 if {$orow > $rowoptim} {
2387 optimize_rows $rowoptim 0 $orow
2388 set rowoptim $orow
2390 set canshow [expr {$rowoptim - $optim_delay}]
2391 if {$canshow > $numcommits} {
2392 showstuff $canshow
2396 proc showstuff {canshow} {
2397 global numcommits commitrow pending_select selectedline
2398 global linesegends idrowranges idrangedrawn curview
2400 if {$numcommits == 0} {
2401 global phase
2402 set phase "incrdraw"
2403 allcanvs delete all
2405 set row $numcommits
2406 set numcommits $canshow
2407 setcanvscroll
2408 set rows [visiblerows]
2409 set r0 [lindex $rows 0]
2410 set r1 [lindex $rows 1]
2411 set selrow -1
2412 for {set r $row} {$r < $canshow} {incr r} {
2413 foreach id [lindex $linesegends [expr {$r+1}]] {
2414 set i -1
2415 foreach {s e} [rowranges $id] {
2416 incr i
2417 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2418 && ![info exists idrangedrawn($id,$i)]} {
2419 drawlineseg $id $i
2420 set idrangedrawn($id,$i) 1
2425 if {$canshow > $r1} {
2426 set canshow $r1
2428 while {$row < $canshow} {
2429 drawcmitrow $row
2430 incr row
2432 if {[info exists pending_select] &&
2433 [info exists commitrow($curview,$pending_select)] &&
2434 $commitrow($curview,$pending_select) < $numcommits} {
2435 selectline $commitrow($curview,$pending_select) 1
2437 if {![info exists selectedline] && ![info exists pending_select]} {
2438 selectline 0 1
2442 proc layoutrows {row endrow last} {
2443 global rowidlist rowoffsets displayorder
2444 global uparrowlen downarrowlen maxwidth mingaplen
2445 global childlist parentlist
2446 global idrowranges linesegends
2447 global commitidx curview
2448 global idinlist rowchk rowrangelist
2450 set idlist [lindex $rowidlist $row]
2451 set offs [lindex $rowoffsets $row]
2452 while {$row < $endrow} {
2453 set id [lindex $displayorder $row]
2454 set oldolds {}
2455 set newolds {}
2456 foreach p [lindex $parentlist $row] {
2457 if {![info exists idinlist($p)]} {
2458 lappend newolds $p
2459 } elseif {!$idinlist($p)} {
2460 lappend oldolds $p
2463 set lse {}
2464 set nev [expr {[llength $idlist] + [llength $newolds]
2465 + [llength $oldolds] - $maxwidth + 1}]
2466 if {$nev > 0} {
2467 if {!$last &&
2468 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2469 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2470 set i [lindex $idlist $x]
2471 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2472 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2473 [expr {$row + $uparrowlen + $mingaplen}]]
2474 if {$r == 0} {
2475 set idlist [lreplace $idlist $x $x]
2476 set offs [lreplace $offs $x $x]
2477 set offs [incrange $offs $x 1]
2478 set idinlist($i) 0
2479 set rm1 [expr {$row - 1}]
2480 lappend lse $i
2481 lappend idrowranges($i) $rm1
2482 if {[incr nev -1] <= 0} break
2483 continue
2485 set rowchk($id) [expr {$row + $r}]
2488 lset rowidlist $row $idlist
2489 lset rowoffsets $row $offs
2491 lappend linesegends $lse
2492 set col [lsearch -exact $idlist $id]
2493 if {$col < 0} {
2494 set col [llength $idlist]
2495 lappend idlist $id
2496 lset rowidlist $row $idlist
2497 set z {}
2498 if {[lindex $childlist $row] ne {}} {
2499 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2500 unset idinlist($id)
2502 lappend offs $z
2503 lset rowoffsets $row $offs
2504 if {$z ne {}} {
2505 makeuparrow $id $col $row $z
2507 } else {
2508 unset idinlist($id)
2510 set ranges {}
2511 if {[info exists idrowranges($id)]} {
2512 set ranges $idrowranges($id)
2513 lappend ranges $row
2514 unset idrowranges($id)
2516 lappend rowrangelist $ranges
2517 incr row
2518 set offs [ntimes [llength $idlist] 0]
2519 set l [llength $newolds]
2520 set idlist [eval lreplace \$idlist $col $col $newolds]
2521 set o 0
2522 if {$l != 1} {
2523 set offs [lrange $offs 0 [expr {$col - 1}]]
2524 foreach x $newolds {
2525 lappend offs {}
2526 incr o -1
2528 incr o
2529 set tmp [expr {[llength $idlist] - [llength $offs]}]
2530 if {$tmp > 0} {
2531 set offs [concat $offs [ntimes $tmp $o]]
2533 } else {
2534 lset offs $col {}
2536 foreach i $newolds {
2537 set idinlist($i) 1
2538 set idrowranges($i) $row
2540 incr col $l
2541 foreach oid $oldolds {
2542 set idinlist($oid) 1
2543 set idlist [linsert $idlist $col $oid]
2544 set offs [linsert $offs $col $o]
2545 makeuparrow $oid $col $row $o
2546 incr col
2548 lappend rowidlist $idlist
2549 lappend rowoffsets $offs
2551 return $row
2554 proc addextraid {id row} {
2555 global displayorder commitrow commitinfo
2556 global commitidx commitlisted
2557 global parentlist childlist children curview
2559 incr commitidx($curview)
2560 lappend displayorder $id
2561 lappend commitlisted 0
2562 lappend parentlist {}
2563 set commitrow($curview,$id) $row
2564 readcommit $id
2565 if {![info exists commitinfo($id)]} {
2566 set commitinfo($id) {"No commit information available"}
2568 if {![info exists children($curview,$id)]} {
2569 set children($curview,$id) {}
2571 lappend childlist $children($curview,$id)
2574 proc layouttail {} {
2575 global rowidlist rowoffsets idinlist commitidx curview
2576 global idrowranges rowrangelist
2578 set row $commitidx($curview)
2579 set idlist [lindex $rowidlist $row]
2580 while {$idlist ne {}} {
2581 set col [expr {[llength $idlist] - 1}]
2582 set id [lindex $idlist $col]
2583 addextraid $id $row
2584 unset idinlist($id)
2585 lappend idrowranges($id) $row
2586 lappend rowrangelist $idrowranges($id)
2587 unset idrowranges($id)
2588 incr row
2589 set offs [ntimes $col 0]
2590 set idlist [lreplace $idlist $col $col]
2591 lappend rowidlist $idlist
2592 lappend rowoffsets $offs
2595 foreach id [array names idinlist] {
2596 addextraid $id $row
2597 lset rowidlist $row [list $id]
2598 lset rowoffsets $row 0
2599 makeuparrow $id 0 $row 0
2600 lappend idrowranges($id) $row
2601 lappend rowrangelist $idrowranges($id)
2602 unset idrowranges($id)
2603 incr row
2604 lappend rowidlist {}
2605 lappend rowoffsets {}
2609 proc insert_pad {row col npad} {
2610 global rowidlist rowoffsets
2612 set pad [ntimes $npad {}]
2613 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2614 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2615 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2618 proc optimize_rows {row col endrow} {
2619 global rowidlist rowoffsets idrowranges displayorder
2621 for {} {$row < $endrow} {incr row} {
2622 set idlist [lindex $rowidlist $row]
2623 set offs [lindex $rowoffsets $row]
2624 set haspad 0
2625 for {} {$col < [llength $offs]} {incr col} {
2626 if {[lindex $idlist $col] eq {}} {
2627 set haspad 1
2628 continue
2630 set z [lindex $offs $col]
2631 if {$z eq {}} continue
2632 set isarrow 0
2633 set x0 [expr {$col + $z}]
2634 set y0 [expr {$row - 1}]
2635 set z0 [lindex $rowoffsets $y0 $x0]
2636 if {$z0 eq {}} {
2637 set id [lindex $idlist $col]
2638 set ranges [rowranges $id]
2639 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2640 set isarrow 1
2643 if {$z < -1 || ($z < 0 && $isarrow)} {
2644 set npad [expr {-1 - $z + $isarrow}]
2645 set offs [incrange $offs $col $npad]
2646 insert_pad $y0 $x0 $npad
2647 if {$y0 > 0} {
2648 optimize_rows $y0 $x0 $row
2650 set z [lindex $offs $col]
2651 set x0 [expr {$col + $z}]
2652 set z0 [lindex $rowoffsets $y0 $x0]
2653 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2654 set npad [expr {$z - 1 + $isarrow}]
2655 set y1 [expr {$row + 1}]
2656 set offs2 [lindex $rowoffsets $y1]
2657 set x1 -1
2658 foreach z $offs2 {
2659 incr x1
2660 if {$z eq {} || $x1 + $z < $col} continue
2661 if {$x1 + $z > $col} {
2662 incr npad
2664 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2665 break
2667 set pad [ntimes $npad {}]
2668 set idlist [eval linsert \$idlist $col $pad]
2669 set tmp [eval linsert \$offs $col $pad]
2670 incr col $npad
2671 set offs [incrange $tmp $col [expr {-$npad}]]
2672 set z [lindex $offs $col]
2673 set haspad 1
2675 if {$z0 eq {} && !$isarrow} {
2676 # this line links to its first child on row $row-2
2677 set rm2 [expr {$row - 2}]
2678 set id [lindex $displayorder $rm2]
2679 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2680 if {$xc >= 0} {
2681 set z0 [expr {$xc - $x0}]
2684 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2685 insert_pad $y0 $x0 1
2686 set offs [incrange $offs $col 1]
2687 optimize_rows $y0 [expr {$x0 + 1}] $row
2690 if {!$haspad} {
2691 set o {}
2692 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2693 set o [lindex $offs $col]
2694 if {$o eq {}} {
2695 # check if this is the link to the first child
2696 set id [lindex $idlist $col]
2697 set ranges [rowranges $id]
2698 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2699 # it is, work out offset to child
2700 set y0 [expr {$row - 1}]
2701 set id [lindex $displayorder $y0]
2702 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2703 if {$x0 >= 0} {
2704 set o [expr {$x0 - $col}]
2708 if {$o eq {} || $o <= 0} break
2710 if {$o ne {} && [incr col] < [llength $idlist]} {
2711 set y1 [expr {$row + 1}]
2712 set offs2 [lindex $rowoffsets $y1]
2713 set x1 -1
2714 foreach z $offs2 {
2715 incr x1
2716 if {$z eq {} || $x1 + $z < $col} continue
2717 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2718 break
2720 set idlist [linsert $idlist $col {}]
2721 set tmp [linsert $offs $col {}]
2722 incr col
2723 set offs [incrange $tmp $col -1]
2726 lset rowidlist $row $idlist
2727 lset rowoffsets $row $offs
2728 set col 0
2732 proc xc {row col} {
2733 global canvx0 linespc
2734 return [expr {$canvx0 + $col * $linespc}]
2737 proc yc {row} {
2738 global canvy0 linespc
2739 return [expr {$canvy0 + $row * $linespc}]
2742 proc linewidth {id} {
2743 global thickerline lthickness
2745 set wid $lthickness
2746 if {[info exists thickerline] && $id eq $thickerline} {
2747 set wid [expr {2 * $lthickness}]
2749 return $wid
2752 proc rowranges {id} {
2753 global phase idrowranges commitrow rowlaidout rowrangelist curview
2755 set ranges {}
2756 if {$phase eq {} ||
2757 ([info exists commitrow($curview,$id)]
2758 && $commitrow($curview,$id) < $rowlaidout)} {
2759 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2760 } elseif {[info exists idrowranges($id)]} {
2761 set ranges $idrowranges($id)
2763 return $ranges
2766 proc drawlineseg {id i} {
2767 global rowoffsets rowidlist
2768 global displayorder
2769 global canv colormap linespc
2770 global numcommits commitrow curview
2772 set ranges [rowranges $id]
2773 set downarrow 1
2774 if {[info exists commitrow($curview,$id)]
2775 && $commitrow($curview,$id) < $numcommits} {
2776 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2777 } else {
2778 set downarrow 1
2780 set startrow [lindex $ranges [expr {2 * $i}]]
2781 set row [lindex $ranges [expr {2 * $i + 1}]]
2782 if {$startrow == $row} return
2783 assigncolor $id
2784 set coords {}
2785 set col [lsearch -exact [lindex $rowidlist $row] $id]
2786 if {$col < 0} {
2787 puts "oops: drawline: id $id not on row $row"
2788 return
2790 set lasto {}
2791 set ns 0
2792 while {1} {
2793 set o [lindex $rowoffsets $row $col]
2794 if {$o eq {}} break
2795 if {$o ne $lasto} {
2796 # changing direction
2797 set x [xc $row $col]
2798 set y [yc $row]
2799 lappend coords $x $y
2800 set lasto $o
2802 incr col $o
2803 incr row -1
2805 set x [xc $row $col]
2806 set y [yc $row]
2807 lappend coords $x $y
2808 if {$i == 0} {
2809 # draw the link to the first child as part of this line
2810 incr row -1
2811 set child [lindex $displayorder $row]
2812 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2813 if {$ccol >= 0} {
2814 set x [xc $row $ccol]
2815 set y [yc $row]
2816 if {$ccol < $col - 1} {
2817 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2818 } elseif {$ccol > $col + 1} {
2819 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2821 lappend coords $x $y
2824 if {[llength $coords] < 4} return
2825 if {$downarrow} {
2826 # This line has an arrow at the lower end: check if the arrow is
2827 # on a diagonal segment, and if so, work around the Tk 8.4
2828 # refusal to draw arrows on diagonal lines.
2829 set x0 [lindex $coords 0]
2830 set x1 [lindex $coords 2]
2831 if {$x0 != $x1} {
2832 set y0 [lindex $coords 1]
2833 set y1 [lindex $coords 3]
2834 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2835 # we have a nearby vertical segment, just trim off the diag bit
2836 set coords [lrange $coords 2 end]
2837 } else {
2838 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2839 set xi [expr {$x0 - $slope * $linespc / 2}]
2840 set yi [expr {$y0 - $linespc / 2}]
2841 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2845 set arrow [expr {2 * ($i > 0) + $downarrow}]
2846 set arrow [lindex {none first last both} $arrow]
2847 set t [$canv create line $coords -width [linewidth $id] \
2848 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2849 $canv lower $t
2850 bindline $t $id
2853 proc drawparentlinks {id row col olds} {
2854 global rowidlist canv colormap
2856 set row2 [expr {$row + 1}]
2857 set x [xc $row $col]
2858 set y [yc $row]
2859 set y2 [yc $row2]
2860 set ids [lindex $rowidlist $row2]
2861 # rmx = right-most X coord used
2862 set rmx 0
2863 foreach p $olds {
2864 set i [lsearch -exact $ids $p]
2865 if {$i < 0} {
2866 puts "oops, parent $p of $id not in list"
2867 continue
2869 set x2 [xc $row2 $i]
2870 if {$x2 > $rmx} {
2871 set rmx $x2
2873 set ranges [rowranges $p]
2874 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2875 && $row2 < [lindex $ranges 1]} {
2876 # drawlineseg will do this one for us
2877 continue
2879 assigncolor $p
2880 # should handle duplicated parents here...
2881 set coords [list $x $y]
2882 if {$i < $col - 1} {
2883 lappend coords [xc $row [expr {$i + 1}]] $y
2884 } elseif {$i > $col + 1} {
2885 lappend coords [xc $row [expr {$i - 1}]] $y
2887 lappend coords $x2 $y2
2888 set t [$canv create line $coords -width [linewidth $p] \
2889 -fill $colormap($p) -tags lines.$p]
2890 $canv lower $t
2891 bindline $t $p
2893 return $rmx
2896 proc drawlines {id} {
2897 global colormap canv
2898 global idrangedrawn
2899 global children iddrawn commitrow rowidlist curview
2901 $canv delete lines.$id
2902 set nr [expr {[llength [rowranges $id]] / 2}]
2903 for {set i 0} {$i < $nr} {incr i} {
2904 if {[info exists idrangedrawn($id,$i)]} {
2905 drawlineseg $id $i
2908 foreach child $children($curview,$id) {
2909 if {[info exists iddrawn($child)]} {
2910 set row $commitrow($curview,$child)
2911 set col [lsearch -exact [lindex $rowidlist $row] $child]
2912 if {$col >= 0} {
2913 drawparentlinks $child $row $col [list $id]
2919 proc drawcmittext {id row col rmx} {
2920 global linespc canv canv2 canv3 canvy0 fgcolor
2921 global commitlisted commitinfo rowidlist
2922 global rowtextx idpos idtags idheads idotherrefs
2923 global linehtag linentag linedtag
2924 global mainfont canvxmax boldrows boldnamerows fgcolor
2926 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2927 set x [xc $row $col]
2928 set y [yc $row]
2929 set orad [expr {$linespc / 3}]
2930 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2931 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2932 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2933 $canv raise $t
2934 $canv bind $t <1> {selcanvline {} %x %y}
2935 set xt [xc $row [llength [lindex $rowidlist $row]]]
2936 if {$xt < $rmx} {
2937 set xt $rmx
2939 set rowtextx($row) $xt
2940 set idpos($id) [list $x $xt $y]
2941 if {[info exists idtags($id)] || [info exists idheads($id)]
2942 || [info exists idotherrefs($id)]} {
2943 set xt [drawtags $id $x $xt $y]
2945 set headline [lindex $commitinfo($id) 0]
2946 set name [lindex $commitinfo($id) 1]
2947 set date [lindex $commitinfo($id) 2]
2948 set date [formatdate $date]
2949 set font $mainfont
2950 set nfont $mainfont
2951 set isbold [ishighlighted $row]
2952 if {$isbold > 0} {
2953 lappend boldrows $row
2954 lappend font bold
2955 if {$isbold > 1} {
2956 lappend boldnamerows $row
2957 lappend nfont bold
2960 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2961 -text $headline -font $font -tags text]
2962 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2963 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2964 -text $name -font $nfont -tags text]
2965 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2966 -text $date -font $mainfont -tags text]
2967 set xr [expr {$xt + [font measure $mainfont $headline]}]
2968 if {$xr > $canvxmax} {
2969 set canvxmax $xr
2970 setcanvscroll
2974 proc drawcmitrow {row} {
2975 global displayorder rowidlist
2976 global idrangedrawn iddrawn
2977 global commitinfo parentlist numcommits
2978 global filehighlight fhighlights findstring nhighlights
2979 global hlview vhighlights
2980 global highlight_related rhighlights
2982 if {$row >= $numcommits} return
2983 foreach id [lindex $rowidlist $row] {
2984 if {$id eq {}} continue
2985 set i -1
2986 foreach {s e} [rowranges $id] {
2987 incr i
2988 if {$row < $s} continue
2989 if {$e eq {}} break
2990 if {$row <= $e} {
2991 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2992 drawlineseg $id $i
2993 set idrangedrawn($id,$i) 1
2995 break
3000 set id [lindex $displayorder $row]
3001 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3002 askvhighlight $row $id
3004 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3005 askfilehighlight $row $id
3007 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3008 askfindhighlight $row $id
3010 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3011 askrelhighlight $row $id
3013 if {[info exists iddrawn($id)]} return
3014 set col [lsearch -exact [lindex $rowidlist $row] $id]
3015 if {$col < 0} {
3016 puts "oops, row $row id $id not in list"
3017 return
3019 if {![info exists commitinfo($id)]} {
3020 getcommit $id
3022 assigncolor $id
3023 set olds [lindex $parentlist $row]
3024 if {$olds ne {}} {
3025 set rmx [drawparentlinks $id $row $col $olds]
3026 } else {
3027 set rmx 0
3029 drawcmittext $id $row $col $rmx
3030 set iddrawn($id) 1
3033 proc drawfrac {f0 f1} {
3034 global numcommits canv
3035 global linespc
3037 set ymax [lindex [$canv cget -scrollregion] 3]
3038 if {$ymax eq {} || $ymax == 0} return
3039 set y0 [expr {int($f0 * $ymax)}]
3040 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3041 if {$row < 0} {
3042 set row 0
3044 set y1 [expr {int($f1 * $ymax)}]
3045 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3046 if {$endrow >= $numcommits} {
3047 set endrow [expr {$numcommits - 1}]
3049 for {} {$row <= $endrow} {incr row} {
3050 drawcmitrow $row
3054 proc drawvisible {} {
3055 global canv
3056 eval drawfrac [$canv yview]
3059 proc clear_display {} {
3060 global iddrawn idrangedrawn
3061 global vhighlights fhighlights nhighlights rhighlights
3063 allcanvs delete all
3064 catch {unset iddrawn}
3065 catch {unset idrangedrawn}
3066 catch {unset vhighlights}
3067 catch {unset fhighlights}
3068 catch {unset nhighlights}
3069 catch {unset rhighlights}
3072 proc findcrossings {id} {
3073 global rowidlist parentlist numcommits rowoffsets displayorder
3075 set cross {}
3076 set ccross {}
3077 foreach {s e} [rowranges $id] {
3078 if {$e >= $numcommits} {
3079 set e [expr {$numcommits - 1}]
3081 if {$e <= $s} continue
3082 set x [lsearch -exact [lindex $rowidlist $e] $id]
3083 if {$x < 0} {
3084 puts "findcrossings: oops, no [shortids $id] in row $e"
3085 continue
3087 for {set row $e} {[incr row -1] >= $s} {} {
3088 set olds [lindex $parentlist $row]
3089 set kid [lindex $displayorder $row]
3090 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3091 if {$kidx < 0} continue
3092 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3093 foreach p $olds {
3094 set px [lsearch -exact $nextrow $p]
3095 if {$px < 0} continue
3096 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3097 if {[lsearch -exact $ccross $p] >= 0} continue
3098 if {$x == $px + ($kidx < $px? -1: 1)} {
3099 lappend ccross $p
3100 } elseif {[lsearch -exact $cross $p] < 0} {
3101 lappend cross $p
3105 set inc [lindex $rowoffsets $row $x]
3106 if {$inc eq {}} break
3107 incr x $inc
3110 return [concat $ccross {{}} $cross]
3113 proc assigncolor {id} {
3114 global colormap colors nextcolor
3115 global commitrow parentlist children children curview
3117 if {[info exists colormap($id)]} return
3118 set ncolors [llength $colors]
3119 if {[info exists children($curview,$id)]} {
3120 set kids $children($curview,$id)
3121 } else {
3122 set kids {}
3124 if {[llength $kids] == 1} {
3125 set child [lindex $kids 0]
3126 if {[info exists colormap($child)]
3127 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3128 set colormap($id) $colormap($child)
3129 return
3132 set badcolors {}
3133 set origbad {}
3134 foreach x [findcrossings $id] {
3135 if {$x eq {}} {
3136 # delimiter between corner crossings and other crossings
3137 if {[llength $badcolors] >= $ncolors - 1} break
3138 set origbad $badcolors
3140 if {[info exists colormap($x)]
3141 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3142 lappend badcolors $colormap($x)
3145 if {[llength $badcolors] >= $ncolors} {
3146 set badcolors $origbad
3148 set origbad $badcolors
3149 if {[llength $badcolors] < $ncolors - 1} {
3150 foreach child $kids {
3151 if {[info exists colormap($child)]
3152 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3153 lappend badcolors $colormap($child)
3155 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3156 if {[info exists colormap($p)]
3157 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3158 lappend badcolors $colormap($p)
3162 if {[llength $badcolors] >= $ncolors} {
3163 set badcolors $origbad
3166 for {set i 0} {$i <= $ncolors} {incr i} {
3167 set c [lindex $colors $nextcolor]
3168 if {[incr nextcolor] >= $ncolors} {
3169 set nextcolor 0
3171 if {[lsearch -exact $badcolors $c]} break
3173 set colormap($id) $c
3176 proc bindline {t id} {
3177 global canv
3179 $canv bind $t <Enter> "lineenter %x %y $id"
3180 $canv bind $t <Motion> "linemotion %x %y $id"
3181 $canv bind $t <Leave> "lineleave $id"
3182 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3185 proc drawtags {id x xt y1} {
3186 global idtags idheads idotherrefs mainhead
3187 global linespc lthickness
3188 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3190 set marks {}
3191 set ntags 0
3192 set nheads 0
3193 if {[info exists idtags($id)]} {
3194 set marks $idtags($id)
3195 set ntags [llength $marks]
3197 if {[info exists idheads($id)]} {
3198 set marks [concat $marks $idheads($id)]
3199 set nheads [llength $idheads($id)]
3201 if {[info exists idotherrefs($id)]} {
3202 set marks [concat $marks $idotherrefs($id)]
3204 if {$marks eq {}} {
3205 return $xt
3208 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3209 set yt [expr {$y1 - 0.5 * $linespc}]
3210 set yb [expr {$yt + $linespc - 1}]
3211 set xvals {}
3212 set wvals {}
3213 set i -1
3214 foreach tag $marks {
3215 incr i
3216 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3217 set wid [font measure [concat $mainfont bold] $tag]
3218 } else {
3219 set wid [font measure $mainfont $tag]
3221 lappend xvals $xt
3222 lappend wvals $wid
3223 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3225 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3226 -width $lthickness -fill black -tags tag.$id]
3227 $canv lower $t
3228 foreach tag $marks x $xvals wid $wvals {
3229 set xl [expr {$x + $delta}]
3230 set xr [expr {$x + $delta + $wid + $lthickness}]
3231 set font $mainfont
3232 if {[incr ntags -1] >= 0} {
3233 # draw a tag
3234 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3235 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3236 -width 1 -outline black -fill yellow -tags tag.$id]
3237 $canv bind $t <1> [list showtag $tag 1]
3238 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3239 } else {
3240 # draw a head or other ref
3241 if {[incr nheads -1] >= 0} {
3242 set col green
3243 if {$tag eq $mainhead} {
3244 lappend font bold
3246 } else {
3247 set col "#ddddff"
3249 set xl [expr {$xl - $delta/2}]
3250 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3251 -width 1 -outline black -fill $col -tags tag.$id
3252 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3253 set rwid [font measure $mainfont $remoteprefix]
3254 set xi [expr {$x + 1}]
3255 set yti [expr {$yt + 1}]
3256 set xri [expr {$x + $rwid}]
3257 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3258 -width 0 -fill "#ffddaa" -tags tag.$id
3261 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3262 -font $font -tags [list tag.$id text]]
3263 if {$ntags >= 0} {
3264 $canv bind $t <1> [list showtag $tag 1]
3265 } elseif {$nheads >= 0} {
3266 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3269 return $xt
3272 proc xcoord {i level ln} {
3273 global canvx0 xspc1 xspc2
3275 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3276 if {$i > 0 && $i == $level} {
3277 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3278 } elseif {$i > $level} {
3279 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3281 return $x
3284 proc show_status {msg} {
3285 global canv mainfont fgcolor
3287 clear_display
3288 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3289 -tags text -fill $fgcolor
3292 proc finishcommits {} {
3293 global commitidx phase curview
3294 global pending_select
3296 if {$commitidx($curview) > 0} {
3297 drawrest
3298 } else {
3299 show_status "No commits selected"
3301 set phase {}
3302 catch {unset pending_select}
3305 # Don't change the text pane cursor if it is currently the hand cursor,
3306 # showing that we are over a sha1 ID link.
3307 proc settextcursor {c} {
3308 global ctext curtextcursor
3310 if {[$ctext cget -cursor] == $curtextcursor} {
3311 $ctext config -cursor $c
3313 set curtextcursor $c
3316 proc nowbusy {what} {
3317 global isbusy
3319 if {[array names isbusy] eq {}} {
3320 . config -cursor watch
3321 settextcursor watch
3323 set isbusy($what) 1
3326 proc notbusy {what} {
3327 global isbusy maincursor textcursor
3329 catch {unset isbusy($what)}
3330 if {[array names isbusy] eq {}} {
3331 . config -cursor $maincursor
3332 settextcursor $textcursor
3336 proc drawrest {} {
3337 global startmsecs
3338 global rowlaidout commitidx curview
3339 global pending_select
3341 set row $rowlaidout
3342 layoutrows $rowlaidout $commitidx($curview) 1
3343 layouttail
3344 optimize_rows $row 0 $commitidx($curview)
3345 showstuff $commitidx($curview)
3346 if {[info exists pending_select]} {
3347 selectline 0 1
3350 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3351 #global numcommits
3352 #puts "overall $drawmsecs ms for $numcommits commits"
3355 proc findmatches {f} {
3356 global findtype foundstring foundstrlen
3357 if {$findtype == "Regexp"} {
3358 set matches [regexp -indices -all -inline $foundstring $f]
3359 } else {
3360 if {$findtype == "IgnCase"} {
3361 set str [string tolower $f]
3362 } else {
3363 set str $f
3365 set matches {}
3366 set i 0
3367 while {[set j [string first $foundstring $str $i]] >= 0} {
3368 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3369 set i [expr {$j + $foundstrlen}]
3372 return $matches
3375 proc dofind {} {
3376 global findtype findloc findstring markedmatches commitinfo
3377 global numcommits displayorder linehtag linentag linedtag
3378 global mainfont canv canv2 canv3 selectedline
3379 global matchinglines foundstring foundstrlen matchstring
3380 global commitdata
3382 stopfindproc
3383 unmarkmatches
3384 cancel_next_highlight
3385 focus .
3386 set matchinglines {}
3387 if {$findtype == "IgnCase"} {
3388 set foundstring [string tolower $findstring]
3389 } else {
3390 set foundstring $findstring
3392 set foundstrlen [string length $findstring]
3393 if {$foundstrlen == 0} return
3394 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3395 set matchstring "*$matchstring*"
3396 if {![info exists selectedline]} {
3397 set oldsel -1
3398 } else {
3399 set oldsel $selectedline
3401 set didsel 0
3402 set fldtypes {Headline Author Date Committer CDate Comments}
3403 set l -1
3404 foreach id $displayorder {
3405 set d $commitdata($id)
3406 incr l
3407 if {$findtype == "Regexp"} {
3408 set doesmatch [regexp $foundstring $d]
3409 } elseif {$findtype == "IgnCase"} {
3410 set doesmatch [string match -nocase $matchstring $d]
3411 } else {
3412 set doesmatch [string match $matchstring $d]
3414 if {!$doesmatch} continue
3415 if {![info exists commitinfo($id)]} {
3416 getcommit $id
3418 set info $commitinfo($id)
3419 set doesmatch 0
3420 foreach f $info ty $fldtypes {
3421 if {$findloc != "All fields" && $findloc != $ty} {
3422 continue
3424 set matches [findmatches $f]
3425 if {$matches == {}} continue
3426 set doesmatch 1
3427 if {$ty == "Headline"} {
3428 drawcmitrow $l
3429 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3430 } elseif {$ty == "Author"} {
3431 drawcmitrow $l
3432 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3433 } elseif {$ty == "Date"} {
3434 drawcmitrow $l
3435 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3438 if {$doesmatch} {
3439 lappend matchinglines $l
3440 if {!$didsel && $l > $oldsel} {
3441 findselectline $l
3442 set didsel 1
3446 if {$matchinglines == {}} {
3447 bell
3448 } elseif {!$didsel} {
3449 findselectline [lindex $matchinglines 0]
3453 proc findselectline {l} {
3454 global findloc commentend ctext
3455 selectline $l 1
3456 if {$findloc == "All fields" || $findloc == "Comments"} {
3457 # highlight the matches in the comments
3458 set f [$ctext get 1.0 $commentend]
3459 set matches [findmatches $f]
3460 foreach match $matches {
3461 set start [lindex $match 0]
3462 set end [expr {[lindex $match 1] + 1}]
3463 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3468 proc findnext {restart} {
3469 global matchinglines selectedline
3470 if {![info exists matchinglines]} {
3471 if {$restart} {
3472 dofind
3474 return
3476 if {![info exists selectedline]} return
3477 foreach l $matchinglines {
3478 if {$l > $selectedline} {
3479 findselectline $l
3480 return
3483 bell
3486 proc findprev {} {
3487 global matchinglines selectedline
3488 if {![info exists matchinglines]} {
3489 dofind
3490 return
3492 if {![info exists selectedline]} return
3493 set prev {}
3494 foreach l $matchinglines {
3495 if {$l >= $selectedline} break
3496 set prev $l
3498 if {$prev != {}} {
3499 findselectline $prev
3500 } else {
3501 bell
3505 proc stopfindproc {{done 0}} {
3506 global findprocpid findprocfile findids
3507 global ctext findoldcursor phase maincursor textcursor
3508 global findinprogress
3510 catch {unset findids}
3511 if {[info exists findprocpid]} {
3512 if {!$done} {
3513 catch {exec kill $findprocpid}
3515 catch {close $findprocfile}
3516 unset findprocpid
3518 catch {unset findinprogress}
3519 notbusy find
3522 # mark a commit as matching by putting a yellow background
3523 # behind the headline
3524 proc markheadline {l id} {
3525 global canv mainfont linehtag
3527 drawcmitrow $l
3528 set bbox [$canv bbox $linehtag($l)]
3529 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3530 $canv lower $t
3533 # mark the bits of a headline, author or date that match a find string
3534 proc markmatches {canv l str tag matches font} {
3535 set bbox [$canv bbox $tag]
3536 set x0 [lindex $bbox 0]
3537 set y0 [lindex $bbox 1]
3538 set y1 [lindex $bbox 3]
3539 foreach match $matches {
3540 set start [lindex $match 0]
3541 set end [lindex $match 1]
3542 if {$start > $end} continue
3543 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3544 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3545 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3546 [expr {$x0+$xlen+2}] $y1 \
3547 -outline {} -tags matches -fill yellow]
3548 $canv lower $t
3552 proc unmarkmatches {} {
3553 global matchinglines findids
3554 allcanvs delete matches
3555 catch {unset matchinglines}
3556 catch {unset findids}
3559 proc selcanvline {w x y} {
3560 global canv canvy0 ctext linespc
3561 global rowtextx
3562 set ymax [lindex [$canv cget -scrollregion] 3]
3563 if {$ymax == {}} return
3564 set yfrac [lindex [$canv yview] 0]
3565 set y [expr {$y + $yfrac * $ymax}]
3566 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3567 if {$l < 0} {
3568 set l 0
3570 if {$w eq $canv} {
3571 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3573 unmarkmatches
3574 selectline $l 1
3577 proc commit_descriptor {p} {
3578 global commitinfo
3579 if {![info exists commitinfo($p)]} {
3580 getcommit $p
3582 set l "..."
3583 if {[llength $commitinfo($p)] > 1} {
3584 set l [lindex $commitinfo($p) 0]
3586 return "$p ($l)\n"
3589 # append some text to the ctext widget, and make any SHA1 ID
3590 # that we know about be a clickable link.
3591 proc appendwithlinks {text tags} {
3592 global ctext commitrow linknum curview
3594 set start [$ctext index "end - 1c"]
3595 $ctext insert end $text $tags
3596 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3597 foreach l $links {
3598 set s [lindex $l 0]
3599 set e [lindex $l 1]
3600 set linkid [string range $text $s $e]
3601 if {![info exists commitrow($curview,$linkid)]} continue
3602 incr e
3603 $ctext tag add link "$start + $s c" "$start + $e c"
3604 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3605 $ctext tag bind link$linknum <1> \
3606 [list selectline $commitrow($curview,$linkid) 1]
3607 incr linknum
3609 $ctext tag conf link -foreground blue -underline 1
3610 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3611 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3614 proc viewnextline {dir} {
3615 global canv linespc
3617 $canv delete hover
3618 set ymax [lindex [$canv cget -scrollregion] 3]
3619 set wnow [$canv yview]
3620 set wtop [expr {[lindex $wnow 0] * $ymax}]
3621 set newtop [expr {$wtop + $dir * $linespc}]
3622 if {$newtop < 0} {
3623 set newtop 0
3624 } elseif {$newtop > $ymax} {
3625 set newtop $ymax
3627 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3630 # add a list of tag or branch names at position pos
3631 # returns the number of names inserted
3632 proc appendrefs {pos l var} {
3633 global ctext commitrow linknum curview idtags $var
3635 if {[catch {$ctext index $pos}]} {
3636 return 0
3638 set tags {}
3639 foreach id $l {
3640 foreach tag [set $var\($id\)] {
3641 lappend tags [concat $tag $id]
3644 set tags [lsort -index 1 $tags]
3645 set sep {}
3646 foreach tag $tags {
3647 set name [lindex $tag 0]
3648 set id [lindex $tag 1]
3649 set lk link$linknum
3650 incr linknum
3651 $ctext insert $pos $sep
3652 $ctext insert $pos $name $lk
3653 $ctext tag conf $lk -foreground blue
3654 if {[info exists commitrow($curview,$id)]} {
3655 $ctext tag bind $lk <1> \
3656 [list selectline $commitrow($curview,$id) 1]
3657 $ctext tag conf $lk -underline 1
3658 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3659 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3661 set sep ", "
3663 return [llength $tags]
3666 # called when we have finished computing the nearby tags
3667 proc dispneartags {} {
3668 global selectedline currentid ctext anc_tags desc_tags showneartags
3669 global desc_heads
3671 if {![info exists selectedline] || !$showneartags} return
3672 set id $currentid
3673 $ctext conf -state normal
3674 if {[info exists desc_heads($id)]} {
3675 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3676 $ctext insert "branch -2c" "es"
3679 if {[info exists anc_tags($id)]} {
3680 appendrefs follows $anc_tags($id) idtags
3682 if {[info exists desc_tags($id)]} {
3683 appendrefs precedes $desc_tags($id) idtags
3685 $ctext conf -state disabled
3688 proc selectline {l isnew} {
3689 global canv canv2 canv3 ctext commitinfo selectedline
3690 global displayorder linehtag linentag linedtag
3691 global canvy0 linespc parentlist childlist
3692 global currentid sha1entry
3693 global commentend idtags linknum
3694 global mergemax numcommits pending_select
3695 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3697 catch {unset pending_select}
3698 $canv delete hover
3699 normalline
3700 cancel_next_highlight
3701 if {$l < 0 || $l >= $numcommits} return
3702 set y [expr {$canvy0 + $l * $linespc}]
3703 set ymax [lindex [$canv cget -scrollregion] 3]
3704 set ytop [expr {$y - $linespc - 1}]
3705 set ybot [expr {$y + $linespc + 1}]
3706 set wnow [$canv yview]
3707 set wtop [expr {[lindex $wnow 0] * $ymax}]
3708 set wbot [expr {[lindex $wnow 1] * $ymax}]
3709 set wh [expr {$wbot - $wtop}]
3710 set newtop $wtop
3711 if {$ytop < $wtop} {
3712 if {$ybot < $wtop} {
3713 set newtop [expr {$y - $wh / 2.0}]
3714 } else {
3715 set newtop $ytop
3716 if {$newtop > $wtop - $linespc} {
3717 set newtop [expr {$wtop - $linespc}]
3720 } elseif {$ybot > $wbot} {
3721 if {$ytop > $wbot} {
3722 set newtop [expr {$y - $wh / 2.0}]
3723 } else {
3724 set newtop [expr {$ybot - $wh}]
3725 if {$newtop < $wtop + $linespc} {
3726 set newtop [expr {$wtop + $linespc}]
3730 if {$newtop != $wtop} {
3731 if {$newtop < 0} {
3732 set newtop 0
3734 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3735 drawvisible
3738 if {![info exists linehtag($l)]} return
3739 $canv delete secsel
3740 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3741 -tags secsel -fill [$canv cget -selectbackground]]
3742 $canv lower $t
3743 $canv2 delete secsel
3744 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3745 -tags secsel -fill [$canv2 cget -selectbackground]]
3746 $canv2 lower $t
3747 $canv3 delete secsel
3748 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3749 -tags secsel -fill [$canv3 cget -selectbackground]]
3750 $canv3 lower $t
3752 if {$isnew} {
3753 addtohistory [list selectline $l 0]
3756 set selectedline $l
3758 set id [lindex $displayorder $l]
3759 set currentid $id
3760 $sha1entry delete 0 end
3761 $sha1entry insert 0 $id
3762 $sha1entry selection from 0
3763 $sha1entry selection to end
3764 rhighlight_sel $id
3766 $ctext conf -state normal
3767 clear_ctext
3768 set linknum 0
3769 set info $commitinfo($id)
3770 set date [formatdate [lindex $info 2]]
3771 $ctext insert end "Author: [lindex $info 1] $date\n"
3772 set date [formatdate [lindex $info 4]]
3773 $ctext insert end "Committer: [lindex $info 3] $date\n"
3774 if {[info exists idtags($id)]} {
3775 $ctext insert end "Tags:"
3776 foreach tag $idtags($id) {
3777 $ctext insert end " $tag"
3779 $ctext insert end "\n"
3782 set headers {}
3783 set olds [lindex $parentlist $l]
3784 if {[llength $olds] > 1} {
3785 set np 0
3786 foreach p $olds {
3787 if {$np >= $mergemax} {
3788 set tag mmax
3789 } else {
3790 set tag m$np
3792 $ctext insert end "Parent: " $tag
3793 appendwithlinks [commit_descriptor $p] {}
3794 incr np
3796 } else {
3797 foreach p $olds {
3798 append headers "Parent: [commit_descriptor $p]"
3802 foreach c [lindex $childlist $l] {
3803 append headers "Child: [commit_descriptor $c]"
3806 # make anything that looks like a SHA1 ID be a clickable link
3807 appendwithlinks $headers {}
3808 if {$showneartags} {
3809 if {![info exists allcommits]} {
3810 getallcommits
3812 $ctext insert end "Branch: "
3813 $ctext mark set branch "end -1c"
3814 $ctext mark gravity branch left
3815 if {[info exists desc_heads($id)]} {
3816 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3817 # turn "Branch" into "Branches"
3818 $ctext insert "branch -2c" "es"
3821 $ctext insert end "\nFollows: "
3822 $ctext mark set follows "end -1c"
3823 $ctext mark gravity follows left
3824 if {[info exists anc_tags($id)]} {
3825 appendrefs follows $anc_tags($id) idtags
3827 $ctext insert end "\nPrecedes: "
3828 $ctext mark set precedes "end -1c"
3829 $ctext mark gravity precedes left
3830 if {[info exists desc_tags($id)]} {
3831 appendrefs precedes $desc_tags($id) idtags
3833 $ctext insert end "\n"
3835 $ctext insert end "\n"
3836 appendwithlinks [lindex $info 5] {comment}
3838 $ctext tag delete Comments
3839 $ctext tag remove found 1.0 end
3840 $ctext conf -state disabled
3841 set commentend [$ctext index "end - 1c"]
3843 init_flist "Comments"
3844 if {$cmitmode eq "tree"} {
3845 gettree $id
3846 } elseif {[llength $olds] <= 1} {
3847 startdiff $id
3848 } else {
3849 mergediff $id $l
3853 proc selfirstline {} {
3854 unmarkmatches
3855 selectline 0 1
3858 proc sellastline {} {
3859 global numcommits
3860 unmarkmatches
3861 set l [expr {$numcommits - 1}]
3862 selectline $l 1
3865 proc selnextline {dir} {
3866 global selectedline
3867 if {![info exists selectedline]} return
3868 set l [expr {$selectedline + $dir}]
3869 unmarkmatches
3870 selectline $l 1
3873 proc selnextpage {dir} {
3874 global canv linespc selectedline numcommits
3876 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3877 if {$lpp < 1} {
3878 set lpp 1
3880 allcanvs yview scroll [expr {$dir * $lpp}] units
3881 drawvisible
3882 if {![info exists selectedline]} return
3883 set l [expr {$selectedline + $dir * $lpp}]
3884 if {$l < 0} {
3885 set l 0
3886 } elseif {$l >= $numcommits} {
3887 set l [expr $numcommits - 1]
3889 unmarkmatches
3890 selectline $l 1
3893 proc unselectline {} {
3894 global selectedline currentid
3896 catch {unset selectedline}
3897 catch {unset currentid}
3898 allcanvs delete secsel
3899 rhighlight_none
3900 cancel_next_highlight
3903 proc reselectline {} {
3904 global selectedline
3906 if {[info exists selectedline]} {
3907 selectline $selectedline 0
3911 proc addtohistory {cmd} {
3912 global history historyindex curview
3914 set elt [list $curview $cmd]
3915 if {$historyindex > 0
3916 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3917 return
3920 if {$historyindex < [llength $history]} {
3921 set history [lreplace $history $historyindex end $elt]
3922 } else {
3923 lappend history $elt
3925 incr historyindex
3926 if {$historyindex > 1} {
3927 .ctop.top.bar.leftbut conf -state normal
3928 } else {
3929 .ctop.top.bar.leftbut conf -state disabled
3931 .ctop.top.bar.rightbut conf -state disabled
3934 proc godo {elt} {
3935 global curview
3937 set view [lindex $elt 0]
3938 set cmd [lindex $elt 1]
3939 if {$curview != $view} {
3940 showview $view
3942 eval $cmd
3945 proc goback {} {
3946 global history historyindex
3948 if {$historyindex > 1} {
3949 incr historyindex -1
3950 godo [lindex $history [expr {$historyindex - 1}]]
3951 .ctop.top.bar.rightbut conf -state normal
3953 if {$historyindex <= 1} {
3954 .ctop.top.bar.leftbut conf -state disabled
3958 proc goforw {} {
3959 global history historyindex
3961 if {$historyindex < [llength $history]} {
3962 set cmd [lindex $history $historyindex]
3963 incr historyindex
3964 godo $cmd
3965 .ctop.top.bar.leftbut conf -state normal
3967 if {$historyindex >= [llength $history]} {
3968 .ctop.top.bar.rightbut conf -state disabled
3972 proc gettree {id} {
3973 global treefilelist treeidlist diffids diffmergeid treepending
3975 set diffids $id
3976 catch {unset diffmergeid}
3977 if {![info exists treefilelist($id)]} {
3978 if {![info exists treepending]} {
3979 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3980 return
3982 set treepending $id
3983 set treefilelist($id) {}
3984 set treeidlist($id) {}
3985 fconfigure $gtf -blocking 0
3986 fileevent $gtf readable [list gettreeline $gtf $id]
3988 } else {
3989 setfilelist $id
3993 proc gettreeline {gtf id} {
3994 global treefilelist treeidlist treepending cmitmode diffids
3996 while {[gets $gtf line] >= 0} {
3997 if {[lindex $line 1] ne "blob"} continue
3998 set sha1 [lindex $line 2]
3999 set fname [lindex $line 3]
4000 lappend treefilelist($id) $fname
4001 lappend treeidlist($id) $sha1
4003 if {![eof $gtf]} return
4004 close $gtf
4005 unset treepending
4006 if {$cmitmode ne "tree"} {
4007 if {![info exists diffmergeid]} {
4008 gettreediffs $diffids
4010 } elseif {$id ne $diffids} {
4011 gettree $diffids
4012 } else {
4013 setfilelist $id
4017 proc showfile {f} {
4018 global treefilelist treeidlist diffids
4019 global ctext commentend
4021 set i [lsearch -exact $treefilelist($diffids) $f]
4022 if {$i < 0} {
4023 puts "oops, $f not in list for id $diffids"
4024 return
4026 set blob [lindex $treeidlist($diffids) $i]
4027 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4028 puts "oops, error reading blob $blob: $err"
4029 return
4031 fconfigure $bf -blocking 0
4032 fileevent $bf readable [list getblobline $bf $diffids]
4033 $ctext config -state normal
4034 clear_ctext $commentend
4035 $ctext insert end "\n"
4036 $ctext insert end "$f\n" filesep
4037 $ctext config -state disabled
4038 $ctext yview $commentend
4041 proc getblobline {bf id} {
4042 global diffids cmitmode ctext
4044 if {$id ne $diffids || $cmitmode ne "tree"} {
4045 catch {close $bf}
4046 return
4048 $ctext config -state normal
4049 while {[gets $bf line] >= 0} {
4050 $ctext insert end "$line\n"
4052 if {[eof $bf]} {
4053 # delete last newline
4054 $ctext delete "end - 2c" "end - 1c"
4055 close $bf
4057 $ctext config -state disabled
4060 proc mergediff {id l} {
4061 global diffmergeid diffopts mdifffd
4062 global diffids
4063 global parentlist
4065 set diffmergeid $id
4066 set diffids $id
4067 # this doesn't seem to actually affect anything...
4068 set env(GIT_DIFF_OPTS) $diffopts
4069 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4070 if {[catch {set mdf [open $cmd r]} err]} {
4071 error_popup "Error getting merge diffs: $err"
4072 return
4074 fconfigure $mdf -blocking 0
4075 set mdifffd($id) $mdf
4076 set np [llength [lindex $parentlist $l]]
4077 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4078 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4081 proc getmergediffline {mdf id np} {
4082 global diffmergeid ctext cflist nextupdate mergemax
4083 global difffilestart mdifffd
4085 set n [gets $mdf line]
4086 if {$n < 0} {
4087 if {[eof $mdf]} {
4088 close $mdf
4090 return
4092 if {![info exists diffmergeid] || $id != $diffmergeid
4093 || $mdf != $mdifffd($id)} {
4094 return
4096 $ctext conf -state normal
4097 if {[regexp {^diff --cc (.*)} $line match fname]} {
4098 # start of a new file
4099 $ctext insert end "\n"
4100 set here [$ctext index "end - 1c"]
4101 lappend difffilestart $here
4102 add_flist [list $fname]
4103 set l [expr {(78 - [string length $fname]) / 2}]
4104 set pad [string range "----------------------------------------" 1 $l]
4105 $ctext insert end "$pad $fname $pad\n" filesep
4106 } elseif {[regexp {^@@} $line]} {
4107 $ctext insert end "$line\n" hunksep
4108 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4109 # do nothing
4110 } else {
4111 # parse the prefix - one ' ', '-' or '+' for each parent
4112 set spaces {}
4113 set minuses {}
4114 set pluses {}
4115 set isbad 0
4116 for {set j 0} {$j < $np} {incr j} {
4117 set c [string range $line $j $j]
4118 if {$c == " "} {
4119 lappend spaces $j
4120 } elseif {$c == "-"} {
4121 lappend minuses $j
4122 } elseif {$c == "+"} {
4123 lappend pluses $j
4124 } else {
4125 set isbad 1
4126 break
4129 set tags {}
4130 set num {}
4131 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4132 # line doesn't appear in result, parents in $minuses have the line
4133 set num [lindex $minuses 0]
4134 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4135 # line appears in result, parents in $pluses don't have the line
4136 lappend tags mresult
4137 set num [lindex $spaces 0]
4139 if {$num ne {}} {
4140 if {$num >= $mergemax} {
4141 set num "max"
4143 lappend tags m$num
4145 $ctext insert end "$line\n" $tags
4147 $ctext conf -state disabled
4148 if {[clock clicks -milliseconds] >= $nextupdate} {
4149 incr nextupdate 100
4150 fileevent $mdf readable {}
4151 update
4152 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4156 proc startdiff {ids} {
4157 global treediffs diffids treepending diffmergeid
4159 set diffids $ids
4160 catch {unset diffmergeid}
4161 if {![info exists treediffs($ids)]} {
4162 if {![info exists treepending]} {
4163 gettreediffs $ids
4165 } else {
4166 addtocflist $ids
4170 proc addtocflist {ids} {
4171 global treediffs cflist
4172 add_flist $treediffs($ids)
4173 getblobdiffs $ids
4176 proc gettreediffs {ids} {
4177 global treediff treepending
4178 set treepending $ids
4179 set treediff {}
4180 if {[catch \
4181 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4182 ]} return
4183 fconfigure $gdtf -blocking 0
4184 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4187 proc gettreediffline {gdtf ids} {
4188 global treediff treediffs treepending diffids diffmergeid
4189 global cmitmode
4191 set n [gets $gdtf line]
4192 if {$n < 0} {
4193 if {![eof $gdtf]} return
4194 close $gdtf
4195 set treediffs($ids) $treediff
4196 unset treepending
4197 if {$cmitmode eq "tree"} {
4198 gettree $diffids
4199 } elseif {$ids != $diffids} {
4200 if {![info exists diffmergeid]} {
4201 gettreediffs $diffids
4203 } else {
4204 addtocflist $ids
4206 return
4208 set file [lindex $line 5]
4209 lappend treediff $file
4212 proc getblobdiffs {ids} {
4213 global diffopts blobdifffd diffids env curdifftag curtagstart
4214 global nextupdate diffinhdr treediffs
4216 set env(GIT_DIFF_OPTS) $diffopts
4217 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4218 if {[catch {set bdf [open $cmd r]} err]} {
4219 puts "error getting diffs: $err"
4220 return
4222 set diffinhdr 0
4223 fconfigure $bdf -blocking 0
4224 set blobdifffd($ids) $bdf
4225 set curdifftag Comments
4226 set curtagstart 0.0
4227 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4228 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4231 proc setinlist {var i val} {
4232 global $var
4234 while {[llength [set $var]] < $i} {
4235 lappend $var {}
4237 if {[llength [set $var]] == $i} {
4238 lappend $var $val
4239 } else {
4240 lset $var $i $val
4244 proc getblobdiffline {bdf ids} {
4245 global diffids blobdifffd ctext curdifftag curtagstart
4246 global diffnexthead diffnextnote difffilestart
4247 global nextupdate diffinhdr treediffs
4249 set n [gets $bdf line]
4250 if {$n < 0} {
4251 if {[eof $bdf]} {
4252 close $bdf
4253 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4254 $ctext tag add $curdifftag $curtagstart end
4257 return
4259 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4260 return
4262 $ctext conf -state normal
4263 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4264 # start of a new file
4265 $ctext insert end "\n"
4266 $ctext tag add $curdifftag $curtagstart end
4267 set here [$ctext index "end - 1c"]
4268 set curtagstart $here
4269 set header $newname
4270 set i [lsearch -exact $treediffs($ids) $fname]
4271 if {$i >= 0} {
4272 setinlist difffilestart $i $here
4274 if {$newname ne $fname} {
4275 set i [lsearch -exact $treediffs($ids) $newname]
4276 if {$i >= 0} {
4277 setinlist difffilestart $i $here
4280 set curdifftag "f:$fname"
4281 $ctext tag delete $curdifftag
4282 set l [expr {(78 - [string length $header]) / 2}]
4283 set pad [string range "----------------------------------------" 1 $l]
4284 $ctext insert end "$pad $header $pad\n" filesep
4285 set diffinhdr 1
4286 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4287 # do nothing
4288 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4289 set diffinhdr 0
4290 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4291 $line match f1l f1c f2l f2c rest]} {
4292 $ctext insert end "$line\n" hunksep
4293 set diffinhdr 0
4294 } else {
4295 set x [string range $line 0 0]
4296 if {$x == "-" || $x == "+"} {
4297 set tag [expr {$x == "+"}]
4298 $ctext insert end "$line\n" d$tag
4299 } elseif {$x == " "} {
4300 $ctext insert end "$line\n"
4301 } elseif {$diffinhdr || $x == "\\"} {
4302 # e.g. "\ No newline at end of file"
4303 $ctext insert end "$line\n" filesep
4304 } else {
4305 # Something else we don't recognize
4306 if {$curdifftag != "Comments"} {
4307 $ctext insert end "\n"
4308 $ctext tag add $curdifftag $curtagstart end
4309 set curtagstart [$ctext index "end - 1c"]
4310 set curdifftag Comments
4312 $ctext insert end "$line\n" filesep
4315 $ctext conf -state disabled
4316 if {[clock clicks -milliseconds] >= $nextupdate} {
4317 incr nextupdate 100
4318 fileevent $bdf readable {}
4319 update
4320 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4324 proc nextfile {} {
4325 global difffilestart ctext
4326 set here [$ctext index @0,0]
4327 foreach loc $difffilestart {
4328 if {[$ctext compare $loc > $here]} {
4329 $ctext yview $loc
4334 proc clear_ctext {{first 1.0}} {
4335 global ctext smarktop smarkbot
4337 set l [lindex [split $first .] 0]
4338 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4339 set smarktop $l
4341 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4342 set smarkbot $l
4344 $ctext delete $first end
4347 proc incrsearch {name ix op} {
4348 global ctext searchstring searchdirn
4350 $ctext tag remove found 1.0 end
4351 if {[catch {$ctext index anchor}]} {
4352 # no anchor set, use start of selection, or of visible area
4353 set sel [$ctext tag ranges sel]
4354 if {$sel ne {}} {
4355 $ctext mark set anchor [lindex $sel 0]
4356 } elseif {$searchdirn eq "-forwards"} {
4357 $ctext mark set anchor @0,0
4358 } else {
4359 $ctext mark set anchor @0,[winfo height $ctext]
4362 if {$searchstring ne {}} {
4363 set here [$ctext search $searchdirn -- $searchstring anchor]
4364 if {$here ne {}} {
4365 $ctext see $here
4367 searchmarkvisible 1
4371 proc dosearch {} {
4372 global sstring ctext searchstring searchdirn
4374 focus $sstring
4375 $sstring icursor end
4376 set searchdirn -forwards
4377 if {$searchstring ne {}} {
4378 set sel [$ctext tag ranges sel]
4379 if {$sel ne {}} {
4380 set start "[lindex $sel 0] + 1c"
4381 } elseif {[catch {set start [$ctext index anchor]}]} {
4382 set start "@0,0"
4384 set match [$ctext search -count mlen -- $searchstring $start]
4385 $ctext tag remove sel 1.0 end
4386 if {$match eq {}} {
4387 bell
4388 return
4390 $ctext see $match
4391 set mend "$match + $mlen c"
4392 $ctext tag add sel $match $mend
4393 $ctext mark unset anchor
4397 proc dosearchback {} {
4398 global sstring ctext searchstring searchdirn
4400 focus $sstring
4401 $sstring icursor end
4402 set searchdirn -backwards
4403 if {$searchstring ne {}} {
4404 set sel [$ctext tag ranges sel]
4405 if {$sel ne {}} {
4406 set start [lindex $sel 0]
4407 } elseif {[catch {set start [$ctext index anchor]}]} {
4408 set start @0,[winfo height $ctext]
4410 set match [$ctext search -backwards -count ml -- $searchstring $start]
4411 $ctext tag remove sel 1.0 end
4412 if {$match eq {}} {
4413 bell
4414 return
4416 $ctext see $match
4417 set mend "$match + $ml c"
4418 $ctext tag add sel $match $mend
4419 $ctext mark unset anchor
4423 proc searchmark {first last} {
4424 global ctext searchstring
4426 set mend $first.0
4427 while {1} {
4428 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4429 if {$match eq {}} break
4430 set mend "$match + $mlen c"
4431 $ctext tag add found $match $mend
4435 proc searchmarkvisible {doall} {
4436 global ctext smarktop smarkbot
4438 set topline [lindex [split [$ctext index @0,0] .] 0]
4439 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4440 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4441 # no overlap with previous
4442 searchmark $topline $botline
4443 set smarktop $topline
4444 set smarkbot $botline
4445 } else {
4446 if {$topline < $smarktop} {
4447 searchmark $topline [expr {$smarktop-1}]
4448 set smarktop $topline
4450 if {$botline > $smarkbot} {
4451 searchmark [expr {$smarkbot+1}] $botline
4452 set smarkbot $botline
4457 proc scrolltext {f0 f1} {
4458 global searchstring
4460 .ctop.cdet.left.sb set $f0 $f1
4461 if {$searchstring ne {}} {
4462 searchmarkvisible 0
4466 proc setcoords {} {
4467 global linespc charspc canvx0 canvy0 mainfont
4468 global xspc1 xspc2 lthickness
4470 set linespc [font metrics $mainfont -linespace]
4471 set charspc [font measure $mainfont "m"]
4472 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4473 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4474 set lthickness [expr {int($linespc / 9) + 1}]
4475 set xspc1(0) $linespc
4476 set xspc2 $linespc
4479 proc redisplay {} {
4480 global canv
4481 global selectedline
4483 set ymax [lindex [$canv cget -scrollregion] 3]
4484 if {$ymax eq {} || $ymax == 0} return
4485 set span [$canv yview]
4486 clear_display
4487 setcanvscroll
4488 allcanvs yview moveto [lindex $span 0]
4489 drawvisible
4490 if {[info exists selectedline]} {
4491 selectline $selectedline 0
4495 proc incrfont {inc} {
4496 global mainfont textfont ctext canv phase
4497 global stopped entries
4498 unmarkmatches
4499 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4500 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4501 setcoords
4502 $ctext conf -font $textfont
4503 $ctext tag conf filesep -font [concat $textfont bold]
4504 foreach e $entries {
4505 $e conf -font $mainfont
4507 if {$phase eq "getcommits"} {
4508 $canv itemconf textitems -font $mainfont
4510 redisplay
4513 proc clearsha1 {} {
4514 global sha1entry sha1string
4515 if {[string length $sha1string] == 40} {
4516 $sha1entry delete 0 end
4520 proc sha1change {n1 n2 op} {
4521 global sha1string currentid sha1but
4522 if {$sha1string == {}
4523 || ([info exists currentid] && $sha1string == $currentid)} {
4524 set state disabled
4525 } else {
4526 set state normal
4528 if {[$sha1but cget -state] == $state} return
4529 if {$state == "normal"} {
4530 $sha1but conf -state normal -relief raised -text "Goto: "
4531 } else {
4532 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4536 proc gotocommit {} {
4537 global sha1string currentid commitrow tagids headids
4538 global displayorder numcommits curview
4540 if {$sha1string == {}
4541 || ([info exists currentid] && $sha1string == $currentid)} return
4542 if {[info exists tagids($sha1string)]} {
4543 set id $tagids($sha1string)
4544 } elseif {[info exists headids($sha1string)]} {
4545 set id $headids($sha1string)
4546 } else {
4547 set id [string tolower $sha1string]
4548 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4549 set matches {}
4550 foreach i $displayorder {
4551 if {[string match $id* $i]} {
4552 lappend matches $i
4555 if {$matches ne {}} {
4556 if {[llength $matches] > 1} {
4557 error_popup "Short SHA1 id $id is ambiguous"
4558 return
4560 set id [lindex $matches 0]
4564 if {[info exists commitrow($curview,$id)]} {
4565 selectline $commitrow($curview,$id) 1
4566 return
4568 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4569 set type "SHA1 id"
4570 } else {
4571 set type "Tag/Head"
4573 error_popup "$type $sha1string is not known"
4576 proc lineenter {x y id} {
4577 global hoverx hovery hoverid hovertimer
4578 global commitinfo canv
4580 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4581 set hoverx $x
4582 set hovery $y
4583 set hoverid $id
4584 if {[info exists hovertimer]} {
4585 after cancel $hovertimer
4587 set hovertimer [after 500 linehover]
4588 $canv delete hover
4591 proc linemotion {x y id} {
4592 global hoverx hovery hoverid hovertimer
4594 if {[info exists hoverid] && $id == $hoverid} {
4595 set hoverx $x
4596 set hovery $y
4597 if {[info exists hovertimer]} {
4598 after cancel $hovertimer
4600 set hovertimer [after 500 linehover]
4604 proc lineleave {id} {
4605 global hoverid hovertimer canv
4607 if {[info exists hoverid] && $id == $hoverid} {
4608 $canv delete hover
4609 if {[info exists hovertimer]} {
4610 after cancel $hovertimer
4611 unset hovertimer
4613 unset hoverid
4617 proc linehover {} {
4618 global hoverx hovery hoverid hovertimer
4619 global canv linespc lthickness
4620 global commitinfo mainfont
4622 set text [lindex $commitinfo($hoverid) 0]
4623 set ymax [lindex [$canv cget -scrollregion] 3]
4624 if {$ymax == {}} return
4625 set yfrac [lindex [$canv yview] 0]
4626 set x [expr {$hoverx + 2 * $linespc}]
4627 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4628 set x0 [expr {$x - 2 * $lthickness}]
4629 set y0 [expr {$y - 2 * $lthickness}]
4630 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4631 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4632 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4633 -fill \#ffff80 -outline black -width 1 -tags hover]
4634 $canv raise $t
4635 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4636 -font $mainfont]
4637 $canv raise $t
4640 proc clickisonarrow {id y} {
4641 global lthickness
4643 set ranges [rowranges $id]
4644 set thresh [expr {2 * $lthickness + 6}]
4645 set n [expr {[llength $ranges] - 1}]
4646 for {set i 1} {$i < $n} {incr i} {
4647 set row [lindex $ranges $i]
4648 if {abs([yc $row] - $y) < $thresh} {
4649 return $i
4652 return {}
4655 proc arrowjump {id n y} {
4656 global canv
4658 # 1 <-> 2, 3 <-> 4, etc...
4659 set n [expr {(($n - 1) ^ 1) + 1}]
4660 set row [lindex [rowranges $id] $n]
4661 set yt [yc $row]
4662 set ymax [lindex [$canv cget -scrollregion] 3]
4663 if {$ymax eq {} || $ymax <= 0} return
4664 set view [$canv yview]
4665 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4666 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4667 if {$yfrac < 0} {
4668 set yfrac 0
4670 allcanvs yview moveto $yfrac
4673 proc lineclick {x y id isnew} {
4674 global ctext commitinfo children canv thickerline curview
4676 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4677 unmarkmatches
4678 unselectline
4679 normalline
4680 $canv delete hover
4681 # draw this line thicker than normal
4682 set thickerline $id
4683 drawlines $id
4684 if {$isnew} {
4685 set ymax [lindex [$canv cget -scrollregion] 3]
4686 if {$ymax eq {}} return
4687 set yfrac [lindex [$canv yview] 0]
4688 set y [expr {$y + $yfrac * $ymax}]
4690 set dirn [clickisonarrow $id $y]
4691 if {$dirn ne {}} {
4692 arrowjump $id $dirn $y
4693 return
4696 if {$isnew} {
4697 addtohistory [list lineclick $x $y $id 0]
4699 # fill the details pane with info about this line
4700 $ctext conf -state normal
4701 clear_ctext
4702 $ctext tag conf link -foreground blue -underline 1
4703 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4704 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4705 $ctext insert end "Parent:\t"
4706 $ctext insert end $id [list link link0]
4707 $ctext tag bind link0 <1> [list selbyid $id]
4708 set info $commitinfo($id)
4709 $ctext insert end "\n\t[lindex $info 0]\n"
4710 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4711 set date [formatdate [lindex $info 2]]
4712 $ctext insert end "\tDate:\t$date\n"
4713 set kids $children($curview,$id)
4714 if {$kids ne {}} {
4715 $ctext insert end "\nChildren:"
4716 set i 0
4717 foreach child $kids {
4718 incr i
4719 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4720 set info $commitinfo($child)
4721 $ctext insert end "\n\t"
4722 $ctext insert end $child [list link link$i]
4723 $ctext tag bind link$i <1> [list selbyid $child]
4724 $ctext insert end "\n\t[lindex $info 0]"
4725 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4726 set date [formatdate [lindex $info 2]]
4727 $ctext insert end "\n\tDate:\t$date\n"
4730 $ctext conf -state disabled
4731 init_flist {}
4734 proc normalline {} {
4735 global thickerline
4736 if {[info exists thickerline]} {
4737 set id $thickerline
4738 unset thickerline
4739 drawlines $id
4743 proc selbyid {id} {
4744 global commitrow curview
4745 if {[info exists commitrow($curview,$id)]} {
4746 selectline $commitrow($curview,$id) 1
4750 proc mstime {} {
4751 global startmstime
4752 if {![info exists startmstime]} {
4753 set startmstime [clock clicks -milliseconds]
4755 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4758 proc rowmenu {x y id} {
4759 global rowctxmenu commitrow selectedline rowmenuid curview
4761 if {![info exists selectedline]
4762 || $commitrow($curview,$id) eq $selectedline} {
4763 set state disabled
4764 } else {
4765 set state normal
4767 $rowctxmenu entryconfigure 0 -state $state
4768 $rowctxmenu entryconfigure 1 -state $state
4769 $rowctxmenu entryconfigure 2 -state $state
4770 set rowmenuid $id
4771 tk_popup $rowctxmenu $x $y
4774 proc diffvssel {dirn} {
4775 global rowmenuid selectedline displayorder
4777 if {![info exists selectedline]} return
4778 if {$dirn} {
4779 set oldid [lindex $displayorder $selectedline]
4780 set newid $rowmenuid
4781 } else {
4782 set oldid $rowmenuid
4783 set newid [lindex $displayorder $selectedline]
4785 addtohistory [list doseldiff $oldid $newid]
4786 doseldiff $oldid $newid
4789 proc doseldiff {oldid newid} {
4790 global ctext
4791 global commitinfo
4793 $ctext conf -state normal
4794 clear_ctext
4795 init_flist "Top"
4796 $ctext insert end "From "
4797 $ctext tag conf link -foreground blue -underline 1
4798 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4799 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4800 $ctext tag bind link0 <1> [list selbyid $oldid]
4801 $ctext insert end $oldid [list link link0]
4802 $ctext insert end "\n "
4803 $ctext insert end [lindex $commitinfo($oldid) 0]
4804 $ctext insert end "\n\nTo "
4805 $ctext tag bind link1 <1> [list selbyid $newid]
4806 $ctext insert end $newid [list link link1]
4807 $ctext insert end "\n "
4808 $ctext insert end [lindex $commitinfo($newid) 0]
4809 $ctext insert end "\n"
4810 $ctext conf -state disabled
4811 $ctext tag delete Comments
4812 $ctext tag remove found 1.0 end
4813 startdiff [list $oldid $newid]
4816 proc mkpatch {} {
4817 global rowmenuid currentid commitinfo patchtop patchnum
4819 if {![info exists currentid]} return
4820 set oldid $currentid
4821 set oldhead [lindex $commitinfo($oldid) 0]
4822 set newid $rowmenuid
4823 set newhead [lindex $commitinfo($newid) 0]
4824 set top .patch
4825 set patchtop $top
4826 catch {destroy $top}
4827 toplevel $top
4828 label $top.title -text "Generate patch"
4829 grid $top.title - -pady 10
4830 label $top.from -text "From:"
4831 entry $top.fromsha1 -width 40 -relief flat
4832 $top.fromsha1 insert 0 $oldid
4833 $top.fromsha1 conf -state readonly
4834 grid $top.from $top.fromsha1 -sticky w
4835 entry $top.fromhead -width 60 -relief flat
4836 $top.fromhead insert 0 $oldhead
4837 $top.fromhead conf -state readonly
4838 grid x $top.fromhead -sticky w
4839 label $top.to -text "To:"
4840 entry $top.tosha1 -width 40 -relief flat
4841 $top.tosha1 insert 0 $newid
4842 $top.tosha1 conf -state readonly
4843 grid $top.to $top.tosha1 -sticky w
4844 entry $top.tohead -width 60 -relief flat
4845 $top.tohead insert 0 $newhead
4846 $top.tohead conf -state readonly
4847 grid x $top.tohead -sticky w
4848 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4849 grid $top.rev x -pady 10
4850 label $top.flab -text "Output file:"
4851 entry $top.fname -width 60
4852 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4853 incr patchnum
4854 grid $top.flab $top.fname -sticky w
4855 frame $top.buts
4856 button $top.buts.gen -text "Generate" -command mkpatchgo
4857 button $top.buts.can -text "Cancel" -command mkpatchcan
4858 grid $top.buts.gen $top.buts.can
4859 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4860 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4861 grid $top.buts - -pady 10 -sticky ew
4862 focus $top.fname
4865 proc mkpatchrev {} {
4866 global patchtop
4868 set oldid [$patchtop.fromsha1 get]
4869 set oldhead [$patchtop.fromhead get]
4870 set newid [$patchtop.tosha1 get]
4871 set newhead [$patchtop.tohead get]
4872 foreach e [list fromsha1 fromhead tosha1 tohead] \
4873 v [list $newid $newhead $oldid $oldhead] {
4874 $patchtop.$e conf -state normal
4875 $patchtop.$e delete 0 end
4876 $patchtop.$e insert 0 $v
4877 $patchtop.$e conf -state readonly
4881 proc mkpatchgo {} {
4882 global patchtop
4884 set oldid [$patchtop.fromsha1 get]
4885 set newid [$patchtop.tosha1 get]
4886 set fname [$patchtop.fname get]
4887 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4888 error_popup "Error creating patch: $err"
4890 catch {destroy $patchtop}
4891 unset patchtop
4894 proc mkpatchcan {} {
4895 global patchtop
4897 catch {destroy $patchtop}
4898 unset patchtop
4901 proc mktag {} {
4902 global rowmenuid mktagtop commitinfo
4904 set top .maketag
4905 set mktagtop $top
4906 catch {destroy $top}
4907 toplevel $top
4908 label $top.title -text "Create tag"
4909 grid $top.title - -pady 10
4910 label $top.id -text "ID:"
4911 entry $top.sha1 -width 40 -relief flat
4912 $top.sha1 insert 0 $rowmenuid
4913 $top.sha1 conf -state readonly
4914 grid $top.id $top.sha1 -sticky w
4915 entry $top.head -width 60 -relief flat
4916 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4917 $top.head conf -state readonly
4918 grid x $top.head -sticky w
4919 label $top.tlab -text "Tag name:"
4920 entry $top.tag -width 60
4921 grid $top.tlab $top.tag -sticky w
4922 frame $top.buts
4923 button $top.buts.gen -text "Create" -command mktaggo
4924 button $top.buts.can -text "Cancel" -command mktagcan
4925 grid $top.buts.gen $top.buts.can
4926 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4927 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4928 grid $top.buts - -pady 10 -sticky ew
4929 focus $top.tag
4932 proc domktag {} {
4933 global mktagtop env tagids idtags
4935 set id [$mktagtop.sha1 get]
4936 set tag [$mktagtop.tag get]
4937 if {$tag == {}} {
4938 error_popup "No tag name specified"
4939 return
4941 if {[info exists tagids($tag)]} {
4942 error_popup "Tag \"$tag\" already exists"
4943 return
4945 if {[catch {
4946 set dir [gitdir]
4947 set fname [file join $dir "refs/tags" $tag]
4948 set f [open $fname w]
4949 puts $f $id
4950 close $f
4951 } err]} {
4952 error_popup "Error creating tag: $err"
4953 return
4956 set tagids($tag) $id
4957 lappend idtags($id) $tag
4958 redrawtags $id
4961 proc redrawtags {id} {
4962 global canv linehtag commitrow idpos selectedline curview
4963 global mainfont canvxmax
4965 if {![info exists commitrow($curview,$id)]} return
4966 drawcmitrow $commitrow($curview,$id)
4967 $canv delete tag.$id
4968 set xt [eval drawtags $id $idpos($id)]
4969 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4970 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4971 set xr [expr {$xt + [font measure $mainfont $text]}]
4972 if {$xr > $canvxmax} {
4973 set canvxmax $xr
4974 setcanvscroll
4976 if {[info exists selectedline]
4977 && $selectedline == $commitrow($curview,$id)} {
4978 selectline $selectedline 0
4982 proc mktagcan {} {
4983 global mktagtop
4985 catch {destroy $mktagtop}
4986 unset mktagtop
4989 proc mktaggo {} {
4990 domktag
4991 mktagcan
4994 proc writecommit {} {
4995 global rowmenuid wrcomtop commitinfo wrcomcmd
4997 set top .writecommit
4998 set wrcomtop $top
4999 catch {destroy $top}
5000 toplevel $top
5001 label $top.title -text "Write commit to file"
5002 grid $top.title - -pady 10
5003 label $top.id -text "ID:"
5004 entry $top.sha1 -width 40 -relief flat
5005 $top.sha1 insert 0 $rowmenuid
5006 $top.sha1 conf -state readonly
5007 grid $top.id $top.sha1 -sticky w
5008 entry $top.head -width 60 -relief flat
5009 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5010 $top.head conf -state readonly
5011 grid x $top.head -sticky w
5012 label $top.clab -text "Command:"
5013 entry $top.cmd -width 60 -textvariable wrcomcmd
5014 grid $top.clab $top.cmd -sticky w -pady 10
5015 label $top.flab -text "Output file:"
5016 entry $top.fname -width 60
5017 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5018 grid $top.flab $top.fname -sticky w
5019 frame $top.buts
5020 button $top.buts.gen -text "Write" -command wrcomgo
5021 button $top.buts.can -text "Cancel" -command wrcomcan
5022 grid $top.buts.gen $top.buts.can
5023 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5024 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5025 grid $top.buts - -pady 10 -sticky ew
5026 focus $top.fname
5029 proc wrcomgo {} {
5030 global wrcomtop
5032 set id [$wrcomtop.sha1 get]
5033 set cmd "echo $id | [$wrcomtop.cmd get]"
5034 set fname [$wrcomtop.fname get]
5035 if {[catch {exec sh -c $cmd >$fname &} err]} {
5036 error_popup "Error writing commit: $err"
5038 catch {destroy $wrcomtop}
5039 unset wrcomtop
5042 proc wrcomcan {} {
5043 global wrcomtop
5045 catch {destroy $wrcomtop}
5046 unset wrcomtop
5049 proc mkbranch {} {
5050 global rowmenuid mkbrtop
5052 set top .makebranch
5053 catch {destroy $top}
5054 toplevel $top
5055 label $top.title -text "Create new branch"
5056 grid $top.title - -pady 10
5057 label $top.id -text "ID:"
5058 entry $top.sha1 -width 40 -relief flat
5059 $top.sha1 insert 0 $rowmenuid
5060 $top.sha1 conf -state readonly
5061 grid $top.id $top.sha1 -sticky w
5062 label $top.nlab -text "Name:"
5063 entry $top.name -width 40
5064 grid $top.nlab $top.name -sticky w
5065 frame $top.buts
5066 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5067 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5068 grid $top.buts.go $top.buts.can
5069 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5070 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5071 grid $top.buts - -pady 10 -sticky ew
5072 focus $top.name
5075 proc mkbrgo {top} {
5076 global headids idheads
5078 set name [$top.name get]
5079 set id [$top.sha1 get]
5080 if {$name eq {}} {
5081 error_popup "Please specify a name for the new branch"
5082 return
5084 catch {destroy $top}
5085 nowbusy newbranch
5086 update
5087 if {[catch {
5088 exec git branch $name $id
5089 } err]} {
5090 notbusy newbranch
5091 error_popup $err
5092 } else {
5093 set headids($name) $id
5094 if {![info exists idheads($id)]} {
5095 addedhead $id
5097 lappend idheads($id) $name
5098 # XXX should update list of heads displayed for selected commit
5099 notbusy newbranch
5100 redrawtags $id
5104 # context menu for a head
5105 proc headmenu {x y id head} {
5106 global headmenuid headmenuhead headctxmenu
5108 set headmenuid $id
5109 set headmenuhead $head
5110 tk_popup $headctxmenu $x $y
5113 proc cobranch {} {
5114 global headmenuid headmenuhead mainhead headids
5116 # check the tree is clean first??
5117 set oldmainhead $mainhead
5118 nowbusy checkout
5119 update
5120 if {[catch {
5121 exec git checkout $headmenuhead
5122 } err]} {
5123 notbusy checkout
5124 error_popup $err
5125 } else {
5126 notbusy checkout
5127 set mainhead $headmenuhead
5128 if {[info exists headids($oldmainhead)]} {
5129 redrawtags $headids($oldmainhead)
5131 redrawtags $headmenuid
5135 proc rmbranch {} {
5136 global desc_heads headmenuid headmenuhead mainhead
5137 global headids idheads
5139 set head $headmenuhead
5140 set id $headmenuid
5141 if {$head eq $mainhead} {
5142 error_popup "Cannot delete the currently checked-out branch"
5143 return
5145 if {$desc_heads($id) eq $id && $idheads($id) eq [list $head]} {
5146 # the stuff on this branch isn't on any other branch
5147 if {![confirm_popup "The commits on branch $head aren't on any other\
5148 branch.\nReally delete branch $head?"]} return
5150 nowbusy rmbranch
5151 update
5152 if {[catch {exec git branch -D $head} err]} {
5153 notbusy rmbranch
5154 error_popup $err
5155 return
5157 unset headids($head)
5158 if {$idheads($id) eq $head} {
5159 unset idheads($id)
5160 removedhead $id
5161 } else {
5162 set i [lsearch -exact $idheads($id) $head]
5163 if {$i >= 0} {
5164 set idheads($id) [lreplace $idheads($id) $i $i]
5167 redrawtags $id
5168 notbusy rmbranch
5171 # Stuff for finding nearby tags
5172 proc getallcommits {} {
5173 global allcstart allcommits allcfd allids
5175 set allids {}
5176 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5177 set allcfd $fd
5178 fconfigure $fd -blocking 0
5179 set allcommits "reading"
5180 nowbusy allcommits
5181 restartgetall $fd
5184 proc discardallcommits {} {
5185 global allparents allchildren allcommits allcfd
5186 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5188 if {![info exists allcommits]} return
5189 if {$allcommits eq "reading"} {
5190 catch {close $allcfd}
5192 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5193 alldtags tagisdesc desc_heads} {
5194 catch {unset $v}
5198 proc restartgetall {fd} {
5199 global allcstart
5201 fileevent $fd readable [list getallclines $fd]
5202 set allcstart [clock clicks -milliseconds]
5205 proc combine_dtags {l1 l2} {
5206 global tagisdesc notfirstd
5208 set res [lsort -unique [concat $l1 $l2]]
5209 for {set i 0} {$i < [llength $res]} {incr i} {
5210 set x [lindex $res $i]
5211 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5212 set y [lindex $res $j]
5213 if {[info exists tagisdesc($x,$y)]} {
5214 if {$tagisdesc($x,$y) > 0} {
5215 # x is a descendent of y, exclude x
5216 set res [lreplace $res $i $i]
5217 incr i -1
5218 break
5219 } else {
5220 # y is a descendent of x, exclude y
5221 set res [lreplace $res $j $j]
5223 } else {
5224 # no relation, keep going
5225 incr j
5229 return $res
5232 proc combine_atags {l1 l2} {
5233 global tagisdesc
5235 set res [lsort -unique [concat $l1 $l2]]
5236 for {set i 0} {$i < [llength $res]} {incr i} {
5237 set x [lindex $res $i]
5238 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5239 set y [lindex $res $j]
5240 if {[info exists tagisdesc($x,$y)]} {
5241 if {$tagisdesc($x,$y) < 0} {
5242 # x is an ancestor of y, exclude x
5243 set res [lreplace $res $i $i]
5244 incr i -1
5245 break
5246 } else {
5247 # y is an ancestor of x, exclude y
5248 set res [lreplace $res $j $j]
5250 } else {
5251 # no relation, keep going
5252 incr j
5256 return $res
5259 proc forward_pass {id children} {
5260 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5262 set dtags {}
5263 set dheads {}
5264 foreach child $children {
5265 if {[info exists idtags($child)]} {
5266 set ctags [list $child]
5267 } else {
5268 set ctags $desc_tags($child)
5270 if {$dtags eq {}} {
5271 set dtags $ctags
5272 } elseif {$ctags ne $dtags} {
5273 set dtags [combine_dtags $dtags $ctags]
5275 set cheads $desc_heads($child)
5276 if {$dheads eq {}} {
5277 set dheads $cheads
5278 } elseif {$cheads ne $dheads} {
5279 set dheads [lsort -unique [concat $dheads $cheads]]
5282 set desc_tags($id) $dtags
5283 if {[info exists idtags($id)]} {
5284 set adt $dtags
5285 foreach tag $dtags {
5286 set adt [concat $adt $alldtags($tag)]
5288 set adt [lsort -unique $adt]
5289 set alldtags($id) $adt
5290 foreach tag $adt {
5291 set tagisdesc($id,$tag) -1
5292 set tagisdesc($tag,$id) 1
5295 if {[info exists idheads($id)]} {
5296 lappend dheads $id
5298 set desc_heads($id) $dheads
5301 proc getallclines {fd} {
5302 global allparents allchildren allcommits allcstart
5303 global desc_tags anc_tags idtags tagisdesc allids
5304 global desc_heads idheads travindex
5306 while {[gets $fd line] >= 0} {
5307 set id [lindex $line 0]
5308 lappend allids $id
5309 set olds [lrange $line 1 end]
5310 set allparents($id) $olds
5311 if {![info exists allchildren($id)]} {
5312 set allchildren($id) {}
5314 foreach p $olds {
5315 lappend allchildren($p) $id
5317 # compute nearest tagged descendents as we go
5318 # also compute descendent heads
5319 forward_pass $id $allchildren($id)
5320 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5321 fileevent $fd readable {}
5322 after idle restartgetall $fd
5323 return
5326 if {[eof $fd]} {
5327 set travindex [llength $allids]
5328 set allcommits "traversing"
5329 after idle restartatags
5330 if {[catch {close $fd} err]} {
5331 error_popup "Error reading full commit graph: $err.\n\
5332 Results may be incomplete."
5337 # walk backward through the tree and compute nearest tagged ancestors
5338 proc restartatags {} {
5339 global allids allparents idtags anc_tags travindex
5341 set t0 [clock clicks -milliseconds]
5342 set i $travindex
5343 while {[incr i -1] >= 0} {
5344 set id [lindex $allids $i]
5345 set atags {}
5346 foreach p $allparents($id) {
5347 if {[info exists idtags($p)]} {
5348 set ptags [list $p]
5349 } else {
5350 set ptags $anc_tags($p)
5352 if {$atags eq {}} {
5353 set atags $ptags
5354 } elseif {$ptags ne $atags} {
5355 set atags [combine_atags $atags $ptags]
5358 set anc_tags($id) $atags
5359 if {[clock clicks -milliseconds] - $t0 >= 50} {
5360 set travindex $i
5361 after idle restartatags
5362 return
5365 set allcommits "done"
5366 set travindex 0
5367 notbusy allcommits
5368 dispneartags
5371 # update the desc_heads array for a new head just added
5372 proc addedhead {hid} {
5373 global desc_heads allparents
5375 set todo [list $hid]
5376 while {$todo ne {}} {
5377 set do [lindex $todo 0]
5378 set todo [lrange $todo 1 end]
5379 if {![info exists desc_heads($do)] ||
5380 [lsearch -exact $desc_heads($do) $hid] >= 0} continue
5381 set oldheads $desc_heads($do)
5382 lappend desc_heads($do) $hid
5383 set heads $desc_heads($do)
5384 while {1} {
5385 set p $allparents($do)
5386 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5387 $desc_heads($p) ne $oldheads} break
5388 set do $p
5389 set desc_heads($do) $heads
5391 set todo [concat $todo $p]
5395 # update the desc_heads array for a head just removed
5396 proc removedhead {hid} {
5397 global desc_heads allparents
5399 set todo [list $hid]
5400 while {$todo ne {}} {
5401 set do [lindex $todo 0]
5402 set todo [lrange $todo 1 end]
5403 if {![info exists desc_heads($do)]} continue
5404 set i [lsearch -exact $desc_heads($do) $hid]
5405 if {$i < 0} continue
5406 set oldheads $desc_heads($do)
5407 set heads [lreplace $desc_heads($do) $i $i]
5408 while {1} {
5409 set desc_heads($do) $heads
5410 set p $allparents($do)
5411 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5412 $desc_heads($p) ne $oldheads} break
5413 set do $p
5415 set todo [concat $todo $p]
5419 proc changedrefs {} {
5420 global desc_heads desc_tags anc_tags allcommits allids
5421 global allchildren allparents idtags travindex
5423 if {![info exists allcommits]} return
5424 catch {unset desc_heads}
5425 catch {unset desc_tags}
5426 catch {unset anc_tags}
5427 catch {unset alldtags}
5428 catch {unset tagisdesc}
5429 foreach id $allids {
5430 forward_pass $id $allchildren($id)
5432 if {$allcommits ne "reading"} {
5433 set travindex [llength $allids]
5434 if {$allcommits ne "traversing"} {
5435 set allcommits "traversing"
5436 after idle restartatags
5441 proc rereadrefs {} {
5442 global idtags idheads idotherrefs mainhead
5444 set refids [concat [array names idtags] \
5445 [array names idheads] [array names idotherrefs]]
5446 foreach id $refids {
5447 if {![info exists ref($id)]} {
5448 set ref($id) [listrefs $id]
5451 set oldmainhead $mainhead
5452 readrefs
5453 changedrefs
5454 set refids [lsort -unique [concat $refids [array names idtags] \
5455 [array names idheads] [array names idotherrefs]]]
5456 foreach id $refids {
5457 set v [listrefs $id]
5458 if {![info exists ref($id)] || $ref($id) != $v ||
5459 ($id eq $oldmainhead && $id ne $mainhead) ||
5460 ($id eq $mainhead && $id ne $oldmainhead)} {
5461 redrawtags $id
5466 proc listrefs {id} {
5467 global idtags idheads idotherrefs
5469 set x {}
5470 if {[info exists idtags($id)]} {
5471 set x $idtags($id)
5473 set y {}
5474 if {[info exists idheads($id)]} {
5475 set y $idheads($id)
5477 set z {}
5478 if {[info exists idotherrefs($id)]} {
5479 set z $idotherrefs($id)
5481 return [list $x $y $z]
5484 proc showtag {tag isnew} {
5485 global ctext tagcontents tagids linknum
5487 if {$isnew} {
5488 addtohistory [list showtag $tag 0]
5490 $ctext conf -state normal
5491 clear_ctext
5492 set linknum 0
5493 if {[info exists tagcontents($tag)]} {
5494 set text $tagcontents($tag)
5495 } else {
5496 set text "Tag: $tag\nId: $tagids($tag)"
5498 appendwithlinks $text {}
5499 $ctext conf -state disabled
5500 init_flist {}
5503 proc doquit {} {
5504 global stopped
5505 set stopped 100
5506 destroy .
5509 proc doprefs {} {
5510 global maxwidth maxgraphpct diffopts
5511 global oldprefs prefstop showneartags
5512 global bgcolor fgcolor ctext diffcolors
5514 set top .gitkprefs
5515 set prefstop $top
5516 if {[winfo exists $top]} {
5517 raise $top
5518 return
5520 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5521 set oldprefs($v) [set $v]
5523 toplevel $top
5524 wm title $top "Gitk preferences"
5525 label $top.ldisp -text "Commit list display options"
5526 grid $top.ldisp - -sticky w -pady 10
5527 label $top.spacer -text " "
5528 label $top.maxwidthl -text "Maximum graph width (lines)" \
5529 -font optionfont
5530 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5531 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5532 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5533 -font optionfont
5534 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5535 grid x $top.maxpctl $top.maxpct -sticky w
5537 label $top.ddisp -text "Diff display options"
5538 grid $top.ddisp - -sticky w -pady 10
5539 label $top.diffoptl -text "Options for diff program" \
5540 -font optionfont
5541 entry $top.diffopt -width 20 -textvariable diffopts
5542 grid x $top.diffoptl $top.diffopt -sticky w
5543 frame $top.ntag
5544 label $top.ntag.l -text "Display nearby tags" -font optionfont
5545 checkbutton $top.ntag.b -variable showneartags
5546 pack $top.ntag.b $top.ntag.l -side left
5547 grid x $top.ntag -sticky w
5549 label $top.cdisp -text "Colors: press to choose"
5550 grid $top.cdisp - -sticky w -pady 10
5551 label $top.bg -padx 40 -relief sunk -background $bgcolor
5552 button $top.bgbut -text "Background" -font optionfont \
5553 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5554 grid x $top.bgbut $top.bg -sticky w
5555 label $top.fg -padx 40 -relief sunk -background $fgcolor
5556 button $top.fgbut -text "Foreground" -font optionfont \
5557 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5558 grid x $top.fgbut $top.fg -sticky w
5559 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5560 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5561 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5562 [list $ctext tag conf d0 -foreground]]
5563 grid x $top.diffoldbut $top.diffold -sticky w
5564 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5565 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5566 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5567 [list $ctext tag conf d1 -foreground]]
5568 grid x $top.diffnewbut $top.diffnew -sticky w
5569 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5570 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5571 -command [list choosecolor diffcolors 2 $top.hunksep \
5572 "diff hunk header" \
5573 [list $ctext tag conf hunksep -foreground]]
5574 grid x $top.hunksepbut $top.hunksep -sticky w
5576 frame $top.buts
5577 button $top.buts.ok -text "OK" -command prefsok
5578 button $top.buts.can -text "Cancel" -command prefscan
5579 grid $top.buts.ok $top.buts.can
5580 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5581 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5582 grid $top.buts - - -pady 10 -sticky ew
5585 proc choosecolor {v vi w x cmd} {
5586 global $v
5588 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5589 -title "Gitk: choose color for $x"]
5590 if {$c eq {}} return
5591 $w conf -background $c
5592 lset $v $vi $c
5593 eval $cmd $c
5596 proc setbg {c} {
5597 global bglist
5599 foreach w $bglist {
5600 $w conf -background $c
5604 proc setfg {c} {
5605 global fglist canv
5607 foreach w $fglist {
5608 $w conf -foreground $c
5610 allcanvs itemconf text -fill $c
5611 $canv itemconf circle -outline $c
5614 proc prefscan {} {
5615 global maxwidth maxgraphpct diffopts
5616 global oldprefs prefstop showneartags
5618 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5619 set $v $oldprefs($v)
5621 catch {destroy $prefstop}
5622 unset prefstop
5625 proc prefsok {} {
5626 global maxwidth maxgraphpct
5627 global oldprefs prefstop showneartags
5629 catch {destroy $prefstop}
5630 unset prefstop
5631 if {$maxwidth != $oldprefs(maxwidth)
5632 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5633 redisplay
5634 } elseif {$showneartags != $oldprefs(showneartags)} {
5635 reselectline
5639 proc formatdate {d} {
5640 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5643 # This list of encoding names and aliases is distilled from
5644 # http://www.iana.org/assignments/character-sets.
5645 # Not all of them are supported by Tcl.
5646 set encoding_aliases {
5647 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5648 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5649 { ISO-10646-UTF-1 csISO10646UTF1 }
5650 { ISO_646.basic:1983 ref csISO646basic1983 }
5651 { INVARIANT csINVARIANT }
5652 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5653 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5654 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5655 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5656 { NATS-DANO iso-ir-9-1 csNATSDANO }
5657 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5658 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5659 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5660 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5661 { ISO-2022-KR csISO2022KR }
5662 { EUC-KR csEUCKR }
5663 { ISO-2022-JP csISO2022JP }
5664 { ISO-2022-JP-2 csISO2022JP2 }
5665 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5666 csISO13JISC6220jp }
5667 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5668 { IT iso-ir-15 ISO646-IT csISO15Italian }
5669 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5670 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5671 { greek7-old iso-ir-18 csISO18Greek7Old }
5672 { latin-greek iso-ir-19 csISO19LatinGreek }
5673 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5674 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5675 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5676 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5677 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5678 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5679 { INIS iso-ir-49 csISO49INIS }
5680 { INIS-8 iso-ir-50 csISO50INIS8 }
5681 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5682 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5683 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5684 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5685 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5686 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5687 csISO60Norwegian1 }
5688 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5689 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5690 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5691 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5692 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5693 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5694 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5695 { greek7 iso-ir-88 csISO88Greek7 }
5696 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5697 { iso-ir-90 csISO90 }
5698 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5699 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5700 csISO92JISC62991984b }
5701 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5702 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5703 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5704 csISO95JIS62291984handadd }
5705 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5706 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5707 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5708 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5709 CP819 csISOLatin1 }
5710 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5711 { T.61-7bit iso-ir-102 csISO102T617bit }
5712 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5713 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5714 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5715 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5716 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5717 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5718 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5719 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5720 arabic csISOLatinArabic }
5721 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5722 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5723 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5724 greek greek8 csISOLatinGreek }
5725 { T.101-G2 iso-ir-128 csISO128T101G2 }
5726 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5727 csISOLatinHebrew }
5728 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5729 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5730 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5731 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5732 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5733 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5734 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5735 csISOLatinCyrillic }
5736 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5737 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5738 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5739 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5740 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5741 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5742 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5743 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5744 { ISO_10367-box iso-ir-155 csISO10367Box }
5745 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5746 { latin-lap lap iso-ir-158 csISO158Lap }
5747 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5748 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5749 { us-dk csUSDK }
5750 { dk-us csDKUS }
5751 { JIS_X0201 X0201 csHalfWidthKatakana }
5752 { KSC5636 ISO646-KR csKSC5636 }
5753 { ISO-10646-UCS-2 csUnicode }
5754 { ISO-10646-UCS-4 csUCS4 }
5755 { DEC-MCS dec csDECMCS }
5756 { hp-roman8 roman8 r8 csHPRoman8 }
5757 { macintosh mac csMacintosh }
5758 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5759 csIBM037 }
5760 { IBM038 EBCDIC-INT cp038 csIBM038 }
5761 { IBM273 CP273 csIBM273 }
5762 { IBM274 EBCDIC-BE CP274 csIBM274 }
5763 { IBM275 EBCDIC-BR cp275 csIBM275 }
5764 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5765 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5766 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5767 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5768 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5769 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5770 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5771 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5772 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5773 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5774 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5775 { IBM437 cp437 437 csPC8CodePage437 }
5776 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5777 { IBM775 cp775 csPC775Baltic }
5778 { IBM850 cp850 850 csPC850Multilingual }
5779 { IBM851 cp851 851 csIBM851 }
5780 { IBM852 cp852 852 csPCp852 }
5781 { IBM855 cp855 855 csIBM855 }
5782 { IBM857 cp857 857 csIBM857 }
5783 { IBM860 cp860 860 csIBM860 }
5784 { IBM861 cp861 861 cp-is csIBM861 }
5785 { IBM862 cp862 862 csPC862LatinHebrew }
5786 { IBM863 cp863 863 csIBM863 }
5787 { IBM864 cp864 csIBM864 }
5788 { IBM865 cp865 865 csIBM865 }
5789 { IBM866 cp866 866 csIBM866 }
5790 { IBM868 CP868 cp-ar csIBM868 }
5791 { IBM869 cp869 869 cp-gr csIBM869 }
5792 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5793 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5794 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5795 { IBM891 cp891 csIBM891 }
5796 { IBM903 cp903 csIBM903 }
5797 { IBM904 cp904 904 csIBBM904 }
5798 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5799 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5800 { IBM1026 CP1026 csIBM1026 }
5801 { EBCDIC-AT-DE csIBMEBCDICATDE }
5802 { EBCDIC-AT-DE-A csEBCDICATDEA }
5803 { EBCDIC-CA-FR csEBCDICCAFR }
5804 { EBCDIC-DK-NO csEBCDICDKNO }
5805 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5806 { EBCDIC-FI-SE csEBCDICFISE }
5807 { EBCDIC-FI-SE-A csEBCDICFISEA }
5808 { EBCDIC-FR csEBCDICFR }
5809 { EBCDIC-IT csEBCDICIT }
5810 { EBCDIC-PT csEBCDICPT }
5811 { EBCDIC-ES csEBCDICES }
5812 { EBCDIC-ES-A csEBCDICESA }
5813 { EBCDIC-ES-S csEBCDICESS }
5814 { EBCDIC-UK csEBCDICUK }
5815 { EBCDIC-US csEBCDICUS }
5816 { UNKNOWN-8BIT csUnknown8BiT }
5817 { MNEMONIC csMnemonic }
5818 { MNEM csMnem }
5819 { VISCII csVISCII }
5820 { VIQR csVIQR }
5821 { KOI8-R csKOI8R }
5822 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5823 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5824 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5825 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5826 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5827 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5828 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5829 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5830 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5831 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5832 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5833 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5834 { IBM1047 IBM-1047 }
5835 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5836 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5837 { UNICODE-1-1 csUnicode11 }
5838 { CESU-8 csCESU-8 }
5839 { BOCU-1 csBOCU-1 }
5840 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5841 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5842 l8 }
5843 { ISO-8859-15 ISO_8859-15 Latin-9 }
5844 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5845 { GBK CP936 MS936 windows-936 }
5846 { JIS_Encoding csJISEncoding }
5847 { Shift_JIS MS_Kanji csShiftJIS }
5848 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5849 EUC-JP }
5850 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5851 { ISO-10646-UCS-Basic csUnicodeASCII }
5852 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5853 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5854 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5855 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5856 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5857 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5858 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5859 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5860 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5861 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5862 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5863 { Ventura-US csVenturaUS }
5864 { Ventura-International csVenturaInternational }
5865 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5866 { PC8-Turkish csPC8Turkish }
5867 { IBM-Symbols csIBMSymbols }
5868 { IBM-Thai csIBMThai }
5869 { HP-Legal csHPLegal }
5870 { HP-Pi-font csHPPiFont }
5871 { HP-Math8 csHPMath8 }
5872 { Adobe-Symbol-Encoding csHPPSMath }
5873 { HP-DeskTop csHPDesktop }
5874 { Ventura-Math csVenturaMath }
5875 { Microsoft-Publishing csMicrosoftPublishing }
5876 { Windows-31J csWindows31J }
5877 { GB2312 csGB2312 }
5878 { Big5 csBig5 }
5881 proc tcl_encoding {enc} {
5882 global encoding_aliases
5883 set names [encoding names]
5884 set lcnames [string tolower $names]
5885 set enc [string tolower $enc]
5886 set i [lsearch -exact $lcnames $enc]
5887 if {$i < 0} {
5888 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5889 if {[regsub {^iso[-_]} $enc iso encx]} {
5890 set i [lsearch -exact $lcnames $encx]
5893 if {$i < 0} {
5894 foreach l $encoding_aliases {
5895 set ll [string tolower $l]
5896 if {[lsearch -exact $ll $enc] < 0} continue
5897 # look through the aliases for one that tcl knows about
5898 foreach e $ll {
5899 set i [lsearch -exact $lcnames $e]
5900 if {$i < 0} {
5901 if {[regsub {^iso[-_]} $e iso ex]} {
5902 set i [lsearch -exact $lcnames $ex]
5905 if {$i >= 0} break
5907 break
5910 if {$i >= 0} {
5911 return [lindex $names $i]
5913 return {}
5916 # defaults...
5917 set datemode 0
5918 set diffopts "-U 5 -p"
5919 set wrcomcmd "git diff-tree --stdin -p --pretty"
5921 set gitencoding {}
5922 catch {
5923 set gitencoding [exec git repo-config --get i18n.commitencoding]
5925 if {$gitencoding == ""} {
5926 set gitencoding "utf-8"
5928 set tclencoding [tcl_encoding $gitencoding]
5929 if {$tclencoding == {}} {
5930 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5933 set mainfont {Helvetica 9}
5934 set textfont {Courier 9}
5935 set uifont {Helvetica 9 bold}
5936 set findmergefiles 0
5937 set maxgraphpct 50
5938 set maxwidth 16
5939 set revlistorder 0
5940 set fastdate 0
5941 set uparrowlen 7
5942 set downarrowlen 7
5943 set mingaplen 30
5944 set cmitmode "patch"
5945 set wrapcomment "none"
5946 set showneartags 1
5948 set colors {green red blue magenta darkgrey brown orange}
5949 set bgcolor white
5950 set fgcolor black
5951 set diffcolors {red "#00a000" blue}
5953 catch {source ~/.gitk}
5955 font create optionfont -family sans-serif -size -12
5957 set revtreeargs {}
5958 foreach arg $argv {
5959 switch -regexp -- $arg {
5960 "^$" { }
5961 "^-d" { set datemode 1 }
5962 default {
5963 lappend revtreeargs $arg
5968 # check that we can find a .git directory somewhere...
5969 set gitdir [gitdir]
5970 if {![file isdirectory $gitdir]} {
5971 show_error {} . "Cannot find the git directory \"$gitdir\"."
5972 exit 1
5975 set cmdline_files {}
5976 set i [lsearch -exact $revtreeargs "--"]
5977 if {$i >= 0} {
5978 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5979 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5980 } elseif {$revtreeargs ne {}} {
5981 if {[catch {
5982 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5983 set cmdline_files [split $f "\n"]
5984 set n [llength $cmdline_files]
5985 set revtreeargs [lrange $revtreeargs 0 end-$n]
5986 } err]} {
5987 # unfortunately we get both stdout and stderr in $err,
5988 # so look for "fatal:".
5989 set i [string first "fatal:" $err]
5990 if {$i > 0} {
5991 set err [string range $err [expr {$i + 6}] end]
5993 show_error {} . "Bad arguments to gitk:\n$err"
5994 exit 1
5998 set history {}
5999 set historyindex 0
6000 set fh_serial 0
6001 set nhl_names {}
6002 set highlight_paths {}
6003 set searchdirn -forwards
6004 set boldrows {}
6005 set boldnamerows {}
6007 set optim_delay 16
6009 set nextviewnum 1
6010 set curview 0
6011 set selectedview 0
6012 set selectedhlview None
6013 set viewfiles(0) {}
6014 set viewperm(0) 0
6015 set viewargs(0) {}
6017 set cmdlineok 0
6018 set stopped 0
6019 set stuffsaved 0
6020 set patchnum 0
6021 setcoords
6022 makewindow
6023 readrefs
6025 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6026 # create a view for the files/dirs specified on the command line
6027 set curview 1
6028 set selectedview 1
6029 set nextviewnum 2
6030 set viewname(1) "Command line"
6031 set viewfiles(1) $cmdline_files
6032 set viewargs(1) $revtreeargs
6033 set viewperm(1) 0
6034 addviewmenu 1
6035 .bar.view entryconf 2 -state normal
6036 .bar.view entryconf 3 -state normal
6039 if {[info exists permviews]} {
6040 foreach v $permviews {
6041 set n $nextviewnum
6042 incr nextviewnum
6043 set viewname($n) [lindex $v 0]
6044 set viewfiles($n) [lindex $v 1]
6045 set viewargs($n) [lindex $v 2]
6046 set viewperm($n) 1
6047 addviewmenu $n
6050 getcommits