gitk: Add a goto next/previous highlighted commit function
[git/gitweb.git] / gitk
blob7c8ad595c04537369b4c13e94fa0eadb93ea05be
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
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 readrefs
242 showview $n
245 proc parsecommit {id contents listed} {
246 global commitinfo cdate
248 set inhdr 1
249 set comment {}
250 set headline {}
251 set auname {}
252 set audate {}
253 set comname {}
254 set comdate {}
255 set hdrend [string first "\n\n" $contents]
256 if {$hdrend < 0} {
257 # should never happen...
258 set hdrend [string length $contents]
260 set header [string range $contents 0 [expr {$hdrend - 1}]]
261 set comment [string range $contents [expr {$hdrend + 2}] end]
262 foreach line [split $header "\n"] {
263 set tag [lindex $line 0]
264 if {$tag == "author"} {
265 set audate [lindex $line end-1]
266 set auname [lrange $line 1 end-2]
267 } elseif {$tag == "committer"} {
268 set comdate [lindex $line end-1]
269 set comname [lrange $line 1 end-2]
272 set headline {}
273 # take the first line of the comment as the headline
274 set i [string first "\n" $comment]
275 if {$i >= 0} {
276 set headline [string trim [string range $comment 0 $i]]
277 } else {
278 set headline $comment
280 if {!$listed} {
281 # git-rev-list indents the comment by 4 spaces;
282 # if we got this via git-cat-file, add the indentation
283 set newcomment {}
284 foreach line [split $comment "\n"] {
285 append newcomment " "
286 append newcomment $line
287 append newcomment "\n"
289 set comment $newcomment
291 if {$comdate != {}} {
292 set cdate($id) $comdate
294 set commitinfo($id) [list $headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit {id} {
299 global commitdata commitinfo
301 if {[info exists commitdata($id)]} {
302 parsecommit $id $commitdata($id) 1
303 } else {
304 readcommit $id
305 if {![info exists commitinfo($id)]} {
306 set commitinfo($id) {"No commit information available"}
309 return 1
312 proc readrefs {} {
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
317 catch {unset $v}
319 set refd [open [list | git ls-remote [gitdir]] r]
320 while {0 <= [set n [gets $refd line]]} {
321 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
322 match id path]} {
323 continue
325 if {[regexp {^remotes/.*/HEAD$} $path match]} {
326 continue
328 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
329 set type others
330 set name $path
332 if {[regexp {^remotes/} $path match]} {
333 set type heads
335 if {$type == "tags"} {
336 set tagids($name) $id
337 lappend idtags($id) $name
338 set obj {}
339 set type {}
340 set tag {}
341 catch {
342 set commit [exec git-rev-parse "$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids($name) $commit
345 lappend idtags($commit) $name
348 catch {
349 set tagcontents($name) [exec git-cat-file tag "$id"]
351 } elseif { $type == "heads" } {
352 set headids($name) $id
353 lappend idheads($id) $name
354 } else {
355 set otherrefids($name) $id
356 lappend idotherrefs($id) $name
359 close $refd
362 proc show_error {w msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $w"
366 pack $w.ok -side bottom -fill x
367 bind $w <Visibility> "grab $w; focus $w"
368 bind $w <Key-Return> "destroy $w"
369 tkwait window $w
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $msg
379 proc makewindow {} {
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax
386 global highlight_files gdttype
387 global searchstring sstring
389 menu .bar
390 .bar add cascade -label "File" -menu .bar.file
391 .bar configure -font $uifont
392 menu .bar.file
393 .bar.file add command -label "Update" -command updatecommits
394 .bar.file add command -label "Reread references" -command rereadrefs
395 .bar.file add command -label "Quit" -command doquit
396 .bar.file configure -font $uifont
397 menu .bar.edit
398 .bar add cascade -label "Edit" -menu .bar.edit
399 .bar.edit add command -label "Preferences" -command doprefs
400 .bar.edit configure -font $uifont
402 menu .bar.view -font $uifont
403 .bar add cascade -label "View" -menu .bar.view
404 .bar.view add command -label "New view..." -command {newview 0}
405 .bar.view add command -label "Edit view..." -command editview \
406 -state disabled
407 .bar.view add command -label "Delete view" -command delview -state disabled
408 .bar.view add separator
409 .bar.view add radiobutton -label "All files" -command {showview 0} \
410 -variable selectedview -value 0
412 menu .bar.help
413 .bar add cascade -label "Help" -menu .bar.help
414 .bar.help add command -label "About gitk" -command about
415 .bar.help add command -label "Key bindings" -command keys
416 .bar.help configure -font $uifont
417 . configure -menu .bar
419 if {![info exists geometry(canv1)]} {
420 set geometry(canv1) [expr {45 * $charspc}]
421 set geometry(canv2) [expr {30 * $charspc}]
422 set geometry(canv3) [expr {15 * $charspc}]
423 set geometry(canvh) [expr {25 * $linespc + 4}]
424 set geometry(ctextw) 80
425 set geometry(ctexth) 30
426 set geometry(cflistw) 30
428 panedwindow .ctop -orient vertical
429 if {[info exists geometry(width)]} {
430 .ctop conf -width $geometry(width) -height $geometry(height)
431 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
432 set geometry(ctexth) [expr {($texth - 8) /
433 [font metrics $textfont -linespace]}]
435 frame .ctop.top
436 frame .ctop.top.bar
437 frame .ctop.top.lbar
438 pack .ctop.top.lbar -side bottom -fill x
439 pack .ctop.top.bar -side bottom -fill x
440 set cscroll .ctop.top.csb
441 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
442 pack $cscroll -side right -fill y
443 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
444 pack .ctop.top.clist -side top -fill both -expand 1
445 .ctop add .ctop.top
446 set canv .ctop.top.clist.canv
447 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
448 -bg white -bd 0 \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add $canv
451 set canv2 .ctop.top.clist.canv2
452 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
453 -bg white -bd 0 -yscrollincr $linespc
454 .ctop.top.clist add $canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
457 -bg white -bd 0 -yscrollincr $linespc
458 .ctop.top.clist add $canv3
459 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
461 set sha1entry .ctop.top.bar.sha1
462 set entries $sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
465 -command gotocommit -width 8 -font $uifont
466 $sha1but conf -disabledforeground [$sha1but cget -foreground]
467 pack .ctop.top.bar.sha1label -side left
468 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string write sha1change
470 pack $sha1entry -side left -pady 2
472 image create bitmap bm-left -data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right -data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut -image bm-left -command goback \
489 -state disabled -width 26
490 pack .ctop.top.bar.leftbut -side left -fill y
491 button .ctop.top.bar.rightbut -image bm-right -command goforw \
492 -state disabled -width 26
493 pack .ctop.top.bar.rightbut -side left -fill y
495 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
496 pack .ctop.top.bar.findbut -side left
497 set findstring {}
498 set fstring .ctop.top.bar.findstring
499 lappend entries $fstring
500 entry $fstring -width 30 -font $textfont -textvariable findstring
501 trace add variable findstring write find_change
502 pack $fstring -side left -expand 1 -fill x
503 set findtype Exact
504 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
505 findtype Exact IgnCase Regexp]
506 trace add variable findtype write find_change
507 .ctop.top.bar.findtype configure -font $uifont
508 .ctop.top.bar.findtype.menu configure -font $uifont
509 set findloc "All fields"
510 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
511 Comments Author Committer
512 trace add variable findloc write find_change
513 .ctop.top.bar.findloc configure -font $uifont
514 .ctop.top.bar.findloc.menu configure -font $uifont
515 pack .ctop.top.bar.findloc -side right
516 pack .ctop.top.bar.findtype -side right
518 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
519 -font $uifont
520 pack .ctop.top.lbar.flabel -side left -fill y
521 set gdttype "touching paths:"
522 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
523 "adding/removing string:"]
524 trace add variable gdttype write hfiles_change
525 $gm conf -font $uifont
526 .ctop.top.lbar.gdttype conf -font $uifont
527 pack .ctop.top.lbar.gdttype -side left -fill y
528 entry .ctop.top.lbar.fent -width 25 -font $textfont \
529 -textvariable highlight_files
530 trace add variable highlight_files write hfiles_change
531 lappend entries .ctop.top.lbar.fent
532 pack .ctop.top.lbar.fent -side left -fill x -expand 1
533 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
534 pack .ctop.top.lbar.vlabel -side left -fill y
535 global viewhlmenu selectedhlview
536 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
537 $viewhlmenu entryconf 0 -command delvhighlight
538 $viewhlmenu conf -font $uifont
539 .ctop.top.lbar.vhl conf -font $uifont
540 pack .ctop.top.lbar.vhl -side left -fill y
541 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
542 pack .ctop.top.lbar.rlabel -side left -fill y
543 global highlight_related
544 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
545 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
546 $m conf -font $uifont
547 .ctop.top.lbar.relm conf -font $uifont
548 trace add variable highlight_related write vrel_change
549 pack .ctop.top.lbar.relm -side left -fill y
551 panedwindow .ctop.cdet -orient horizontal
552 .ctop add .ctop.cdet
553 frame .ctop.cdet.left
554 frame .ctop.cdet.left.bot
555 pack .ctop.cdet.left.bot -side bottom -fill x
556 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
557 -font $uifont
558 pack .ctop.cdet.left.bot.search -side left -padx 5
559 set sstring .ctop.cdet.left.bot.sstring
560 entry $sstring -width 20 -font $textfont -textvariable searchstring
561 lappend entries $sstring
562 trace add variable searchstring write incrsearch
563 pack $sstring -side left -expand 1 -fill x
564 set ctext .ctop.cdet.left.ctext
565 text $ctext -bg white -state disabled -font $textfont \
566 -width $geometry(ctextw) -height $geometry(ctexth) \
567 -yscrollcommand scrolltext -wrap none
568 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
569 pack .ctop.cdet.left.sb -side right -fill y
570 pack $ctext -side left -fill both -expand 1
571 .ctop.cdet add .ctop.cdet.left
573 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
574 $ctext tag conf hunksep -fore blue
575 $ctext tag conf d0 -fore red
576 $ctext tag conf d1 -fore "#00a000"
577 $ctext tag conf m0 -fore red
578 $ctext tag conf m1 -fore blue
579 $ctext tag conf m2 -fore green
580 $ctext tag conf m3 -fore purple
581 $ctext tag conf m4 -fore brown
582 $ctext tag conf m5 -fore "#009090"
583 $ctext tag conf m6 -fore magenta
584 $ctext tag conf m7 -fore "#808000"
585 $ctext tag conf m8 -fore "#009000"
586 $ctext tag conf m9 -fore "#ff0080"
587 $ctext tag conf m10 -fore cyan
588 $ctext tag conf m11 -fore "#b07070"
589 $ctext tag conf m12 -fore "#70b0f0"
590 $ctext tag conf m13 -fore "#70f0b0"
591 $ctext tag conf m14 -fore "#f0b070"
592 $ctext tag conf m15 -fore "#ff70b0"
593 $ctext tag conf mmax -fore darkgrey
594 set mergemax 16
595 $ctext tag conf mresult -font [concat $textfont bold]
596 $ctext tag conf msep -font [concat $textfont bold]
597 $ctext tag conf found -back yellow
599 frame .ctop.cdet.right
600 frame .ctop.cdet.right.mode
601 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
602 -command reselectline -variable cmitmode -value "patch"
603 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
604 -command reselectline -variable cmitmode -value "tree"
605 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
606 pack .ctop.cdet.right.mode -side top -fill x
607 set cflist .ctop.cdet.right.cfiles
608 set indent [font measure $mainfont "nn"]
609 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
610 -tabs [list $indent [expr {2 * $indent}]] \
611 -yscrollcommand ".ctop.cdet.right.sb set" \
612 -cursor [. cget -cursor] \
613 -spacing1 1 -spacing3 1
614 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
615 pack .ctop.cdet.right.sb -side right -fill y
616 pack $cflist -side left -fill both -expand 1
617 $cflist tag configure highlight \
618 -background [$cflist cget -selectbackground]
619 $cflist tag configure bold -font [concat $mainfont bold]
620 .ctop.cdet add .ctop.cdet.right
621 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
623 pack .ctop -side top -fill both -expand 1
625 bindall <1> {selcanvline %W %x %y}
626 #bindall <B1-Motion> {selcanvline %W %x %y}
627 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
628 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
629 bindall <2> "canvscan mark %W %x %y"
630 bindall <B2-Motion> "canvscan dragto %W %x %y"
631 bindkey <Home> selfirstline
632 bindkey <End> sellastline
633 bind . <Key-Up> "selnextline -1"
634 bind . <Key-Down> "selnextline 1"
635 bind . <Shift-Key-Up> "next_highlight -1"
636 bind . <Shift-Key-Down> "next_highlight 1"
637 bindkey <Key-Right> "goforw"
638 bindkey <Key-Left> "goback"
639 bind . <Key-Prior> "selnextpage -1"
640 bind . <Key-Next> "selnextpage 1"
641 bind . <Control-Home> "allcanvs yview moveto 0.0"
642 bind . <Control-End> "allcanvs yview moveto 1.0"
643 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
644 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
645 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
646 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
647 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
648 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
649 bindkey <Key-space> "$ctext yview scroll 1 pages"
650 bindkey p "selnextline -1"
651 bindkey n "selnextline 1"
652 bindkey z "goback"
653 bindkey x "goforw"
654 bindkey i "selnextline -1"
655 bindkey k "selnextline 1"
656 bindkey j "goback"
657 bindkey l "goforw"
658 bindkey b "$ctext yview scroll -1 pages"
659 bindkey d "$ctext yview scroll 18 units"
660 bindkey u "$ctext yview scroll -18 units"
661 bindkey / {findnext 1}
662 bindkey <Key-Return> {findnext 0}
663 bindkey ? findprev
664 bindkey f nextfile
665 bind . <Control-q> doquit
666 bind . <Control-f> dofind
667 bind . <Control-g> {findnext 0}
668 bind . <Control-r> dosearchback
669 bind . <Control-s> dosearch
670 bind . <Control-equal> {incrfont 1}
671 bind . <Control-KP_Add> {incrfont 1}
672 bind . <Control-minus> {incrfont -1}
673 bind . <Control-KP_Subtract> {incrfont -1}
674 bind . <Destroy> {savestuff %W}
675 bind . <Button-1> "click %W"
676 bind $fstring <Key-Return> dofind
677 bind $sha1entry <Key-Return> gotocommit
678 bind $sha1entry <<PasteSelection>> clearsha1
679 bind $cflist <1> {sel_flist %W %x %y; break}
680 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
681 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
683 set maincursor [. cget -cursor]
684 set textcursor [$ctext cget -cursor]
685 set curtextcursor $textcursor
687 set rowctxmenu .rowctxmenu
688 menu $rowctxmenu -tearoff 0
689 $rowctxmenu add command -label "Diff this -> selected" \
690 -command {diffvssel 0}
691 $rowctxmenu add command -label "Diff selected -> this" \
692 -command {diffvssel 1}
693 $rowctxmenu add command -label "Make patch" -command mkpatch
694 $rowctxmenu add command -label "Create tag" -command mktag
695 $rowctxmenu add command -label "Write commit to file" -command writecommit
698 # mouse-2 makes all windows scan vertically, but only the one
699 # the cursor is in scans horizontally
700 proc canvscan {op w x y} {
701 global canv canv2 canv3
702 foreach c [list $canv $canv2 $canv3] {
703 if {$c == $w} {
704 $c scan $op $x $y
705 } else {
706 $c scan $op 0 $y
711 proc scrollcanv {cscroll f0 f1} {
712 $cscroll set $f0 $f1
713 drawfrac $f0 $f1
714 flushhighlights
717 # when we make a key binding for the toplevel, make sure
718 # it doesn't get triggered when that key is pressed in the
719 # find string entry widget.
720 proc bindkey {ev script} {
721 global entries
722 bind . $ev $script
723 set escript [bind Entry $ev]
724 if {$escript == {}} {
725 set escript [bind Entry <Key>]
727 foreach e $entries {
728 bind $e $ev "$escript; break"
732 # set the focus back to the toplevel for any click outside
733 # the entry widgets
734 proc click {w} {
735 global entries
736 foreach e $entries {
737 if {$w == $e} return
739 focus .
742 proc savestuff {w} {
743 global canv canv2 canv3 ctext cflist mainfont textfont uifont
744 global stuffsaved findmergefiles maxgraphpct
745 global maxwidth
746 global viewname viewfiles viewargs viewperm nextviewnum
747 global cmitmode
749 if {$stuffsaved} return
750 if {![winfo viewable .]} return
751 catch {
752 set f [open "~/.gitk-new" w]
753 puts $f [list set mainfont $mainfont]
754 puts $f [list set textfont $textfont]
755 puts $f [list set uifont $uifont]
756 puts $f [list set findmergefiles $findmergefiles]
757 puts $f [list set maxgraphpct $maxgraphpct]
758 puts $f [list set maxwidth $maxwidth]
759 puts $f [list set cmitmode $cmitmode]
760 puts $f "set geometry(width) [winfo width .ctop]"
761 puts $f "set geometry(height) [winfo height .ctop]"
762 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
763 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
764 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
765 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
766 set wid [expr {([winfo width $ctext] - 8) \
767 / [font measure $textfont "0"]}]
768 puts $f "set geometry(ctextw) $wid"
769 set wid [expr {([winfo width $cflist] - 11) \
770 / [font measure [$cflist cget -font] "0"]}]
771 puts $f "set geometry(cflistw) $wid"
772 puts -nonewline $f "set permviews {"
773 for {set v 0} {$v < $nextviewnum} {incr v} {
774 if {$viewperm($v)} {
775 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
778 puts $f "}"
779 close $f
780 file rename -force "~/.gitk-new" "~/.gitk"
782 set stuffsaved 1
785 proc resizeclistpanes {win w} {
786 global oldwidth
787 if {[info exists oldwidth($win)]} {
788 set s0 [$win sash coord 0]
789 set s1 [$win sash coord 1]
790 if {$w < 60} {
791 set sash0 [expr {int($w/2 - 2)}]
792 set sash1 [expr {int($w*5/6 - 2)}]
793 } else {
794 set factor [expr {1.0 * $w / $oldwidth($win)}]
795 set sash0 [expr {int($factor * [lindex $s0 0])}]
796 set sash1 [expr {int($factor * [lindex $s1 0])}]
797 if {$sash0 < 30} {
798 set sash0 30
800 if {$sash1 < $sash0 + 20} {
801 set sash1 [expr {$sash0 + 20}]
803 if {$sash1 > $w - 10} {
804 set sash1 [expr {$w - 10}]
805 if {$sash0 > $sash1 - 20} {
806 set sash0 [expr {$sash1 - 20}]
810 $win sash place 0 $sash0 [lindex $s0 1]
811 $win sash place 1 $sash1 [lindex $s1 1]
813 set oldwidth($win) $w
816 proc resizecdetpanes {win w} {
817 global oldwidth
818 if {[info exists oldwidth($win)]} {
819 set s0 [$win sash coord 0]
820 if {$w < 60} {
821 set sash0 [expr {int($w*3/4 - 2)}]
822 } else {
823 set factor [expr {1.0 * $w / $oldwidth($win)}]
824 set sash0 [expr {int($factor * [lindex $s0 0])}]
825 if {$sash0 < 45} {
826 set sash0 45
828 if {$sash0 > $w - 15} {
829 set sash0 [expr {$w - 15}]
832 $win sash place 0 $sash0 [lindex $s0 1]
834 set oldwidth($win) $w
837 proc allcanvs args {
838 global canv canv2 canv3
839 eval $canv $args
840 eval $canv2 $args
841 eval $canv3 $args
844 proc bindall {event action} {
845 global canv canv2 canv3
846 bind $canv $event $action
847 bind $canv2 $event $action
848 bind $canv3 $event $action
851 proc about {} {
852 set w .about
853 if {[winfo exists $w]} {
854 raise $w
855 return
857 toplevel $w
858 wm title $w "About gitk"
859 message $w.m -text {
860 Gitk - a commit viewer for git
862 Copyright © 2005-2006 Paul Mackerras
864 Use and redistribute under the terms of the GNU General Public License} \
865 -justify center -aspect 400
866 pack $w.m -side top -fill x -padx 20 -pady 20
867 button $w.ok -text Close -command "destroy $w"
868 pack $w.ok -side bottom
871 proc keys {} {
872 set w .keys
873 if {[winfo exists $w]} {
874 raise $w
875 return
877 toplevel $w
878 wm title $w "Gitk key bindings"
879 message $w.m -text {
880 Gitk key bindings:
882 <Ctrl-Q> Quit
883 <Home> Move to first commit
884 <End> Move to last commit
885 <Up>, p, i Move up one commit
886 <Down>, n, k Move down one commit
887 <Left>, z, j Go back in history list
888 <Right>, x, l Go forward in history list
889 <PageUp> Move up one page in commit list
890 <PageDown> Move down one page in commit list
891 <Ctrl-Home> Scroll to top of commit list
892 <Ctrl-End> Scroll to bottom of commit list
893 <Ctrl-Up> Scroll commit list up one line
894 <Ctrl-Down> Scroll commit list down one line
895 <Ctrl-PageUp> Scroll commit list up one page
896 <Ctrl-PageDown> Scroll commit list down one page
897 <Shift-Up> Move to previous highlighted line
898 <Shift-Down> Move to next highlighted line
899 <Delete>, b Scroll diff view up one page
900 <Backspace> Scroll diff view up one page
901 <Space> Scroll diff view down one page
902 u Scroll diff view up 18 lines
903 d Scroll diff view down 18 lines
904 <Ctrl-F> Find
905 <Ctrl-G> Move to next find hit
906 <Return> Move to next find hit
907 / Move to next find hit, or redo find
908 ? Move to previous find hit
909 f Scroll diff view to next file
910 <Ctrl-S> Search for next hit in diff view
911 <Ctrl-R> Search for previous hit in diff view
912 <Ctrl-KP+> Increase font size
913 <Ctrl-plus> Increase font size
914 <Ctrl-KP-> Decrease font size
915 <Ctrl-minus> Decrease font size
917 -justify left -bg white -border 2 -relief sunken
918 pack $w.m -side top -fill both
919 button $w.ok -text Close -command "destroy $w"
920 pack $w.ok -side bottom
923 # Procedures for manipulating the file list window at the
924 # bottom right of the overall window.
926 proc treeview {w l openlevs} {
927 global treecontents treediropen treeheight treeparent treeindex
929 set ix 0
930 set treeindex() 0
931 set lev 0
932 set prefix {}
933 set prefixend -1
934 set prefendstack {}
935 set htstack {}
936 set ht 0
937 set treecontents() {}
938 $w conf -state normal
939 foreach f $l {
940 while {[string range $f 0 $prefixend] ne $prefix} {
941 if {$lev <= $openlevs} {
942 $w mark set e:$treeindex($prefix) "end -1c"
943 $w mark gravity e:$treeindex($prefix) left
945 set treeheight($prefix) $ht
946 incr ht [lindex $htstack end]
947 set htstack [lreplace $htstack end end]
948 set prefixend [lindex $prefendstack end]
949 set prefendstack [lreplace $prefendstack end end]
950 set prefix [string range $prefix 0 $prefixend]
951 incr lev -1
953 set tail [string range $f [expr {$prefixend+1}] end]
954 while {[set slash [string first "/" $tail]] >= 0} {
955 lappend htstack $ht
956 set ht 0
957 lappend prefendstack $prefixend
958 incr prefixend [expr {$slash + 1}]
959 set d [string range $tail 0 $slash]
960 lappend treecontents($prefix) $d
961 set oldprefix $prefix
962 append prefix $d
963 set treecontents($prefix) {}
964 set treeindex($prefix) [incr ix]
965 set treeparent($prefix) $oldprefix
966 set tail [string range $tail [expr {$slash+1}] end]
967 if {$lev <= $openlevs} {
968 set ht 1
969 set treediropen($prefix) [expr {$lev < $openlevs}]
970 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
971 $w mark set d:$ix "end -1c"
972 $w mark gravity d:$ix left
973 set str "\n"
974 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
975 $w insert end $str
976 $w image create end -align center -image $bm -padx 1 \
977 -name a:$ix
978 $w insert end $d [highlight_tag $prefix]
979 $w mark set s:$ix "end -1c"
980 $w mark gravity s:$ix left
982 incr lev
984 if {$tail ne {}} {
985 if {$lev <= $openlevs} {
986 incr ht
987 set str "\n"
988 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
989 $w insert end $str
990 $w insert end $tail [highlight_tag $f]
992 lappend treecontents($prefix) $tail
995 while {$htstack ne {}} {
996 set treeheight($prefix) $ht
997 incr ht [lindex $htstack end]
998 set htstack [lreplace $htstack end end]
1000 $w conf -state disabled
1003 proc linetoelt {l} {
1004 global treeheight treecontents
1006 set y 2
1007 set prefix {}
1008 while {1} {
1009 foreach e $treecontents($prefix) {
1010 if {$y == $l} {
1011 return "$prefix$e"
1013 set n 1
1014 if {[string index $e end] eq "/"} {
1015 set n $treeheight($prefix$e)
1016 if {$y + $n > $l} {
1017 append prefix $e
1018 incr y
1019 break
1022 incr y $n
1027 proc highlight_tree {y prefix} {
1028 global treeheight treecontents cflist
1030 foreach e $treecontents($prefix) {
1031 set path $prefix$e
1032 if {[highlight_tag $path] ne {}} {
1033 $cflist tag add bold $y.0 "$y.0 lineend"
1035 incr y
1036 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1037 set y [highlight_tree $y $path]
1040 return $y
1043 proc treeclosedir {w dir} {
1044 global treediropen treeheight treeparent treeindex
1046 set ix $treeindex($dir)
1047 $w conf -state normal
1048 $w delete s:$ix e:$ix
1049 set treediropen($dir) 0
1050 $w image configure a:$ix -image tri-rt
1051 $w conf -state disabled
1052 set n [expr {1 - $treeheight($dir)}]
1053 while {$dir ne {}} {
1054 incr treeheight($dir) $n
1055 set dir $treeparent($dir)
1059 proc treeopendir {w dir} {
1060 global treediropen treeheight treeparent treecontents treeindex
1062 set ix $treeindex($dir)
1063 $w conf -state normal
1064 $w image configure a:$ix -image tri-dn
1065 $w mark set e:$ix s:$ix
1066 $w mark gravity e:$ix right
1067 set lev 0
1068 set str "\n"
1069 set n [llength $treecontents($dir)]
1070 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1071 incr lev
1072 append str "\t"
1073 incr treeheight($x) $n
1075 foreach e $treecontents($dir) {
1076 set de $dir$e
1077 if {[string index $e end] eq "/"} {
1078 set iy $treeindex($de)
1079 $w mark set d:$iy e:$ix
1080 $w mark gravity d:$iy left
1081 $w insert e:$ix $str
1082 set treediropen($de) 0
1083 $w image create e:$ix -align center -image tri-rt -padx 1 \
1084 -name a:$iy
1085 $w insert e:$ix $e [highlight_tag $de]
1086 $w mark set s:$iy e:$ix
1087 $w mark gravity s:$iy left
1088 set treeheight($de) 1
1089 } else {
1090 $w insert e:$ix $str
1091 $w insert e:$ix $e [highlight_tag $de]
1094 $w mark gravity e:$ix left
1095 $w conf -state disabled
1096 set treediropen($dir) 1
1097 set top [lindex [split [$w index @0,0] .] 0]
1098 set ht [$w cget -height]
1099 set l [lindex [split [$w index s:$ix] .] 0]
1100 if {$l < $top} {
1101 $w yview $l.0
1102 } elseif {$l + $n + 1 > $top + $ht} {
1103 set top [expr {$l + $n + 2 - $ht}]
1104 if {$l < $top} {
1105 set top $l
1107 $w yview $top.0
1111 proc treeclick {w x y} {
1112 global treediropen cmitmode ctext cflist cflist_top
1114 if {$cmitmode ne "tree"} return
1115 if {![info exists cflist_top]} return
1116 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1117 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1118 $cflist tag add highlight $l.0 "$l.0 lineend"
1119 set cflist_top $l
1120 if {$l == 1} {
1121 $ctext yview 1.0
1122 return
1124 set e [linetoelt $l]
1125 if {[string index $e end] ne "/"} {
1126 showfile $e
1127 } elseif {$treediropen($e)} {
1128 treeclosedir $w $e
1129 } else {
1130 treeopendir $w $e
1134 proc setfilelist {id} {
1135 global treefilelist cflist
1137 treeview $cflist $treefilelist($id) 0
1140 image create bitmap tri-rt -background black -foreground blue -data {
1141 #define tri-rt_width 13
1142 #define tri-rt_height 13
1143 static unsigned char tri-rt_bits[] = {
1144 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1145 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1146 0x00, 0x00};
1147 } -maskdata {
1148 #define tri-rt-mask_width 13
1149 #define tri-rt-mask_height 13
1150 static unsigned char tri-rt-mask_bits[] = {
1151 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1152 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1153 0x08, 0x00};
1155 image create bitmap tri-dn -background black -foreground blue -data {
1156 #define tri-dn_width 13
1157 #define tri-dn_height 13
1158 static unsigned char tri-dn_bits[] = {
1159 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1160 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1161 0x00, 0x00};
1162 } -maskdata {
1163 #define tri-dn-mask_width 13
1164 #define tri-dn-mask_height 13
1165 static unsigned char tri-dn-mask_bits[] = {
1166 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1167 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1168 0x00, 0x00};
1171 proc init_flist {first} {
1172 global cflist cflist_top selectedline difffilestart
1174 $cflist conf -state normal
1175 $cflist delete 0.0 end
1176 if {$first ne {}} {
1177 $cflist insert end $first
1178 set cflist_top 1
1179 $cflist tag add highlight 1.0 "1.0 lineend"
1180 } else {
1181 catch {unset cflist_top}
1183 $cflist conf -state disabled
1184 set difffilestart {}
1187 proc highlight_tag {f} {
1188 global highlight_paths
1190 foreach p $highlight_paths {
1191 if {[string match $p $f]} {
1192 return "bold"
1195 return {}
1198 proc highlight_filelist {} {
1199 global cmitmode cflist
1201 $cflist conf -state normal
1202 if {$cmitmode ne "tree"} {
1203 set end [lindex [split [$cflist index end] .] 0]
1204 for {set l 2} {$l < $end} {incr l} {
1205 set line [$cflist get $l.0 "$l.0 lineend"]
1206 if {[highlight_tag $line] ne {}} {
1207 $cflist tag add bold $l.0 "$l.0 lineend"
1210 } else {
1211 highlight_tree 2 {}
1213 $cflist conf -state disabled
1216 proc unhighlight_filelist {} {
1217 global cflist
1219 $cflist conf -state normal
1220 $cflist tag remove bold 1.0 end
1221 $cflist conf -state disabled
1224 proc add_flist {fl} {
1225 global cflist
1227 $cflist conf -state normal
1228 foreach f $fl {
1229 $cflist insert end "\n"
1230 $cflist insert end $f [highlight_tag $f]
1232 $cflist conf -state disabled
1235 proc sel_flist {w x y} {
1236 global ctext difffilestart cflist cflist_top cmitmode
1238 if {$cmitmode eq "tree"} return
1239 if {![info exists cflist_top]} return
1240 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1241 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1242 $cflist tag add highlight $l.0 "$l.0 lineend"
1243 set cflist_top $l
1244 if {$l == 1} {
1245 $ctext yview 1.0
1246 } else {
1247 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1251 # Functions for adding and removing shell-type quoting
1253 proc shellquote {str} {
1254 if {![string match "*\['\"\\ \t]*" $str]} {
1255 return $str
1257 if {![string match "*\['\"\\]*" $str]} {
1258 return "\"$str\""
1260 if {![string match "*'*" $str]} {
1261 return "'$str'"
1263 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1266 proc shellarglist {l} {
1267 set str {}
1268 foreach a $l {
1269 if {$str ne {}} {
1270 append str " "
1272 append str [shellquote $a]
1274 return $str
1277 proc shelldequote {str} {
1278 set ret {}
1279 set used -1
1280 while {1} {
1281 incr used
1282 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1283 append ret [string range $str $used end]
1284 set used [string length $str]
1285 break
1287 set first [lindex $first 0]
1288 set ch [string index $str $first]
1289 if {$first > $used} {
1290 append ret [string range $str $used [expr {$first - 1}]]
1291 set used $first
1293 if {$ch eq " " || $ch eq "\t"} break
1294 incr used
1295 if {$ch eq "'"} {
1296 set first [string first "'" $str $used]
1297 if {$first < 0} {
1298 error "unmatched single-quote"
1300 append ret [string range $str $used [expr {$first - 1}]]
1301 set used $first
1302 continue
1304 if {$ch eq "\\"} {
1305 if {$used >= [string length $str]} {
1306 error "trailing backslash"
1308 append ret [string index $str $used]
1309 continue
1311 # here ch == "\""
1312 while {1} {
1313 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1314 error "unmatched double-quote"
1316 set first [lindex $first 0]
1317 set ch [string index $str $first]
1318 if {$first > $used} {
1319 append ret [string range $str $used [expr {$first - 1}]]
1320 set used $first
1322 if {$ch eq "\""} break
1323 incr used
1324 append ret [string index $str $used]
1325 incr used
1328 return [list $used $ret]
1331 proc shellsplit {str} {
1332 set l {}
1333 while {1} {
1334 set str [string trimleft $str]
1335 if {$str eq {}} break
1336 set dq [shelldequote $str]
1337 set n [lindex $dq 0]
1338 set word [lindex $dq 1]
1339 set str [string range $str $n end]
1340 lappend l $word
1342 return $l
1345 # Code to implement multiple views
1347 proc newview {ishighlight} {
1348 global nextviewnum newviewname newviewperm uifont newishighlight
1349 global newviewargs revtreeargs
1351 set newishighlight $ishighlight
1352 set top .gitkview
1353 if {[winfo exists $top]} {
1354 raise $top
1355 return
1357 set newviewname($nextviewnum) "View $nextviewnum"
1358 set newviewperm($nextviewnum) 0
1359 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1360 vieweditor $top $nextviewnum "Gitk view definition"
1363 proc editview {} {
1364 global curview
1365 global viewname viewperm newviewname newviewperm
1366 global viewargs newviewargs
1368 set top .gitkvedit-$curview
1369 if {[winfo exists $top]} {
1370 raise $top
1371 return
1373 set newviewname($curview) $viewname($curview)
1374 set newviewperm($curview) $viewperm($curview)
1375 set newviewargs($curview) [shellarglist $viewargs($curview)]
1376 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1379 proc vieweditor {top n title} {
1380 global newviewname newviewperm viewfiles
1381 global uifont
1383 toplevel $top
1384 wm title $top $title
1385 label $top.nl -text "Name" -font $uifont
1386 entry $top.name -width 20 -textvariable newviewname($n)
1387 grid $top.nl $top.name -sticky w -pady 5
1388 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1389 grid $top.perm - -pady 5 -sticky w
1390 message $top.al -aspect 1000 -font $uifont \
1391 -text "Commits to include (arguments to git-rev-list):"
1392 grid $top.al - -sticky w -pady 5
1393 entry $top.args -width 50 -textvariable newviewargs($n) \
1394 -background white
1395 grid $top.args - -sticky ew -padx 5
1396 message $top.l -aspect 1000 -font $uifont \
1397 -text "Enter files and directories to include, one per line:"
1398 grid $top.l - -sticky w
1399 text $top.t -width 40 -height 10 -background white
1400 if {[info exists viewfiles($n)]} {
1401 foreach f $viewfiles($n) {
1402 $top.t insert end $f
1403 $top.t insert end "\n"
1405 $top.t delete {end - 1c} end
1406 $top.t mark set insert 0.0
1408 grid $top.t - -sticky ew -padx 5
1409 frame $top.buts
1410 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1411 button $top.buts.can -text "Cancel" -command [list destroy $top]
1412 grid $top.buts.ok $top.buts.can
1413 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1414 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1415 grid $top.buts - -pady 10 -sticky ew
1416 focus $top.t
1419 proc doviewmenu {m first cmd op argv} {
1420 set nmenu [$m index end]
1421 for {set i $first} {$i <= $nmenu} {incr i} {
1422 if {[$m entrycget $i -command] eq $cmd} {
1423 eval $m $op $i $argv
1424 break
1429 proc allviewmenus {n op args} {
1430 global viewhlmenu
1432 doviewmenu .bar.view 7 [list showview $n] $op $args
1433 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1436 proc newviewok {top n} {
1437 global nextviewnum newviewperm newviewname newishighlight
1438 global viewname viewfiles viewperm selectedview curview
1439 global viewargs newviewargs viewhlmenu
1441 if {[catch {
1442 set newargs [shellsplit $newviewargs($n)]
1443 } err]} {
1444 error_popup "Error in commit selection arguments: $err"
1445 wm raise $top
1446 focus $top
1447 return
1449 set files {}
1450 foreach f [split [$top.t get 0.0 end] "\n"] {
1451 set ft [string trim $f]
1452 if {$ft ne {}} {
1453 lappend files $ft
1456 if {![info exists viewfiles($n)]} {
1457 # creating a new view
1458 incr nextviewnum
1459 set viewname($n) $newviewname($n)
1460 set viewperm($n) $newviewperm($n)
1461 set viewfiles($n) $files
1462 set viewargs($n) $newargs
1463 addviewmenu $n
1464 if {!$newishighlight} {
1465 after idle showview $n
1466 } else {
1467 after idle addvhighlight $n
1469 } else {
1470 # editing an existing view
1471 set viewperm($n) $newviewperm($n)
1472 if {$newviewname($n) ne $viewname($n)} {
1473 set viewname($n) $newviewname($n)
1474 doviewmenu .bar.view 7 [list showview $n] \
1475 entryconf [list -label $viewname($n)]
1476 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1477 entryconf [list -label $viewname($n) -value $viewname($n)]
1479 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1480 set viewfiles($n) $files
1481 set viewargs($n) $newargs
1482 if {$curview == $n} {
1483 after idle updatecommits
1487 catch {destroy $top}
1490 proc delview {} {
1491 global curview viewdata viewperm hlview selectedhlview
1493 if {$curview == 0} return
1494 if {[info exists hlview] && $hlview == $curview} {
1495 set selectedhlview None
1496 unset hlview
1498 allviewmenus $curview delete
1499 set viewdata($curview) {}
1500 set viewperm($curview) 0
1501 showview 0
1504 proc addviewmenu {n} {
1505 global viewname viewhlmenu
1507 .bar.view add radiobutton -label $viewname($n) \
1508 -command [list showview $n] -variable selectedview -value $n
1509 $viewhlmenu add radiobutton -label $viewname($n) \
1510 -command [list addvhighlight $n] -variable selectedhlview
1513 proc flatten {var} {
1514 global $var
1516 set ret {}
1517 foreach i [array names $var] {
1518 lappend ret $i [set $var\($i\)]
1520 return $ret
1523 proc unflatten {var l} {
1524 global $var
1526 catch {unset $var}
1527 foreach {i v} $l {
1528 set $var\($i\) $v
1532 proc showview {n} {
1533 global curview viewdata viewfiles
1534 global displayorder parentlist childlist rowidlist rowoffsets
1535 global colormap rowtextx commitrow nextcolor canvxmax
1536 global numcommits rowrangelist commitlisted idrowranges
1537 global selectedline currentid canv canvy0
1538 global matchinglines treediffs
1539 global pending_select phase
1540 global commitidx rowlaidout rowoptim linesegends
1541 global commfd nextupdate
1542 global selectedview
1543 global vparentlist vchildlist vdisporder vcmitlisted
1544 global hlview selectedhlview
1546 if {$n == $curview} return
1547 set selid {}
1548 if {[info exists selectedline]} {
1549 set selid $currentid
1550 set y [yc $selectedline]
1551 set ymax [lindex [$canv cget -scrollregion] 3]
1552 set span [$canv yview]
1553 set ytop [expr {[lindex $span 0] * $ymax}]
1554 set ybot [expr {[lindex $span 1] * $ymax}]
1555 if {$ytop < $y && $y < $ybot} {
1556 set yscreen [expr {$y - $ytop}]
1557 } else {
1558 set yscreen [expr {($ybot - $ytop) / 2}]
1561 unselectline
1562 normalline
1563 stopfindproc
1564 if {$curview >= 0} {
1565 set vparentlist($curview) $parentlist
1566 set vchildlist($curview) $childlist
1567 set vdisporder($curview) $displayorder
1568 set vcmitlisted($curview) $commitlisted
1569 if {$phase ne {}} {
1570 set viewdata($curview) \
1571 [list $phase $rowidlist $rowoffsets $rowrangelist \
1572 [flatten idrowranges] [flatten idinlist] \
1573 $rowlaidout $rowoptim $numcommits $linesegends]
1574 } elseif {![info exists viewdata($curview)]
1575 || [lindex $viewdata($curview) 0] ne {}} {
1576 set viewdata($curview) \
1577 [list {} $rowidlist $rowoffsets $rowrangelist]
1580 catch {unset matchinglines}
1581 catch {unset treediffs}
1582 clear_display
1583 if {[info exists hlview] && $hlview == $n} {
1584 unset hlview
1585 set selectedhlview None
1588 set curview $n
1589 set selectedview $n
1590 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1591 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1593 if {![info exists viewdata($n)]} {
1594 set pending_select $selid
1595 getcommits
1596 return
1599 set v $viewdata($n)
1600 set phase [lindex $v 0]
1601 set displayorder $vdisporder($n)
1602 set parentlist $vparentlist($n)
1603 set childlist $vchildlist($n)
1604 set commitlisted $vcmitlisted($n)
1605 set rowidlist [lindex $v 1]
1606 set rowoffsets [lindex $v 2]
1607 set rowrangelist [lindex $v 3]
1608 if {$phase eq {}} {
1609 set numcommits [llength $displayorder]
1610 catch {unset idrowranges}
1611 } else {
1612 unflatten idrowranges [lindex $v 4]
1613 unflatten idinlist [lindex $v 5]
1614 set rowlaidout [lindex $v 6]
1615 set rowoptim [lindex $v 7]
1616 set numcommits [lindex $v 8]
1617 set linesegends [lindex $v 9]
1620 catch {unset colormap}
1621 catch {unset rowtextx}
1622 set nextcolor 0
1623 set canvxmax [$canv cget -width]
1624 set curview $n
1625 set row 0
1626 setcanvscroll
1627 set yf 0
1628 set row 0
1629 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1630 set row $commitrow($n,$selid)
1631 # try to get the selected row in the same position on the screen
1632 set ymax [lindex [$canv cget -scrollregion] 3]
1633 set ytop [expr {[yc $row] - $yscreen}]
1634 if {$ytop < 0} {
1635 set ytop 0
1637 set yf [expr {$ytop * 1.0 / $ymax}]
1639 allcanvs yview moveto $yf
1640 drawvisible
1641 selectline $row 0
1642 if {$phase ne {}} {
1643 if {$phase eq "getcommits"} {
1644 show_status "Reading commits..."
1646 if {[info exists commfd($n)]} {
1647 layoutmore
1648 } else {
1649 finishcommits
1651 } elseif {$numcommits == 0} {
1652 show_status "No commits selected"
1656 # Stuff relating to the highlighting facility
1658 proc ishighlighted {row} {
1659 global vhighlights fhighlights nhighlights rhighlights
1661 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1662 return $nhighlights($row)
1664 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1665 return $vhighlights($row)
1667 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1668 return $fhighlights($row)
1670 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1671 return $rhighlights($row)
1673 return 0
1676 proc bolden {row font} {
1677 global canv linehtag selectedline boldrows
1679 lappend boldrows $row
1680 $canv itemconf $linehtag($row) -font $font
1681 if {[info exists selectedline] && $row == $selectedline} {
1682 $canv delete secsel
1683 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1684 -outline {{}} -tags secsel \
1685 -fill [$canv cget -selectbackground]]
1686 $canv lower $t
1690 proc bolden_name {row font} {
1691 global canv2 linentag selectedline boldnamerows
1693 lappend boldnamerows $row
1694 $canv2 itemconf $linentag($row) -font $font
1695 if {[info exists selectedline] && $row == $selectedline} {
1696 $canv2 delete secsel
1697 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1698 -outline {{}} -tags secsel \
1699 -fill [$canv2 cget -selectbackground]]
1700 $canv2 lower $t
1704 proc unbolden {} {
1705 global mainfont boldrows
1707 set stillbold {}
1708 foreach row $boldrows {
1709 if {![ishighlighted $row]} {
1710 bolden $row $mainfont
1711 } else {
1712 lappend stillbold $row
1715 set boldrows $stillbold
1718 proc addvhighlight {n} {
1719 global hlview curview viewdata vhl_done vhighlights commitidx
1721 if {[info exists hlview]} {
1722 delvhighlight
1724 set hlview $n
1725 if {$n != $curview && ![info exists viewdata($n)]} {
1726 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1727 set vparentlist($n) {}
1728 set vchildlist($n) {}
1729 set vdisporder($n) {}
1730 set vcmitlisted($n) {}
1731 start_rev_list $n
1733 set vhl_done $commitidx($hlview)
1734 if {$vhl_done > 0} {
1735 drawvisible
1739 proc delvhighlight {} {
1740 global hlview vhighlights
1742 if {![info exists hlview]} return
1743 unset hlview
1744 catch {unset vhighlights}
1745 unbolden
1748 proc vhighlightmore {} {
1749 global hlview vhl_done commitidx vhighlights
1750 global displayorder vdisporder curview mainfont
1752 set font [concat $mainfont bold]
1753 set max $commitidx($hlview)
1754 if {$hlview == $curview} {
1755 set disp $displayorder
1756 } else {
1757 set disp $vdisporder($hlview)
1759 set vr [visiblerows]
1760 set r0 [lindex $vr 0]
1761 set r1 [lindex $vr 1]
1762 for {set i $vhl_done} {$i < $max} {incr i} {
1763 set id [lindex $disp $i]
1764 if {[info exists commitrow($curview,$id)]} {
1765 set row $commitrow($curview,$id)
1766 if {$r0 <= $row && $row <= $r1} {
1767 if {![highlighted $row]} {
1768 bolden $row $font
1770 set vhighlights($row) 1
1774 set vhl_done $max
1777 proc askvhighlight {row id} {
1778 global hlview vhighlights commitrow iddrawn mainfont
1780 if {[info exists commitrow($hlview,$id)]} {
1781 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1782 bolden $row [concat $mainfont bold]
1784 set vhighlights($row) 1
1785 } else {
1786 set vhighlights($row) 0
1790 proc hfiles_change {name ix op} {
1791 global highlight_files filehighlight fhighlights fh_serial
1792 global mainfont highlight_paths
1794 if {[info exists filehighlight]} {
1795 # delete previous highlights
1796 catch {close $filehighlight}
1797 unset filehighlight
1798 catch {unset fhighlights}
1799 unbolden
1800 unhighlight_filelist
1802 set highlight_paths {}
1803 after cancel do_file_hl $fh_serial
1804 incr fh_serial
1805 if {$highlight_files ne {}} {
1806 after 300 do_file_hl $fh_serial
1810 proc makepatterns {l} {
1811 set ret {}
1812 foreach e $l {
1813 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1814 if {[string index $ee end] eq "/"} {
1815 lappend ret "$ee*"
1816 } else {
1817 lappend ret $ee
1818 lappend ret "$ee/*"
1821 return $ret
1824 proc do_file_hl {serial} {
1825 global highlight_files filehighlight highlight_paths gdttype fhl_list
1827 if {$gdttype eq "touching paths:"} {
1828 if {[catch {set paths [shellsplit $highlight_files]}]} return
1829 set highlight_paths [makepatterns $paths]
1830 highlight_filelist
1831 set gdtargs [concat -- $paths]
1832 } else {
1833 set gdtargs [list "-S$highlight_files"]
1835 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1836 set filehighlight [open $cmd r+]
1837 fconfigure $filehighlight -blocking 0
1838 fileevent $filehighlight readable readfhighlight
1839 set fhl_list {}
1840 drawvisible
1841 flushhighlights
1844 proc flushhighlights {} {
1845 global filehighlight fhl_list
1847 if {[info exists filehighlight]} {
1848 lappend fhl_list {}
1849 puts $filehighlight ""
1850 flush $filehighlight
1854 proc askfilehighlight {row id} {
1855 global filehighlight fhighlights fhl_list
1857 lappend fhl_list $id
1858 set fhighlights($row) -1
1859 puts $filehighlight $id
1862 proc readfhighlight {} {
1863 global filehighlight fhighlights commitrow curview mainfont iddrawn
1864 global fhl_list
1866 while {[gets $filehighlight line] >= 0} {
1867 set line [string trim $line]
1868 set i [lsearch -exact $fhl_list $line]
1869 if {$i < 0} continue
1870 for {set j 0} {$j < $i} {incr j} {
1871 set id [lindex $fhl_list $j]
1872 if {[info exists commitrow($curview,$id)]} {
1873 set fhighlights($commitrow($curview,$id)) 0
1876 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1877 if {$line eq {}} continue
1878 if {![info exists commitrow($curview,$line)]} continue
1879 set row $commitrow($curview,$line)
1880 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1881 bolden $row [concat $mainfont bold]
1883 set fhighlights($row) 1
1885 if {[eof $filehighlight]} {
1886 # strange...
1887 puts "oops, git-diff-tree died"
1888 catch {close $filehighlight}
1889 unset filehighlight
1891 next_hlcont
1894 proc find_change {name ix op} {
1895 global nhighlights mainfont boldnamerows
1896 global findstring findpattern findtype
1898 # delete previous highlights, if any
1899 foreach row $boldnamerows {
1900 bolden_name $row $mainfont
1902 set boldnamerows {}
1903 catch {unset nhighlights}
1904 unbolden
1905 if {$findtype ne "Regexp"} {
1906 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1907 $findstring]
1908 set findpattern "*$e*"
1910 drawvisible
1913 proc askfindhighlight {row id} {
1914 global nhighlights commitinfo iddrawn mainfont
1915 global findstring findtype findloc findpattern
1917 if {![info exists commitinfo($id)]} {
1918 getcommit $id
1920 set info $commitinfo($id)
1921 set isbold 0
1922 set fldtypes {Headline Author Date Committer CDate Comments}
1923 foreach f $info ty $fldtypes {
1924 if {$findloc ne "All fields" && $findloc ne $ty} {
1925 continue
1927 if {$findtype eq "Regexp"} {
1928 set doesmatch [regexp $findstring $f]
1929 } elseif {$findtype eq "IgnCase"} {
1930 set doesmatch [string match -nocase $findpattern $f]
1931 } else {
1932 set doesmatch [string match $findpattern $f]
1934 if {$doesmatch} {
1935 if {$ty eq "Author"} {
1936 set isbold 2
1937 } else {
1938 set isbold 1
1942 if {[info exists iddrawn($id)]} {
1943 if {$isbold && ![ishighlighted $row]} {
1944 bolden $row [concat $mainfont bold]
1946 if {$isbold >= 2} {
1947 bolden_name $row [concat $mainfont bold]
1950 set nhighlights($row) $isbold
1953 proc vrel_change {name ix op} {
1954 global highlight_related
1956 rhighlight_none
1957 if {$highlight_related ne "None"} {
1958 after idle drawvisible
1962 # prepare for testing whether commits are descendents or ancestors of a
1963 proc rhighlight_sel {a} {
1964 global descendent desc_todo ancestor anc_todo
1965 global highlight_related rhighlights
1967 catch {unset descendent}
1968 set desc_todo [list $a]
1969 catch {unset ancestor}
1970 set anc_todo [list $a]
1971 if {$highlight_related ne "None"} {
1972 rhighlight_none
1973 after idle drawvisible
1977 proc rhighlight_none {} {
1978 global rhighlights
1980 catch {unset rhighlights}
1981 unbolden
1984 proc is_descendent {a} {
1985 global curview children commitrow descendent desc_todo
1987 set v $curview
1988 set la $commitrow($v,$a)
1989 set todo $desc_todo
1990 set leftover {}
1991 set done 0
1992 for {set i 0} {$i < [llength $todo]} {incr i} {
1993 set do [lindex $todo $i]
1994 if {$commitrow($v,$do) < $la} {
1995 lappend leftover $do
1996 continue
1998 foreach nk $children($v,$do) {
1999 if {![info exists descendent($nk)]} {
2000 set descendent($nk) 1
2001 lappend todo $nk
2002 if {$nk eq $a} {
2003 set done 1
2007 if {$done} {
2008 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2009 return
2012 set descendent($a) 0
2013 set desc_todo $leftover
2016 proc is_ancestor {a} {
2017 global curview parentlist commitrow ancestor anc_todo
2019 set v $curview
2020 set la $commitrow($v,$a)
2021 set todo $anc_todo
2022 set leftover {}
2023 set done 0
2024 for {set i 0} {$i < [llength $todo]} {incr i} {
2025 set do [lindex $todo $i]
2026 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2027 lappend leftover $do
2028 continue
2030 foreach np [lindex $parentlist $commitrow($v,$do)] {
2031 if {![info exists ancestor($np)]} {
2032 set ancestor($np) 1
2033 lappend todo $np
2034 if {$np eq $a} {
2035 set done 1
2039 if {$done} {
2040 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2041 return
2044 set ancestor($a) 0
2045 set anc_todo $leftover
2048 proc askrelhighlight {row id} {
2049 global descendent highlight_related iddrawn mainfont rhighlights
2050 global selectedline ancestor
2052 if {![info exists selectedline]} return
2053 set isbold 0
2054 if {$highlight_related eq "Descendent" ||
2055 $highlight_related eq "Not descendent"} {
2056 if {![info exists descendent($id)]} {
2057 is_descendent $id
2059 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2060 set isbold 1
2062 } elseif {$highlight_related eq "Ancestor" ||
2063 $highlight_related eq "Not ancestor"} {
2064 if {![info exists ancestor($id)]} {
2065 is_ancestor $id
2067 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2068 set isbold 1
2071 if {[info exists iddrawn($id)]} {
2072 if {$isbold && ![ishighlighted $row]} {
2073 bolden $row [concat $mainfont bold]
2076 set rhighlights($row) $isbold
2079 proc next_hlcont {} {
2080 global fhl_row fhl_dirn displayorder numcommits
2081 global vhighlights fhighlights nhighlights rhighlights
2082 global hlview filehighlight findstring highlight_related
2084 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2085 set row $fhl_row
2086 while {1} {
2087 if {$row < 0 || $row >= $numcommits} {
2088 bell
2089 set fhl_dirn 0
2090 return
2092 set id [lindex $displayorder $row]
2093 if {[info exists hlview]} {
2094 if {![info exists vhighlights($row)]} {
2095 askvhighlight $row $id
2097 if {$vhighlights($row) > 0} break
2099 if {$findstring ne {}} {
2100 if {![info exists nhighlights($row)]} {
2101 askfindhighlight $row $id
2103 if {$nhighlights($row) > 0} break
2105 if {$highlight_related ne "None"} {
2106 if {![info exists rhighlights($row)]} {
2107 askrelhighlight $row $id
2109 if {$rhighlights($row) > 0} break
2111 if {[info exists filehighlight]} {
2112 if {![info exists fhighlights($row)]} {
2113 # ask for a few more while we're at it...
2114 set r $row
2115 for {set n 0} {$n < 100} {incr n} {
2116 if {![info exists fhighlights($r)]} {
2117 askfilehighlight $r [lindex $displayorder $r]
2119 incr r $fhl_dirn
2120 if {$r < 0 || $r >= $numcommits} break
2122 flushhighlights
2124 if {$fhighlights($row) < 0} {
2125 set fhl_row $row
2126 return
2128 if {$fhighlights($row) > 0} break
2130 incr row $fhl_dirn
2132 set fhl_dirn 0
2133 selectline $row 1
2136 proc next_highlight {dirn} {
2137 global selectedline fhl_row fhl_dirn
2138 global hlview filehighlight findstring highlight_related
2140 if {![info exists selectedline]} return
2141 if {!([info exists hlview] || $findstring ne {} ||
2142 $highlight_related ne "None" || [info exists filehighlight])} return
2143 set fhl_row [expr {$selectedline + $dirn}]
2144 set fhl_dirn $dirn
2145 next_hlcont
2148 proc cancel_next_highlight {} {
2149 global fhl_dirn
2151 set fhl_dirn 0
2154 # Graph layout functions
2156 proc shortids {ids} {
2157 set res {}
2158 foreach id $ids {
2159 if {[llength $id] > 1} {
2160 lappend res [shortids $id]
2161 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2162 lappend res [string range $id 0 7]
2163 } else {
2164 lappend res $id
2167 return $res
2170 proc incrange {l x o} {
2171 set n [llength $l]
2172 while {$x < $n} {
2173 set e [lindex $l $x]
2174 if {$e ne {}} {
2175 lset l $x [expr {$e + $o}]
2177 incr x
2179 return $l
2182 proc ntimes {n o} {
2183 set ret {}
2184 for {} {$n > 0} {incr n -1} {
2185 lappend ret $o
2187 return $ret
2190 proc usedinrange {id l1 l2} {
2191 global children commitrow childlist curview
2193 if {[info exists commitrow($curview,$id)]} {
2194 set r $commitrow($curview,$id)
2195 if {$l1 <= $r && $r <= $l2} {
2196 return [expr {$r - $l1 + 1}]
2198 set kids [lindex $childlist $r]
2199 } else {
2200 set kids $children($curview,$id)
2202 foreach c $kids {
2203 set r $commitrow($curview,$c)
2204 if {$l1 <= $r && $r <= $l2} {
2205 return [expr {$r - $l1 + 1}]
2208 return 0
2211 proc sanity {row {full 0}} {
2212 global rowidlist rowoffsets
2214 set col -1
2215 set ids [lindex $rowidlist $row]
2216 foreach id $ids {
2217 incr col
2218 if {$id eq {}} continue
2219 if {$col < [llength $ids] - 1 &&
2220 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2221 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2223 set o [lindex $rowoffsets $row $col]
2224 set y $row
2225 set x $col
2226 while {$o ne {}} {
2227 incr y -1
2228 incr x $o
2229 if {[lindex $rowidlist $y $x] != $id} {
2230 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2231 puts " id=[shortids $id] check started at row $row"
2232 for {set i $row} {$i >= $y} {incr i -1} {
2233 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2235 break
2237 if {!$full} break
2238 set o [lindex $rowoffsets $y $x]
2243 proc makeuparrow {oid x y z} {
2244 global rowidlist rowoffsets uparrowlen idrowranges
2246 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2247 incr y -1
2248 incr x $z
2249 set off0 [lindex $rowoffsets $y]
2250 for {set x0 $x} {1} {incr x0} {
2251 if {$x0 >= [llength $off0]} {
2252 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2253 break
2255 set z [lindex $off0 $x0]
2256 if {$z ne {}} {
2257 incr x0 $z
2258 break
2261 set z [expr {$x0 - $x}]
2262 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2263 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2265 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2266 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2267 lappend idrowranges($oid) $y
2270 proc initlayout {} {
2271 global rowidlist rowoffsets displayorder commitlisted
2272 global rowlaidout rowoptim
2273 global idinlist rowchk rowrangelist idrowranges
2274 global numcommits canvxmax canv
2275 global nextcolor
2276 global parentlist childlist children
2277 global colormap rowtextx
2278 global linesegends
2280 set numcommits 0
2281 set displayorder {}
2282 set commitlisted {}
2283 set parentlist {}
2284 set childlist {}
2285 set rowrangelist {}
2286 set nextcolor 0
2287 set rowidlist {{}}
2288 set rowoffsets {{}}
2289 catch {unset idinlist}
2290 catch {unset rowchk}
2291 set rowlaidout 0
2292 set rowoptim 0
2293 set canvxmax [$canv cget -width]
2294 catch {unset colormap}
2295 catch {unset rowtextx}
2296 catch {unset idrowranges}
2297 set linesegends {}
2300 proc setcanvscroll {} {
2301 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2303 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2304 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2305 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2306 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2309 proc visiblerows {} {
2310 global canv numcommits linespc
2312 set ymax [lindex [$canv cget -scrollregion] 3]
2313 if {$ymax eq {} || $ymax == 0} return
2314 set f [$canv yview]
2315 set y0 [expr {int([lindex $f 0] * $ymax)}]
2316 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2317 if {$r0 < 0} {
2318 set r0 0
2320 set y1 [expr {int([lindex $f 1] * $ymax)}]
2321 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2322 if {$r1 >= $numcommits} {
2323 set r1 [expr {$numcommits - 1}]
2325 return [list $r0 $r1]
2328 proc layoutmore {} {
2329 global rowlaidout rowoptim commitidx numcommits optim_delay
2330 global uparrowlen curview
2332 set row $rowlaidout
2333 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2334 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2335 if {$orow > $rowoptim} {
2336 optimize_rows $rowoptim 0 $orow
2337 set rowoptim $orow
2339 set canshow [expr {$rowoptim - $optim_delay}]
2340 if {$canshow > $numcommits} {
2341 showstuff $canshow
2345 proc showstuff {canshow} {
2346 global numcommits commitrow pending_select selectedline
2347 global linesegends idrowranges idrangedrawn curview
2349 if {$numcommits == 0} {
2350 global phase
2351 set phase "incrdraw"
2352 allcanvs delete all
2354 set row $numcommits
2355 set numcommits $canshow
2356 setcanvscroll
2357 set rows [visiblerows]
2358 set r0 [lindex $rows 0]
2359 set r1 [lindex $rows 1]
2360 set selrow -1
2361 for {set r $row} {$r < $canshow} {incr r} {
2362 foreach id [lindex $linesegends [expr {$r+1}]] {
2363 set i -1
2364 foreach {s e} [rowranges $id] {
2365 incr i
2366 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2367 && ![info exists idrangedrawn($id,$i)]} {
2368 drawlineseg $id $i
2369 set idrangedrawn($id,$i) 1
2374 if {$canshow > $r1} {
2375 set canshow $r1
2377 while {$row < $canshow} {
2378 drawcmitrow $row
2379 incr row
2381 if {[info exists pending_select] &&
2382 [info exists commitrow($curview,$pending_select)] &&
2383 $commitrow($curview,$pending_select) < $numcommits} {
2384 selectline $commitrow($curview,$pending_select) 1
2386 if {![info exists selectedline] && ![info exists pending_select]} {
2387 selectline 0 1
2391 proc layoutrows {row endrow last} {
2392 global rowidlist rowoffsets displayorder
2393 global uparrowlen downarrowlen maxwidth mingaplen
2394 global childlist parentlist
2395 global idrowranges linesegends
2396 global commitidx curview
2397 global idinlist rowchk rowrangelist
2399 set idlist [lindex $rowidlist $row]
2400 set offs [lindex $rowoffsets $row]
2401 while {$row < $endrow} {
2402 set id [lindex $displayorder $row]
2403 set oldolds {}
2404 set newolds {}
2405 foreach p [lindex $parentlist $row] {
2406 if {![info exists idinlist($p)]} {
2407 lappend newolds $p
2408 } elseif {!$idinlist($p)} {
2409 lappend oldolds $p
2412 set lse {}
2413 set nev [expr {[llength $idlist] + [llength $newolds]
2414 + [llength $oldolds] - $maxwidth + 1}]
2415 if {$nev > 0} {
2416 if {!$last &&
2417 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2418 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2419 set i [lindex $idlist $x]
2420 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2421 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2422 [expr {$row + $uparrowlen + $mingaplen}]]
2423 if {$r == 0} {
2424 set idlist [lreplace $idlist $x $x]
2425 set offs [lreplace $offs $x $x]
2426 set offs [incrange $offs $x 1]
2427 set idinlist($i) 0
2428 set rm1 [expr {$row - 1}]
2429 lappend lse $i
2430 lappend idrowranges($i) $rm1
2431 if {[incr nev -1] <= 0} break
2432 continue
2434 set rowchk($id) [expr {$row + $r}]
2437 lset rowidlist $row $idlist
2438 lset rowoffsets $row $offs
2440 lappend linesegends $lse
2441 set col [lsearch -exact $idlist $id]
2442 if {$col < 0} {
2443 set col [llength $idlist]
2444 lappend idlist $id
2445 lset rowidlist $row $idlist
2446 set z {}
2447 if {[lindex $childlist $row] ne {}} {
2448 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2449 unset idinlist($id)
2451 lappend offs $z
2452 lset rowoffsets $row $offs
2453 if {$z ne {}} {
2454 makeuparrow $id $col $row $z
2456 } else {
2457 unset idinlist($id)
2459 set ranges {}
2460 if {[info exists idrowranges($id)]} {
2461 set ranges $idrowranges($id)
2462 lappend ranges $row
2463 unset idrowranges($id)
2465 lappend rowrangelist $ranges
2466 incr row
2467 set offs [ntimes [llength $idlist] 0]
2468 set l [llength $newolds]
2469 set idlist [eval lreplace \$idlist $col $col $newolds]
2470 set o 0
2471 if {$l != 1} {
2472 set offs [lrange $offs 0 [expr {$col - 1}]]
2473 foreach x $newolds {
2474 lappend offs {}
2475 incr o -1
2477 incr o
2478 set tmp [expr {[llength $idlist] - [llength $offs]}]
2479 if {$tmp > 0} {
2480 set offs [concat $offs [ntimes $tmp $o]]
2482 } else {
2483 lset offs $col {}
2485 foreach i $newolds {
2486 set idinlist($i) 1
2487 set idrowranges($i) $row
2489 incr col $l
2490 foreach oid $oldolds {
2491 set idinlist($oid) 1
2492 set idlist [linsert $idlist $col $oid]
2493 set offs [linsert $offs $col $o]
2494 makeuparrow $oid $col $row $o
2495 incr col
2497 lappend rowidlist $idlist
2498 lappend rowoffsets $offs
2500 return $row
2503 proc addextraid {id row} {
2504 global displayorder commitrow commitinfo
2505 global commitidx commitlisted
2506 global parentlist childlist children curview
2508 incr commitidx($curview)
2509 lappend displayorder $id
2510 lappend commitlisted 0
2511 lappend parentlist {}
2512 set commitrow($curview,$id) $row
2513 readcommit $id
2514 if {![info exists commitinfo($id)]} {
2515 set commitinfo($id) {"No commit information available"}
2517 if {![info exists children($curview,$id)]} {
2518 set children($curview,$id) {}
2520 lappend childlist $children($curview,$id)
2523 proc layouttail {} {
2524 global rowidlist rowoffsets idinlist commitidx curview
2525 global idrowranges rowrangelist
2527 set row $commitidx($curview)
2528 set idlist [lindex $rowidlist $row]
2529 while {$idlist ne {}} {
2530 set col [expr {[llength $idlist] - 1}]
2531 set id [lindex $idlist $col]
2532 addextraid $id $row
2533 unset idinlist($id)
2534 lappend idrowranges($id) $row
2535 lappend rowrangelist $idrowranges($id)
2536 unset idrowranges($id)
2537 incr row
2538 set offs [ntimes $col 0]
2539 set idlist [lreplace $idlist $col $col]
2540 lappend rowidlist $idlist
2541 lappend rowoffsets $offs
2544 foreach id [array names idinlist] {
2545 addextraid $id $row
2546 lset rowidlist $row [list $id]
2547 lset rowoffsets $row 0
2548 makeuparrow $id 0 $row 0
2549 lappend idrowranges($id) $row
2550 lappend rowrangelist $idrowranges($id)
2551 unset idrowranges($id)
2552 incr row
2553 lappend rowidlist {}
2554 lappend rowoffsets {}
2558 proc insert_pad {row col npad} {
2559 global rowidlist rowoffsets
2561 set pad [ntimes $npad {}]
2562 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2563 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2564 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2567 proc optimize_rows {row col endrow} {
2568 global rowidlist rowoffsets idrowranges displayorder
2570 for {} {$row < $endrow} {incr row} {
2571 set idlist [lindex $rowidlist $row]
2572 set offs [lindex $rowoffsets $row]
2573 set haspad 0
2574 for {} {$col < [llength $offs]} {incr col} {
2575 if {[lindex $idlist $col] eq {}} {
2576 set haspad 1
2577 continue
2579 set z [lindex $offs $col]
2580 if {$z eq {}} continue
2581 set isarrow 0
2582 set x0 [expr {$col + $z}]
2583 set y0 [expr {$row - 1}]
2584 set z0 [lindex $rowoffsets $y0 $x0]
2585 if {$z0 eq {}} {
2586 set id [lindex $idlist $col]
2587 set ranges [rowranges $id]
2588 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2589 set isarrow 1
2592 if {$z < -1 || ($z < 0 && $isarrow)} {
2593 set npad [expr {-1 - $z + $isarrow}]
2594 set offs [incrange $offs $col $npad]
2595 insert_pad $y0 $x0 $npad
2596 if {$y0 > 0} {
2597 optimize_rows $y0 $x0 $row
2599 set z [lindex $offs $col]
2600 set x0 [expr {$col + $z}]
2601 set z0 [lindex $rowoffsets $y0 $x0]
2602 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2603 set npad [expr {$z - 1 + $isarrow}]
2604 set y1 [expr {$row + 1}]
2605 set offs2 [lindex $rowoffsets $y1]
2606 set x1 -1
2607 foreach z $offs2 {
2608 incr x1
2609 if {$z eq {} || $x1 + $z < $col} continue
2610 if {$x1 + $z > $col} {
2611 incr npad
2613 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2614 break
2616 set pad [ntimes $npad {}]
2617 set idlist [eval linsert \$idlist $col $pad]
2618 set tmp [eval linsert \$offs $col $pad]
2619 incr col $npad
2620 set offs [incrange $tmp $col [expr {-$npad}]]
2621 set z [lindex $offs $col]
2622 set haspad 1
2624 if {$z0 eq {} && !$isarrow} {
2625 # this line links to its first child on row $row-2
2626 set rm2 [expr {$row - 2}]
2627 set id [lindex $displayorder $rm2]
2628 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2629 if {$xc >= 0} {
2630 set z0 [expr {$xc - $x0}]
2633 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2634 insert_pad $y0 $x0 1
2635 set offs [incrange $offs $col 1]
2636 optimize_rows $y0 [expr {$x0 + 1}] $row
2639 if {!$haspad} {
2640 set o {}
2641 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2642 set o [lindex $offs $col]
2643 if {$o eq {}} {
2644 # check if this is the link to the first child
2645 set id [lindex $idlist $col]
2646 set ranges [rowranges $id]
2647 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2648 # it is, work out offset to child
2649 set y0 [expr {$row - 1}]
2650 set id [lindex $displayorder $y0]
2651 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2652 if {$x0 >= 0} {
2653 set o [expr {$x0 - $col}]
2657 if {$o eq {} || $o <= 0} break
2659 if {$o ne {} && [incr col] < [llength $idlist]} {
2660 set y1 [expr {$row + 1}]
2661 set offs2 [lindex $rowoffsets $y1]
2662 set x1 -1
2663 foreach z $offs2 {
2664 incr x1
2665 if {$z eq {} || $x1 + $z < $col} continue
2666 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2667 break
2669 set idlist [linsert $idlist $col {}]
2670 set tmp [linsert $offs $col {}]
2671 incr col
2672 set offs [incrange $tmp $col -1]
2675 lset rowidlist $row $idlist
2676 lset rowoffsets $row $offs
2677 set col 0
2681 proc xc {row col} {
2682 global canvx0 linespc
2683 return [expr {$canvx0 + $col * $linespc}]
2686 proc yc {row} {
2687 global canvy0 linespc
2688 return [expr {$canvy0 + $row * $linespc}]
2691 proc linewidth {id} {
2692 global thickerline lthickness
2694 set wid $lthickness
2695 if {[info exists thickerline] && $id eq $thickerline} {
2696 set wid [expr {2 * $lthickness}]
2698 return $wid
2701 proc rowranges {id} {
2702 global phase idrowranges commitrow rowlaidout rowrangelist curview
2704 set ranges {}
2705 if {$phase eq {} ||
2706 ([info exists commitrow($curview,$id)]
2707 && $commitrow($curview,$id) < $rowlaidout)} {
2708 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2709 } elseif {[info exists idrowranges($id)]} {
2710 set ranges $idrowranges($id)
2712 return $ranges
2715 proc drawlineseg {id i} {
2716 global rowoffsets rowidlist
2717 global displayorder
2718 global canv colormap linespc
2719 global numcommits commitrow curview
2721 set ranges [rowranges $id]
2722 set downarrow 1
2723 if {[info exists commitrow($curview,$id)]
2724 && $commitrow($curview,$id) < $numcommits} {
2725 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2726 } else {
2727 set downarrow 1
2729 set startrow [lindex $ranges [expr {2 * $i}]]
2730 set row [lindex $ranges [expr {2 * $i + 1}]]
2731 if {$startrow == $row} return
2732 assigncolor $id
2733 set coords {}
2734 set col [lsearch -exact [lindex $rowidlist $row] $id]
2735 if {$col < 0} {
2736 puts "oops: drawline: id $id not on row $row"
2737 return
2739 set lasto {}
2740 set ns 0
2741 while {1} {
2742 set o [lindex $rowoffsets $row $col]
2743 if {$o eq {}} break
2744 if {$o ne $lasto} {
2745 # changing direction
2746 set x [xc $row $col]
2747 set y [yc $row]
2748 lappend coords $x $y
2749 set lasto $o
2751 incr col $o
2752 incr row -1
2754 set x [xc $row $col]
2755 set y [yc $row]
2756 lappend coords $x $y
2757 if {$i == 0} {
2758 # draw the link to the first child as part of this line
2759 incr row -1
2760 set child [lindex $displayorder $row]
2761 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2762 if {$ccol >= 0} {
2763 set x [xc $row $ccol]
2764 set y [yc $row]
2765 if {$ccol < $col - 1} {
2766 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2767 } elseif {$ccol > $col + 1} {
2768 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2770 lappend coords $x $y
2773 if {[llength $coords] < 4} return
2774 if {$downarrow} {
2775 # This line has an arrow at the lower end: check if the arrow is
2776 # on a diagonal segment, and if so, work around the Tk 8.4
2777 # refusal to draw arrows on diagonal lines.
2778 set x0 [lindex $coords 0]
2779 set x1 [lindex $coords 2]
2780 if {$x0 != $x1} {
2781 set y0 [lindex $coords 1]
2782 set y1 [lindex $coords 3]
2783 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2784 # we have a nearby vertical segment, just trim off the diag bit
2785 set coords [lrange $coords 2 end]
2786 } else {
2787 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2788 set xi [expr {$x0 - $slope * $linespc / 2}]
2789 set yi [expr {$y0 - $linespc / 2}]
2790 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2794 set arrow [expr {2 * ($i > 0) + $downarrow}]
2795 set arrow [lindex {none first last both} $arrow]
2796 set t [$canv create line $coords -width [linewidth $id] \
2797 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2798 $canv lower $t
2799 bindline $t $id
2802 proc drawparentlinks {id row col olds} {
2803 global rowidlist canv colormap
2805 set row2 [expr {$row + 1}]
2806 set x [xc $row $col]
2807 set y [yc $row]
2808 set y2 [yc $row2]
2809 set ids [lindex $rowidlist $row2]
2810 # rmx = right-most X coord used
2811 set rmx 0
2812 foreach p $olds {
2813 set i [lsearch -exact $ids $p]
2814 if {$i < 0} {
2815 puts "oops, parent $p of $id not in list"
2816 continue
2818 set x2 [xc $row2 $i]
2819 if {$x2 > $rmx} {
2820 set rmx $x2
2822 set ranges [rowranges $p]
2823 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2824 && $row2 < [lindex $ranges 1]} {
2825 # drawlineseg will do this one for us
2826 continue
2828 assigncolor $p
2829 # should handle duplicated parents here...
2830 set coords [list $x $y]
2831 if {$i < $col - 1} {
2832 lappend coords [xc $row [expr {$i + 1}]] $y
2833 } elseif {$i > $col + 1} {
2834 lappend coords [xc $row [expr {$i - 1}]] $y
2836 lappend coords $x2 $y2
2837 set t [$canv create line $coords -width [linewidth $p] \
2838 -fill $colormap($p) -tags lines.$p]
2839 $canv lower $t
2840 bindline $t $p
2842 return $rmx
2845 proc drawlines {id} {
2846 global colormap canv
2847 global idrangedrawn
2848 global children iddrawn commitrow rowidlist curview
2850 $canv delete lines.$id
2851 set nr [expr {[llength [rowranges $id]] / 2}]
2852 for {set i 0} {$i < $nr} {incr i} {
2853 if {[info exists idrangedrawn($id,$i)]} {
2854 drawlineseg $id $i
2857 foreach child $children($curview,$id) {
2858 if {[info exists iddrawn($child)]} {
2859 set row $commitrow($curview,$child)
2860 set col [lsearch -exact [lindex $rowidlist $row] $child]
2861 if {$col >= 0} {
2862 drawparentlinks $child $row $col [list $id]
2868 proc drawcmittext {id row col rmx} {
2869 global linespc canv canv2 canv3 canvy0
2870 global commitlisted commitinfo rowidlist
2871 global rowtextx idpos idtags idheads idotherrefs
2872 global linehtag linentag linedtag
2873 global mainfont canvxmax boldrows boldnamerows
2875 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2876 set x [xc $row $col]
2877 set y [yc $row]
2878 set orad [expr {$linespc / 3}]
2879 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2880 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2881 -fill $ofill -outline black -width 1]
2882 $canv raise $t
2883 $canv bind $t <1> {selcanvline {} %x %y}
2884 set xt [xc $row [llength [lindex $rowidlist $row]]]
2885 if {$xt < $rmx} {
2886 set xt $rmx
2888 set rowtextx($row) $xt
2889 set idpos($id) [list $x $xt $y]
2890 if {[info exists idtags($id)] || [info exists idheads($id)]
2891 || [info exists idotherrefs($id)]} {
2892 set xt [drawtags $id $x $xt $y]
2894 set headline [lindex $commitinfo($id) 0]
2895 set name [lindex $commitinfo($id) 1]
2896 set date [lindex $commitinfo($id) 2]
2897 set date [formatdate $date]
2898 set font $mainfont
2899 set nfont $mainfont
2900 set isbold [ishighlighted $row]
2901 if {$isbold > 0} {
2902 lappend boldrows $row
2903 lappend font bold
2904 if {$isbold > 1} {
2905 lappend boldnamerows $row
2906 lappend nfont bold
2909 set linehtag($row) [$canv create text $xt $y -anchor w \
2910 -text $headline -font $font]
2911 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2912 set linentag($row) [$canv2 create text 3 $y -anchor w \
2913 -text $name -font $nfont]
2914 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2915 -text $date -font $mainfont]
2916 set xr [expr {$xt + [font measure $mainfont $headline]}]
2917 if {$xr > $canvxmax} {
2918 set canvxmax $xr
2919 setcanvscroll
2923 proc drawcmitrow {row} {
2924 global displayorder rowidlist
2925 global idrangedrawn iddrawn
2926 global commitinfo parentlist numcommits
2927 global filehighlight fhighlights findstring nhighlights
2928 global hlview vhighlights
2929 global highlight_related rhighlights
2931 if {$row >= $numcommits} return
2932 foreach id [lindex $rowidlist $row] {
2933 if {$id eq {}} continue
2934 set i -1
2935 foreach {s e} [rowranges $id] {
2936 incr i
2937 if {$row < $s} continue
2938 if {$e eq {}} break
2939 if {$row <= $e} {
2940 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2941 drawlineseg $id $i
2942 set idrangedrawn($id,$i) 1
2944 break
2949 set id [lindex $displayorder $row]
2950 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2951 askvhighlight $row $id
2953 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2954 askfilehighlight $row $id
2956 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2957 askfindhighlight $row $id
2959 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2960 askrelhighlight $row $id
2962 if {[info exists iddrawn($id)]} return
2963 set col [lsearch -exact [lindex $rowidlist $row] $id]
2964 if {$col < 0} {
2965 puts "oops, row $row id $id not in list"
2966 return
2968 if {![info exists commitinfo($id)]} {
2969 getcommit $id
2971 assigncolor $id
2972 set olds [lindex $parentlist $row]
2973 if {$olds ne {}} {
2974 set rmx [drawparentlinks $id $row $col $olds]
2975 } else {
2976 set rmx 0
2978 drawcmittext $id $row $col $rmx
2979 set iddrawn($id) 1
2982 proc drawfrac {f0 f1} {
2983 global numcommits canv
2984 global linespc
2986 set ymax [lindex [$canv cget -scrollregion] 3]
2987 if {$ymax eq {} || $ymax == 0} return
2988 set y0 [expr {int($f0 * $ymax)}]
2989 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2990 if {$row < 0} {
2991 set row 0
2993 set y1 [expr {int($f1 * $ymax)}]
2994 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2995 if {$endrow >= $numcommits} {
2996 set endrow [expr {$numcommits - 1}]
2998 for {} {$row <= $endrow} {incr row} {
2999 drawcmitrow $row
3003 proc drawvisible {} {
3004 global canv
3005 eval drawfrac [$canv yview]
3008 proc clear_display {} {
3009 global iddrawn idrangedrawn
3010 global vhighlights fhighlights nhighlights rhighlights
3012 allcanvs delete all
3013 catch {unset iddrawn}
3014 catch {unset idrangedrawn}
3015 catch {unset vhighlights}
3016 catch {unset fhighlights}
3017 catch {unset nhighlights}
3018 catch {unset rhighlights}
3021 proc findcrossings {id} {
3022 global rowidlist parentlist numcommits rowoffsets displayorder
3024 set cross {}
3025 set ccross {}
3026 foreach {s e} [rowranges $id] {
3027 if {$e >= $numcommits} {
3028 set e [expr {$numcommits - 1}]
3030 if {$e <= $s} continue
3031 set x [lsearch -exact [lindex $rowidlist $e] $id]
3032 if {$x < 0} {
3033 puts "findcrossings: oops, no [shortids $id] in row $e"
3034 continue
3036 for {set row $e} {[incr row -1] >= $s} {} {
3037 set olds [lindex $parentlist $row]
3038 set kid [lindex $displayorder $row]
3039 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3040 if {$kidx < 0} continue
3041 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3042 foreach p $olds {
3043 set px [lsearch -exact $nextrow $p]
3044 if {$px < 0} continue
3045 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3046 if {[lsearch -exact $ccross $p] >= 0} continue
3047 if {$x == $px + ($kidx < $px? -1: 1)} {
3048 lappend ccross $p
3049 } elseif {[lsearch -exact $cross $p] < 0} {
3050 lappend cross $p
3054 set inc [lindex $rowoffsets $row $x]
3055 if {$inc eq {}} break
3056 incr x $inc
3059 return [concat $ccross {{}} $cross]
3062 proc assigncolor {id} {
3063 global colormap colors nextcolor
3064 global commitrow parentlist children children curview
3066 if {[info exists colormap($id)]} return
3067 set ncolors [llength $colors]
3068 if {[info exists children($curview,$id)]} {
3069 set kids $children($curview,$id)
3070 } else {
3071 set kids {}
3073 if {[llength $kids] == 1} {
3074 set child [lindex $kids 0]
3075 if {[info exists colormap($child)]
3076 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3077 set colormap($id) $colormap($child)
3078 return
3081 set badcolors {}
3082 set origbad {}
3083 foreach x [findcrossings $id] {
3084 if {$x eq {}} {
3085 # delimiter between corner crossings and other crossings
3086 if {[llength $badcolors] >= $ncolors - 1} break
3087 set origbad $badcolors
3089 if {[info exists colormap($x)]
3090 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3091 lappend badcolors $colormap($x)
3094 if {[llength $badcolors] >= $ncolors} {
3095 set badcolors $origbad
3097 set origbad $badcolors
3098 if {[llength $badcolors] < $ncolors - 1} {
3099 foreach child $kids {
3100 if {[info exists colormap($child)]
3101 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3102 lappend badcolors $colormap($child)
3104 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3105 if {[info exists colormap($p)]
3106 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3107 lappend badcolors $colormap($p)
3111 if {[llength $badcolors] >= $ncolors} {
3112 set badcolors $origbad
3115 for {set i 0} {$i <= $ncolors} {incr i} {
3116 set c [lindex $colors $nextcolor]
3117 if {[incr nextcolor] >= $ncolors} {
3118 set nextcolor 0
3120 if {[lsearch -exact $badcolors $c]} break
3122 set colormap($id) $c
3125 proc bindline {t id} {
3126 global canv
3128 $canv bind $t <Enter> "lineenter %x %y $id"
3129 $canv bind $t <Motion> "linemotion %x %y $id"
3130 $canv bind $t <Leave> "lineleave $id"
3131 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3134 proc drawtags {id x xt y1} {
3135 global idtags idheads idotherrefs
3136 global linespc lthickness
3137 global canv mainfont commitrow rowtextx curview
3139 set marks {}
3140 set ntags 0
3141 set nheads 0
3142 if {[info exists idtags($id)]} {
3143 set marks $idtags($id)
3144 set ntags [llength $marks]
3146 if {[info exists idheads($id)]} {
3147 set marks [concat $marks $idheads($id)]
3148 set nheads [llength $idheads($id)]
3150 if {[info exists idotherrefs($id)]} {
3151 set marks [concat $marks $idotherrefs($id)]
3153 if {$marks eq {}} {
3154 return $xt
3157 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3158 set yt [expr {$y1 - 0.5 * $linespc}]
3159 set yb [expr {$yt + $linespc - 1}]
3160 set xvals {}
3161 set wvals {}
3162 foreach tag $marks {
3163 set wid [font measure $mainfont $tag]
3164 lappend xvals $xt
3165 lappend wvals $wid
3166 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3168 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3169 -width $lthickness -fill black -tags tag.$id]
3170 $canv lower $t
3171 foreach tag $marks x $xvals wid $wvals {
3172 set xl [expr {$x + $delta}]
3173 set xr [expr {$x + $delta + $wid + $lthickness}]
3174 if {[incr ntags -1] >= 0} {
3175 # draw a tag
3176 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3177 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3178 -width 1 -outline black -fill yellow -tags tag.$id]
3179 $canv bind $t <1> [list showtag $tag 1]
3180 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3181 } else {
3182 # draw a head or other ref
3183 if {[incr nheads -1] >= 0} {
3184 set col green
3185 } else {
3186 set col "#ddddff"
3188 set xl [expr {$xl - $delta/2}]
3189 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3190 -width 1 -outline black -fill $col -tags tag.$id
3191 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3192 set rwid [font measure $mainfont $remoteprefix]
3193 set xi [expr {$x + 1}]
3194 set yti [expr {$yt + 1}]
3195 set xri [expr {$x + $rwid}]
3196 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3197 -width 0 -fill "#ffddaa" -tags tag.$id
3200 set t [$canv create text $xl $y1 -anchor w -text $tag \
3201 -font $mainfont -tags tag.$id]
3202 if {$ntags >= 0} {
3203 $canv bind $t <1> [list showtag $tag 1]
3206 return $xt
3209 proc xcoord {i level ln} {
3210 global canvx0 xspc1 xspc2
3212 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3213 if {$i > 0 && $i == $level} {
3214 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3215 } elseif {$i > $level} {
3216 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3218 return $x
3221 proc show_status {msg} {
3222 global canv mainfont
3224 clear_display
3225 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3228 proc finishcommits {} {
3229 global commitidx phase curview
3230 global canv mainfont ctext maincursor textcursor
3231 global findinprogress pending_select
3233 if {$commitidx($curview) > 0} {
3234 drawrest
3235 } else {
3236 show_status "No commits selected"
3238 set phase {}
3239 catch {unset pending_select}
3242 # Don't change the text pane cursor if it is currently the hand cursor,
3243 # showing that we are over a sha1 ID link.
3244 proc settextcursor {c} {
3245 global ctext curtextcursor
3247 if {[$ctext cget -cursor] == $curtextcursor} {
3248 $ctext config -cursor $c
3250 set curtextcursor $c
3253 proc nowbusy {what} {
3254 global isbusy
3256 if {[array names isbusy] eq {}} {
3257 . config -cursor watch
3258 settextcursor watch
3260 set isbusy($what) 1
3263 proc notbusy {what} {
3264 global isbusy maincursor textcursor
3266 catch {unset isbusy($what)}
3267 if {[array names isbusy] eq {}} {
3268 . config -cursor $maincursor
3269 settextcursor $textcursor
3273 proc drawrest {} {
3274 global numcommits
3275 global startmsecs
3276 global canvy0 numcommits linespc
3277 global rowlaidout commitidx curview
3278 global pending_select
3280 set row $rowlaidout
3281 layoutrows $rowlaidout $commitidx($curview) 1
3282 layouttail
3283 optimize_rows $row 0 $commitidx($curview)
3284 showstuff $commitidx($curview)
3285 if {[info exists pending_select]} {
3286 selectline 0 1
3289 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3290 #puts "overall $drawmsecs ms for $numcommits commits"
3293 proc findmatches {f} {
3294 global findtype foundstring foundstrlen
3295 if {$findtype == "Regexp"} {
3296 set matches [regexp -indices -all -inline $foundstring $f]
3297 } else {
3298 if {$findtype == "IgnCase"} {
3299 set str [string tolower $f]
3300 } else {
3301 set str $f
3303 set matches {}
3304 set i 0
3305 while {[set j [string first $foundstring $str $i]] >= 0} {
3306 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3307 set i [expr {$j + $foundstrlen}]
3310 return $matches
3313 proc dofind {} {
3314 global findtype findloc findstring markedmatches commitinfo
3315 global numcommits displayorder linehtag linentag linedtag
3316 global mainfont canv canv2 canv3 selectedline
3317 global matchinglines foundstring foundstrlen matchstring
3318 global commitdata
3320 stopfindproc
3321 unmarkmatches
3322 cancel_next_highlight
3323 focus .
3324 set matchinglines {}
3325 if {$findtype == "IgnCase"} {
3326 set foundstring [string tolower $findstring]
3327 } else {
3328 set foundstring $findstring
3330 set foundstrlen [string length $findstring]
3331 if {$foundstrlen == 0} return
3332 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3333 set matchstring "*$matchstring*"
3334 if {![info exists selectedline]} {
3335 set oldsel -1
3336 } else {
3337 set oldsel $selectedline
3339 set didsel 0
3340 set fldtypes {Headline Author Date Committer CDate Comments}
3341 set l -1
3342 foreach id $displayorder {
3343 set d $commitdata($id)
3344 incr l
3345 if {$findtype == "Regexp"} {
3346 set doesmatch [regexp $foundstring $d]
3347 } elseif {$findtype == "IgnCase"} {
3348 set doesmatch [string match -nocase $matchstring $d]
3349 } else {
3350 set doesmatch [string match $matchstring $d]
3352 if {!$doesmatch} continue
3353 if {![info exists commitinfo($id)]} {
3354 getcommit $id
3356 set info $commitinfo($id)
3357 set doesmatch 0
3358 foreach f $info ty $fldtypes {
3359 if {$findloc != "All fields" && $findloc != $ty} {
3360 continue
3362 set matches [findmatches $f]
3363 if {$matches == {}} continue
3364 set doesmatch 1
3365 if {$ty == "Headline"} {
3366 drawcmitrow $l
3367 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3368 } elseif {$ty == "Author"} {
3369 drawcmitrow $l
3370 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3371 } elseif {$ty == "Date"} {
3372 drawcmitrow $l
3373 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3376 if {$doesmatch} {
3377 lappend matchinglines $l
3378 if {!$didsel && $l > $oldsel} {
3379 findselectline $l
3380 set didsel 1
3384 if {$matchinglines == {}} {
3385 bell
3386 } elseif {!$didsel} {
3387 findselectline [lindex $matchinglines 0]
3391 proc findselectline {l} {
3392 global findloc commentend ctext
3393 selectline $l 1
3394 if {$findloc == "All fields" || $findloc == "Comments"} {
3395 # highlight the matches in the comments
3396 set f [$ctext get 1.0 $commentend]
3397 set matches [findmatches $f]
3398 foreach match $matches {
3399 set start [lindex $match 0]
3400 set end [expr {[lindex $match 1] + 1}]
3401 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3406 proc findnext {restart} {
3407 global matchinglines selectedline
3408 if {![info exists matchinglines]} {
3409 if {$restart} {
3410 dofind
3412 return
3414 if {![info exists selectedline]} return
3415 foreach l $matchinglines {
3416 if {$l > $selectedline} {
3417 findselectline $l
3418 return
3421 bell
3424 proc findprev {} {
3425 global matchinglines selectedline
3426 if {![info exists matchinglines]} {
3427 dofind
3428 return
3430 if {![info exists selectedline]} return
3431 set prev {}
3432 foreach l $matchinglines {
3433 if {$l >= $selectedline} break
3434 set prev $l
3436 if {$prev != {}} {
3437 findselectline $prev
3438 } else {
3439 bell
3443 proc stopfindproc {{done 0}} {
3444 global findprocpid findprocfile findids
3445 global ctext findoldcursor phase maincursor textcursor
3446 global findinprogress
3448 catch {unset findids}
3449 if {[info exists findprocpid]} {
3450 if {!$done} {
3451 catch {exec kill $findprocpid}
3453 catch {close $findprocfile}
3454 unset findprocpid
3456 catch {unset findinprogress}
3457 notbusy find
3460 # mark a commit as matching by putting a yellow background
3461 # behind the headline
3462 proc markheadline {l id} {
3463 global canv mainfont linehtag
3465 drawcmitrow $l
3466 set bbox [$canv bbox $linehtag($l)]
3467 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3468 $canv lower $t
3471 # mark the bits of a headline, author or date that match a find string
3472 proc markmatches {canv l str tag matches font} {
3473 set bbox [$canv bbox $tag]
3474 set x0 [lindex $bbox 0]
3475 set y0 [lindex $bbox 1]
3476 set y1 [lindex $bbox 3]
3477 foreach match $matches {
3478 set start [lindex $match 0]
3479 set end [lindex $match 1]
3480 if {$start > $end} continue
3481 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3482 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3483 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3484 [expr {$x0+$xlen+2}] $y1 \
3485 -outline {} -tags matches -fill yellow]
3486 $canv lower $t
3490 proc unmarkmatches {} {
3491 global matchinglines findids
3492 allcanvs delete matches
3493 catch {unset matchinglines}
3494 catch {unset findids}
3497 proc selcanvline {w x y} {
3498 global canv canvy0 ctext linespc
3499 global rowtextx
3500 set ymax [lindex [$canv cget -scrollregion] 3]
3501 if {$ymax == {}} return
3502 set yfrac [lindex [$canv yview] 0]
3503 set y [expr {$y + $yfrac * $ymax}]
3504 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3505 if {$l < 0} {
3506 set l 0
3508 if {$w eq $canv} {
3509 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3511 unmarkmatches
3512 selectline $l 1
3515 proc commit_descriptor {p} {
3516 global commitinfo
3517 if {![info exists commitinfo($p)]} {
3518 getcommit $p
3520 set l "..."
3521 if {[llength $commitinfo($p)] > 1} {
3522 set l [lindex $commitinfo($p) 0]
3524 return "$p ($l)"
3527 # append some text to the ctext widget, and make any SHA1 ID
3528 # that we know about be a clickable link.
3529 proc appendwithlinks {text} {
3530 global ctext commitrow linknum curview
3532 set start [$ctext index "end - 1c"]
3533 $ctext insert end $text
3534 $ctext insert end "\n"
3535 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3536 foreach l $links {
3537 set s [lindex $l 0]
3538 set e [lindex $l 1]
3539 set linkid [string range $text $s $e]
3540 if {![info exists commitrow($curview,$linkid)]} continue
3541 incr e
3542 $ctext tag add link "$start + $s c" "$start + $e c"
3543 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3544 $ctext tag bind link$linknum <1> \
3545 [list selectline $commitrow($curview,$linkid) 1]
3546 incr linknum
3548 $ctext tag conf link -foreground blue -underline 1
3549 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3550 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3553 proc viewnextline {dir} {
3554 global canv linespc
3556 $canv delete hover
3557 set ymax [lindex [$canv cget -scrollregion] 3]
3558 set wnow [$canv yview]
3559 set wtop [expr {[lindex $wnow 0] * $ymax}]
3560 set newtop [expr {$wtop + $dir * $linespc}]
3561 if {$newtop < 0} {
3562 set newtop 0
3563 } elseif {$newtop > $ymax} {
3564 set newtop $ymax
3566 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3569 proc selectline {l isnew} {
3570 global canv canv2 canv3 ctext commitinfo selectedline
3571 global displayorder linehtag linentag linedtag
3572 global canvy0 linespc parentlist childlist
3573 global currentid sha1entry
3574 global commentend idtags linknum
3575 global mergemax numcommits pending_select
3576 global cmitmode
3578 catch {unset pending_select}
3579 $canv delete hover
3580 normalline
3581 cancel_next_highlight
3582 if {$l < 0 || $l >= $numcommits} return
3583 set y [expr {$canvy0 + $l * $linespc}]
3584 set ymax [lindex [$canv cget -scrollregion] 3]
3585 set ytop [expr {$y - $linespc - 1}]
3586 set ybot [expr {$y + $linespc + 1}]
3587 set wnow [$canv yview]
3588 set wtop [expr {[lindex $wnow 0] * $ymax}]
3589 set wbot [expr {[lindex $wnow 1] * $ymax}]
3590 set wh [expr {$wbot - $wtop}]
3591 set newtop $wtop
3592 if {$ytop < $wtop} {
3593 if {$ybot < $wtop} {
3594 set newtop [expr {$y - $wh / 2.0}]
3595 } else {
3596 set newtop $ytop
3597 if {$newtop > $wtop - $linespc} {
3598 set newtop [expr {$wtop - $linespc}]
3601 } elseif {$ybot > $wbot} {
3602 if {$ytop > $wbot} {
3603 set newtop [expr {$y - $wh / 2.0}]
3604 } else {
3605 set newtop [expr {$ybot - $wh}]
3606 if {$newtop < $wtop + $linespc} {
3607 set newtop [expr {$wtop + $linespc}]
3611 if {$newtop != $wtop} {
3612 if {$newtop < 0} {
3613 set newtop 0
3615 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3616 drawvisible
3619 if {![info exists linehtag($l)]} return
3620 $canv delete secsel
3621 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3622 -tags secsel -fill [$canv cget -selectbackground]]
3623 $canv lower $t
3624 $canv2 delete secsel
3625 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3626 -tags secsel -fill [$canv2 cget -selectbackground]]
3627 $canv2 lower $t
3628 $canv3 delete secsel
3629 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3630 -tags secsel -fill [$canv3 cget -selectbackground]]
3631 $canv3 lower $t
3633 if {$isnew} {
3634 addtohistory [list selectline $l 0]
3637 set selectedline $l
3639 set id [lindex $displayorder $l]
3640 set currentid $id
3641 $sha1entry delete 0 end
3642 $sha1entry insert 0 $id
3643 $sha1entry selection from 0
3644 $sha1entry selection to end
3645 rhighlight_sel $id
3647 $ctext conf -state normal
3648 clear_ctext
3649 set linknum 0
3650 set info $commitinfo($id)
3651 set date [formatdate [lindex $info 2]]
3652 $ctext insert end "Author: [lindex $info 1] $date\n"
3653 set date [formatdate [lindex $info 4]]
3654 $ctext insert end "Committer: [lindex $info 3] $date\n"
3655 if {[info exists idtags($id)]} {
3656 $ctext insert end "Tags:"
3657 foreach tag $idtags($id) {
3658 $ctext insert end " $tag"
3660 $ctext insert end "\n"
3663 set comment {}
3664 set olds [lindex $parentlist $l]
3665 if {[llength $olds] > 1} {
3666 set np 0
3667 foreach p $olds {
3668 if {$np >= $mergemax} {
3669 set tag mmax
3670 } else {
3671 set tag m$np
3673 $ctext insert end "Parent: " $tag
3674 appendwithlinks [commit_descriptor $p]
3675 incr np
3677 } else {
3678 foreach p $olds {
3679 append comment "Parent: [commit_descriptor $p]\n"
3683 foreach c [lindex $childlist $l] {
3684 append comment "Child: [commit_descriptor $c]\n"
3686 append comment "\n"
3687 append comment [lindex $info 5]
3689 # make anything that looks like a SHA1 ID be a clickable link
3690 appendwithlinks $comment
3692 $ctext tag delete Comments
3693 $ctext tag remove found 1.0 end
3694 $ctext conf -state disabled
3695 set commentend [$ctext index "end - 1c"]
3697 init_flist "Comments"
3698 if {$cmitmode eq "tree"} {
3699 gettree $id
3700 } elseif {[llength $olds] <= 1} {
3701 startdiff $id
3702 } else {
3703 mergediff $id $l
3707 proc selfirstline {} {
3708 unmarkmatches
3709 selectline 0 1
3712 proc sellastline {} {
3713 global numcommits
3714 unmarkmatches
3715 set l [expr {$numcommits - 1}]
3716 selectline $l 1
3719 proc selnextline {dir} {
3720 global selectedline
3721 if {![info exists selectedline]} return
3722 set l [expr {$selectedline + $dir}]
3723 unmarkmatches
3724 selectline $l 1
3727 proc selnextpage {dir} {
3728 global canv linespc selectedline numcommits
3730 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3731 if {$lpp < 1} {
3732 set lpp 1
3734 allcanvs yview scroll [expr {$dir * $lpp}] units
3735 drawvisible
3736 if {![info exists selectedline]} return
3737 set l [expr {$selectedline + $dir * $lpp}]
3738 if {$l < 0} {
3739 set l 0
3740 } elseif {$l >= $numcommits} {
3741 set l [expr $numcommits - 1]
3743 unmarkmatches
3744 selectline $l 1
3747 proc unselectline {} {
3748 global selectedline currentid
3750 catch {unset selectedline}
3751 catch {unset currentid}
3752 allcanvs delete secsel
3753 rhighlight_none
3754 cancel_next_highlight
3757 proc reselectline {} {
3758 global selectedline
3760 if {[info exists selectedline]} {
3761 selectline $selectedline 0
3765 proc addtohistory {cmd} {
3766 global history historyindex curview
3768 set elt [list $curview $cmd]
3769 if {$historyindex > 0
3770 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3771 return
3774 if {$historyindex < [llength $history]} {
3775 set history [lreplace $history $historyindex end $elt]
3776 } else {
3777 lappend history $elt
3779 incr historyindex
3780 if {$historyindex > 1} {
3781 .ctop.top.bar.leftbut conf -state normal
3782 } else {
3783 .ctop.top.bar.leftbut conf -state disabled
3785 .ctop.top.bar.rightbut conf -state disabled
3788 proc godo {elt} {
3789 global curview
3791 set view [lindex $elt 0]
3792 set cmd [lindex $elt 1]
3793 if {$curview != $view} {
3794 showview $view
3796 eval $cmd
3799 proc goback {} {
3800 global history historyindex
3802 if {$historyindex > 1} {
3803 incr historyindex -1
3804 godo [lindex $history [expr {$historyindex - 1}]]
3805 .ctop.top.bar.rightbut conf -state normal
3807 if {$historyindex <= 1} {
3808 .ctop.top.bar.leftbut conf -state disabled
3812 proc goforw {} {
3813 global history historyindex
3815 if {$historyindex < [llength $history]} {
3816 set cmd [lindex $history $historyindex]
3817 incr historyindex
3818 godo $cmd
3819 .ctop.top.bar.leftbut conf -state normal
3821 if {$historyindex >= [llength $history]} {
3822 .ctop.top.bar.rightbut conf -state disabled
3826 proc gettree {id} {
3827 global treefilelist treeidlist diffids diffmergeid treepending
3829 set diffids $id
3830 catch {unset diffmergeid}
3831 if {![info exists treefilelist($id)]} {
3832 if {![info exists treepending]} {
3833 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3834 return
3836 set treepending $id
3837 set treefilelist($id) {}
3838 set treeidlist($id) {}
3839 fconfigure $gtf -blocking 0
3840 fileevent $gtf readable [list gettreeline $gtf $id]
3842 } else {
3843 setfilelist $id
3847 proc gettreeline {gtf id} {
3848 global treefilelist treeidlist treepending cmitmode diffids
3850 while {[gets $gtf line] >= 0} {
3851 if {[lindex $line 1] ne "blob"} continue
3852 set sha1 [lindex $line 2]
3853 set fname [lindex $line 3]
3854 lappend treefilelist($id) $fname
3855 lappend treeidlist($id) $sha1
3857 if {![eof $gtf]} return
3858 close $gtf
3859 unset treepending
3860 if {$cmitmode ne "tree"} {
3861 if {![info exists diffmergeid]} {
3862 gettreediffs $diffids
3864 } elseif {$id ne $diffids} {
3865 gettree $diffids
3866 } else {
3867 setfilelist $id
3871 proc showfile {f} {
3872 global treefilelist treeidlist diffids
3873 global ctext commentend
3875 set i [lsearch -exact $treefilelist($diffids) $f]
3876 if {$i < 0} {
3877 puts "oops, $f not in list for id $diffids"
3878 return
3880 set blob [lindex $treeidlist($diffids) $i]
3881 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3882 puts "oops, error reading blob $blob: $err"
3883 return
3885 fconfigure $bf -blocking 0
3886 fileevent $bf readable [list getblobline $bf $diffids]
3887 $ctext config -state normal
3888 clear_ctext $commentend
3889 $ctext insert end "\n"
3890 $ctext insert end "$f\n" filesep
3891 $ctext config -state disabled
3892 $ctext yview $commentend
3895 proc getblobline {bf id} {
3896 global diffids cmitmode ctext
3898 if {$id ne $diffids || $cmitmode ne "tree"} {
3899 catch {close $bf}
3900 return
3902 $ctext config -state normal
3903 while {[gets $bf line] >= 0} {
3904 $ctext insert end "$line\n"
3906 if {[eof $bf]} {
3907 # delete last newline
3908 $ctext delete "end - 2c" "end - 1c"
3909 close $bf
3911 $ctext config -state disabled
3914 proc mergediff {id l} {
3915 global diffmergeid diffopts mdifffd
3916 global diffids
3917 global parentlist
3919 set diffmergeid $id
3920 set diffids $id
3921 # this doesn't seem to actually affect anything...
3922 set env(GIT_DIFF_OPTS) $diffopts
3923 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3924 if {[catch {set mdf [open $cmd r]} err]} {
3925 error_popup "Error getting merge diffs: $err"
3926 return
3928 fconfigure $mdf -blocking 0
3929 set mdifffd($id) $mdf
3930 set np [llength [lindex $parentlist $l]]
3931 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3932 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3935 proc getmergediffline {mdf id np} {
3936 global diffmergeid ctext cflist nextupdate mergemax
3937 global difffilestart mdifffd
3939 set n [gets $mdf line]
3940 if {$n < 0} {
3941 if {[eof $mdf]} {
3942 close $mdf
3944 return
3946 if {![info exists diffmergeid] || $id != $diffmergeid
3947 || $mdf != $mdifffd($id)} {
3948 return
3950 $ctext conf -state normal
3951 if {[regexp {^diff --cc (.*)} $line match fname]} {
3952 # start of a new file
3953 $ctext insert end "\n"
3954 set here [$ctext index "end - 1c"]
3955 lappend difffilestart $here
3956 add_flist [list $fname]
3957 set l [expr {(78 - [string length $fname]) / 2}]
3958 set pad [string range "----------------------------------------" 1 $l]
3959 $ctext insert end "$pad $fname $pad\n" filesep
3960 } elseif {[regexp {^@@} $line]} {
3961 $ctext insert end "$line\n" hunksep
3962 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3963 # do nothing
3964 } else {
3965 # parse the prefix - one ' ', '-' or '+' for each parent
3966 set spaces {}
3967 set minuses {}
3968 set pluses {}
3969 set isbad 0
3970 for {set j 0} {$j < $np} {incr j} {
3971 set c [string range $line $j $j]
3972 if {$c == " "} {
3973 lappend spaces $j
3974 } elseif {$c == "-"} {
3975 lappend minuses $j
3976 } elseif {$c == "+"} {
3977 lappend pluses $j
3978 } else {
3979 set isbad 1
3980 break
3983 set tags {}
3984 set num {}
3985 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3986 # line doesn't appear in result, parents in $minuses have the line
3987 set num [lindex $minuses 0]
3988 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3989 # line appears in result, parents in $pluses don't have the line
3990 lappend tags mresult
3991 set num [lindex $spaces 0]
3993 if {$num ne {}} {
3994 if {$num >= $mergemax} {
3995 set num "max"
3997 lappend tags m$num
3999 $ctext insert end "$line\n" $tags
4001 $ctext conf -state disabled
4002 if {[clock clicks -milliseconds] >= $nextupdate} {
4003 incr nextupdate 100
4004 fileevent $mdf readable {}
4005 update
4006 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4010 proc startdiff {ids} {
4011 global treediffs diffids treepending diffmergeid
4013 set diffids $ids
4014 catch {unset diffmergeid}
4015 if {![info exists treediffs($ids)]} {
4016 if {![info exists treepending]} {
4017 gettreediffs $ids
4019 } else {
4020 addtocflist $ids
4024 proc addtocflist {ids} {
4025 global treediffs cflist
4026 add_flist $treediffs($ids)
4027 getblobdiffs $ids
4030 proc gettreediffs {ids} {
4031 global treediff treepending
4032 set treepending $ids
4033 set treediff {}
4034 if {[catch \
4035 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4036 ]} return
4037 fconfigure $gdtf -blocking 0
4038 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4041 proc gettreediffline {gdtf ids} {
4042 global treediff treediffs treepending diffids diffmergeid
4043 global cmitmode
4045 set n [gets $gdtf line]
4046 if {$n < 0} {
4047 if {![eof $gdtf]} return
4048 close $gdtf
4049 set treediffs($ids) $treediff
4050 unset treepending
4051 if {$cmitmode eq "tree"} {
4052 gettree $diffids
4053 } elseif {$ids != $diffids} {
4054 if {![info exists diffmergeid]} {
4055 gettreediffs $diffids
4057 } else {
4058 addtocflist $ids
4060 return
4062 set file [lindex $line 5]
4063 lappend treediff $file
4066 proc getblobdiffs {ids} {
4067 global diffopts blobdifffd diffids env curdifftag curtagstart
4068 global nextupdate diffinhdr treediffs
4070 set env(GIT_DIFF_OPTS) $diffopts
4071 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4072 if {[catch {set bdf [open $cmd r]} err]} {
4073 puts "error getting diffs: $err"
4074 return
4076 set diffinhdr 0
4077 fconfigure $bdf -blocking 0
4078 set blobdifffd($ids) $bdf
4079 set curdifftag Comments
4080 set curtagstart 0.0
4081 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4082 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4085 proc setinlist {var i val} {
4086 global $var
4088 while {[llength [set $var]] < $i} {
4089 lappend $var {}
4091 if {[llength [set $var]] == $i} {
4092 lappend $var $val
4093 } else {
4094 lset $var $i $val
4098 proc getblobdiffline {bdf ids} {
4099 global diffids blobdifffd ctext curdifftag curtagstart
4100 global diffnexthead diffnextnote difffilestart
4101 global nextupdate diffinhdr treediffs
4103 set n [gets $bdf line]
4104 if {$n < 0} {
4105 if {[eof $bdf]} {
4106 close $bdf
4107 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4108 $ctext tag add $curdifftag $curtagstart end
4111 return
4113 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4114 return
4116 $ctext conf -state normal
4117 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4118 # start of a new file
4119 $ctext insert end "\n"
4120 $ctext tag add $curdifftag $curtagstart end
4121 set here [$ctext index "end - 1c"]
4122 set curtagstart $here
4123 set header $newname
4124 set i [lsearch -exact $treediffs($ids) $fname]
4125 if {$i >= 0} {
4126 setinlist difffilestart $i $here
4128 if {$newname ne $fname} {
4129 set i [lsearch -exact $treediffs($ids) $newname]
4130 if {$i >= 0} {
4131 setinlist difffilestart $i $here
4134 set curdifftag "f:$fname"
4135 $ctext tag delete $curdifftag
4136 set l [expr {(78 - [string length $header]) / 2}]
4137 set pad [string range "----------------------------------------" 1 $l]
4138 $ctext insert end "$pad $header $pad\n" filesep
4139 set diffinhdr 1
4140 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4141 # do nothing
4142 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4143 set diffinhdr 0
4144 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4145 $line match f1l f1c f2l f2c rest]} {
4146 $ctext insert end "$line\n" hunksep
4147 set diffinhdr 0
4148 } else {
4149 set x [string range $line 0 0]
4150 if {$x == "-" || $x == "+"} {
4151 set tag [expr {$x == "+"}]
4152 $ctext insert end "$line\n" d$tag
4153 } elseif {$x == " "} {
4154 $ctext insert end "$line\n"
4155 } elseif {$diffinhdr || $x == "\\"} {
4156 # e.g. "\ No newline at end of file"
4157 $ctext insert end "$line\n" filesep
4158 } else {
4159 # Something else we don't recognize
4160 if {$curdifftag != "Comments"} {
4161 $ctext insert end "\n"
4162 $ctext tag add $curdifftag $curtagstart end
4163 set curtagstart [$ctext index "end - 1c"]
4164 set curdifftag Comments
4166 $ctext insert end "$line\n" filesep
4169 $ctext conf -state disabled
4170 if {[clock clicks -milliseconds] >= $nextupdate} {
4171 incr nextupdate 100
4172 fileevent $bdf readable {}
4173 update
4174 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4178 proc nextfile {} {
4179 global difffilestart ctext
4180 set here [$ctext index @0,0]
4181 foreach loc $difffilestart {
4182 if {[$ctext compare $loc > $here]} {
4183 $ctext yview $loc
4188 proc clear_ctext {{first 1.0}} {
4189 global ctext smarktop smarkbot
4191 set l [lindex [split $first .] 0]
4192 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4193 set smarktop $l
4195 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4196 set smarkbot $l
4198 $ctext delete $first end
4201 proc incrsearch {name ix op} {
4202 global ctext searchstring searchdirn
4204 $ctext tag remove found 1.0 end
4205 if {[catch {$ctext index anchor}]} {
4206 # no anchor set, use start of selection, or of visible area
4207 set sel [$ctext tag ranges sel]
4208 if {$sel ne {}} {
4209 $ctext mark set anchor [lindex $sel 0]
4210 } elseif {$searchdirn eq "-forwards"} {
4211 $ctext mark set anchor @0,0
4212 } else {
4213 $ctext mark set anchor @0,[winfo height $ctext]
4216 if {$searchstring ne {}} {
4217 set here [$ctext search $searchdirn -- $searchstring anchor]
4218 if {$here ne {}} {
4219 $ctext see $here
4221 searchmarkvisible 1
4225 proc dosearch {} {
4226 global sstring ctext searchstring searchdirn
4228 focus $sstring
4229 $sstring icursor end
4230 set searchdirn -forwards
4231 if {$searchstring ne {}} {
4232 set sel [$ctext tag ranges sel]
4233 if {$sel ne {}} {
4234 set start "[lindex $sel 0] + 1c"
4235 } elseif {[catch {set start [$ctext index anchor]}]} {
4236 set start "@0,0"
4238 set match [$ctext search -count mlen -- $searchstring $start]
4239 $ctext tag remove sel 1.0 end
4240 if {$match eq {}} {
4241 bell
4242 return
4244 $ctext see $match
4245 set mend "$match + $mlen c"
4246 $ctext tag add sel $match $mend
4247 $ctext mark unset anchor
4251 proc dosearchback {} {
4252 global sstring ctext searchstring searchdirn
4254 focus $sstring
4255 $sstring icursor end
4256 set searchdirn -backwards
4257 if {$searchstring ne {}} {
4258 set sel [$ctext tag ranges sel]
4259 if {$sel ne {}} {
4260 set start [lindex $sel 0]
4261 } elseif {[catch {set start [$ctext index anchor]}]} {
4262 set start @0,[winfo height $ctext]
4264 set match [$ctext search -backwards -count ml -- $searchstring $start]
4265 $ctext tag remove sel 1.0 end
4266 if {$match eq {}} {
4267 bell
4268 return
4270 $ctext see $match
4271 set mend "$match + $ml c"
4272 $ctext tag add sel $match $mend
4273 $ctext mark unset anchor
4277 proc searchmark {first last} {
4278 global ctext searchstring
4280 set mend $first.0
4281 while {1} {
4282 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4283 if {$match eq {}} break
4284 set mend "$match + $mlen c"
4285 $ctext tag add found $match $mend
4289 proc searchmarkvisible {doall} {
4290 global ctext smarktop smarkbot
4292 set topline [lindex [split [$ctext index @0,0] .] 0]
4293 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4294 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4295 # no overlap with previous
4296 searchmark $topline $botline
4297 set smarktop $topline
4298 set smarkbot $botline
4299 } else {
4300 if {$topline < $smarktop} {
4301 searchmark $topline [expr {$smarktop-1}]
4302 set smarktop $topline
4304 if {$botline > $smarkbot} {
4305 searchmark [expr {$smarkbot+1}] $botline
4306 set smarkbot $botline
4311 proc scrolltext {f0 f1} {
4312 global searchstring
4314 .ctop.cdet.left.sb set $f0 $f1
4315 if {$searchstring ne {}} {
4316 searchmarkvisible 0
4320 proc setcoords {} {
4321 global linespc charspc canvx0 canvy0 mainfont
4322 global xspc1 xspc2 lthickness
4324 set linespc [font metrics $mainfont -linespace]
4325 set charspc [font measure $mainfont "m"]
4326 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4327 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4328 set lthickness [expr {int($linespc / 9) + 1}]
4329 set xspc1(0) $linespc
4330 set xspc2 $linespc
4333 proc redisplay {} {
4334 global canv
4335 global selectedline
4337 set ymax [lindex [$canv cget -scrollregion] 3]
4338 if {$ymax eq {} || $ymax == 0} return
4339 set span [$canv yview]
4340 clear_display
4341 setcanvscroll
4342 allcanvs yview moveto [lindex $span 0]
4343 drawvisible
4344 if {[info exists selectedline]} {
4345 selectline $selectedline 0
4349 proc incrfont {inc} {
4350 global mainfont textfont ctext canv phase
4351 global stopped entries
4352 unmarkmatches
4353 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4354 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4355 setcoords
4356 $ctext conf -font $textfont
4357 $ctext tag conf filesep -font [concat $textfont bold]
4358 foreach e $entries {
4359 $e conf -font $mainfont
4361 if {$phase eq "getcommits"} {
4362 $canv itemconf textitems -font $mainfont
4364 redisplay
4367 proc clearsha1 {} {
4368 global sha1entry sha1string
4369 if {[string length $sha1string] == 40} {
4370 $sha1entry delete 0 end
4374 proc sha1change {n1 n2 op} {
4375 global sha1string currentid sha1but
4376 if {$sha1string == {}
4377 || ([info exists currentid] && $sha1string == $currentid)} {
4378 set state disabled
4379 } else {
4380 set state normal
4382 if {[$sha1but cget -state] == $state} return
4383 if {$state == "normal"} {
4384 $sha1but conf -state normal -relief raised -text "Goto: "
4385 } else {
4386 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4390 proc gotocommit {} {
4391 global sha1string currentid commitrow tagids headids
4392 global displayorder numcommits curview
4394 if {$sha1string == {}
4395 || ([info exists currentid] && $sha1string == $currentid)} return
4396 if {[info exists tagids($sha1string)]} {
4397 set id $tagids($sha1string)
4398 } elseif {[info exists headids($sha1string)]} {
4399 set id $headids($sha1string)
4400 } else {
4401 set id [string tolower $sha1string]
4402 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4403 set matches {}
4404 foreach i $displayorder {
4405 if {[string match $id* $i]} {
4406 lappend matches $i
4409 if {$matches ne {}} {
4410 if {[llength $matches] > 1} {
4411 error_popup "Short SHA1 id $id is ambiguous"
4412 return
4414 set id [lindex $matches 0]
4418 if {[info exists commitrow($curview,$id)]} {
4419 selectline $commitrow($curview,$id) 1
4420 return
4422 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4423 set type "SHA1 id"
4424 } else {
4425 set type "Tag/Head"
4427 error_popup "$type $sha1string is not known"
4430 proc lineenter {x y id} {
4431 global hoverx hovery hoverid hovertimer
4432 global commitinfo canv
4434 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4435 set hoverx $x
4436 set hovery $y
4437 set hoverid $id
4438 if {[info exists hovertimer]} {
4439 after cancel $hovertimer
4441 set hovertimer [after 500 linehover]
4442 $canv delete hover
4445 proc linemotion {x y id} {
4446 global hoverx hovery hoverid hovertimer
4448 if {[info exists hoverid] && $id == $hoverid} {
4449 set hoverx $x
4450 set hovery $y
4451 if {[info exists hovertimer]} {
4452 after cancel $hovertimer
4454 set hovertimer [after 500 linehover]
4458 proc lineleave {id} {
4459 global hoverid hovertimer canv
4461 if {[info exists hoverid] && $id == $hoverid} {
4462 $canv delete hover
4463 if {[info exists hovertimer]} {
4464 after cancel $hovertimer
4465 unset hovertimer
4467 unset hoverid
4471 proc linehover {} {
4472 global hoverx hovery hoverid hovertimer
4473 global canv linespc lthickness
4474 global commitinfo mainfont
4476 set text [lindex $commitinfo($hoverid) 0]
4477 set ymax [lindex [$canv cget -scrollregion] 3]
4478 if {$ymax == {}} return
4479 set yfrac [lindex [$canv yview] 0]
4480 set x [expr {$hoverx + 2 * $linespc}]
4481 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4482 set x0 [expr {$x - 2 * $lthickness}]
4483 set y0 [expr {$y - 2 * $lthickness}]
4484 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4485 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4486 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4487 -fill \#ffff80 -outline black -width 1 -tags hover]
4488 $canv raise $t
4489 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4490 $canv raise $t
4493 proc clickisonarrow {id y} {
4494 global lthickness
4496 set ranges [rowranges $id]
4497 set thresh [expr {2 * $lthickness + 6}]
4498 set n [expr {[llength $ranges] - 1}]
4499 for {set i 1} {$i < $n} {incr i} {
4500 set row [lindex $ranges $i]
4501 if {abs([yc $row] - $y) < $thresh} {
4502 return $i
4505 return {}
4508 proc arrowjump {id n y} {
4509 global canv
4511 # 1 <-> 2, 3 <-> 4, etc...
4512 set n [expr {(($n - 1) ^ 1) + 1}]
4513 set row [lindex [rowranges $id] $n]
4514 set yt [yc $row]
4515 set ymax [lindex [$canv cget -scrollregion] 3]
4516 if {$ymax eq {} || $ymax <= 0} return
4517 set view [$canv yview]
4518 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4519 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4520 if {$yfrac < 0} {
4521 set yfrac 0
4523 allcanvs yview moveto $yfrac
4526 proc lineclick {x y id isnew} {
4527 global ctext commitinfo children canv thickerline curview
4529 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4530 unmarkmatches
4531 unselectline
4532 normalline
4533 $canv delete hover
4534 # draw this line thicker than normal
4535 set thickerline $id
4536 drawlines $id
4537 if {$isnew} {
4538 set ymax [lindex [$canv cget -scrollregion] 3]
4539 if {$ymax eq {}} return
4540 set yfrac [lindex [$canv yview] 0]
4541 set y [expr {$y + $yfrac * $ymax}]
4543 set dirn [clickisonarrow $id $y]
4544 if {$dirn ne {}} {
4545 arrowjump $id $dirn $y
4546 return
4549 if {$isnew} {
4550 addtohistory [list lineclick $x $y $id 0]
4552 # fill the details pane with info about this line
4553 $ctext conf -state normal
4554 clear_ctext
4555 $ctext tag conf link -foreground blue -underline 1
4556 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4557 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4558 $ctext insert end "Parent:\t"
4559 $ctext insert end $id [list link link0]
4560 $ctext tag bind link0 <1> [list selbyid $id]
4561 set info $commitinfo($id)
4562 $ctext insert end "\n\t[lindex $info 0]\n"
4563 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4564 set date [formatdate [lindex $info 2]]
4565 $ctext insert end "\tDate:\t$date\n"
4566 set kids $children($curview,$id)
4567 if {$kids ne {}} {
4568 $ctext insert end "\nChildren:"
4569 set i 0
4570 foreach child $kids {
4571 incr i
4572 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4573 set info $commitinfo($child)
4574 $ctext insert end "\n\t"
4575 $ctext insert end $child [list link link$i]
4576 $ctext tag bind link$i <1> [list selbyid $child]
4577 $ctext insert end "\n\t[lindex $info 0]"
4578 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4579 set date [formatdate [lindex $info 2]]
4580 $ctext insert end "\n\tDate:\t$date\n"
4583 $ctext conf -state disabled
4584 init_flist {}
4587 proc normalline {} {
4588 global thickerline
4589 if {[info exists thickerline]} {
4590 set id $thickerline
4591 unset thickerline
4592 drawlines $id
4596 proc selbyid {id} {
4597 global commitrow curview
4598 if {[info exists commitrow($curview,$id)]} {
4599 selectline $commitrow($curview,$id) 1
4603 proc mstime {} {
4604 global startmstime
4605 if {![info exists startmstime]} {
4606 set startmstime [clock clicks -milliseconds]
4608 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4611 proc rowmenu {x y id} {
4612 global rowctxmenu commitrow selectedline rowmenuid curview
4614 if {![info exists selectedline]
4615 || $commitrow($curview,$id) eq $selectedline} {
4616 set state disabled
4617 } else {
4618 set state normal
4620 $rowctxmenu entryconfigure 0 -state $state
4621 $rowctxmenu entryconfigure 1 -state $state
4622 $rowctxmenu entryconfigure 2 -state $state
4623 set rowmenuid $id
4624 tk_popup $rowctxmenu $x $y
4627 proc diffvssel {dirn} {
4628 global rowmenuid selectedline displayorder
4630 if {![info exists selectedline]} return
4631 if {$dirn} {
4632 set oldid [lindex $displayorder $selectedline]
4633 set newid $rowmenuid
4634 } else {
4635 set oldid $rowmenuid
4636 set newid [lindex $displayorder $selectedline]
4638 addtohistory [list doseldiff $oldid $newid]
4639 doseldiff $oldid $newid
4642 proc doseldiff {oldid newid} {
4643 global ctext
4644 global commitinfo
4646 $ctext conf -state normal
4647 clear_ctext
4648 init_flist "Top"
4649 $ctext insert end "From "
4650 $ctext tag conf link -foreground blue -underline 1
4651 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4652 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4653 $ctext tag bind link0 <1> [list selbyid $oldid]
4654 $ctext insert end $oldid [list link link0]
4655 $ctext insert end "\n "
4656 $ctext insert end [lindex $commitinfo($oldid) 0]
4657 $ctext insert end "\n\nTo "
4658 $ctext tag bind link1 <1> [list selbyid $newid]
4659 $ctext insert end $newid [list link link1]
4660 $ctext insert end "\n "
4661 $ctext insert end [lindex $commitinfo($newid) 0]
4662 $ctext insert end "\n"
4663 $ctext conf -state disabled
4664 $ctext tag delete Comments
4665 $ctext tag remove found 1.0 end
4666 startdiff [list $oldid $newid]
4669 proc mkpatch {} {
4670 global rowmenuid currentid commitinfo patchtop patchnum
4672 if {![info exists currentid]} return
4673 set oldid $currentid
4674 set oldhead [lindex $commitinfo($oldid) 0]
4675 set newid $rowmenuid
4676 set newhead [lindex $commitinfo($newid) 0]
4677 set top .patch
4678 set patchtop $top
4679 catch {destroy $top}
4680 toplevel $top
4681 label $top.title -text "Generate patch"
4682 grid $top.title - -pady 10
4683 label $top.from -text "From:"
4684 entry $top.fromsha1 -width 40 -relief flat
4685 $top.fromsha1 insert 0 $oldid
4686 $top.fromsha1 conf -state readonly
4687 grid $top.from $top.fromsha1 -sticky w
4688 entry $top.fromhead -width 60 -relief flat
4689 $top.fromhead insert 0 $oldhead
4690 $top.fromhead conf -state readonly
4691 grid x $top.fromhead -sticky w
4692 label $top.to -text "To:"
4693 entry $top.tosha1 -width 40 -relief flat
4694 $top.tosha1 insert 0 $newid
4695 $top.tosha1 conf -state readonly
4696 grid $top.to $top.tosha1 -sticky w
4697 entry $top.tohead -width 60 -relief flat
4698 $top.tohead insert 0 $newhead
4699 $top.tohead conf -state readonly
4700 grid x $top.tohead -sticky w
4701 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4702 grid $top.rev x -pady 10
4703 label $top.flab -text "Output file:"
4704 entry $top.fname -width 60
4705 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4706 incr patchnum
4707 grid $top.flab $top.fname -sticky w
4708 frame $top.buts
4709 button $top.buts.gen -text "Generate" -command mkpatchgo
4710 button $top.buts.can -text "Cancel" -command mkpatchcan
4711 grid $top.buts.gen $top.buts.can
4712 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4713 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4714 grid $top.buts - -pady 10 -sticky ew
4715 focus $top.fname
4718 proc mkpatchrev {} {
4719 global patchtop
4721 set oldid [$patchtop.fromsha1 get]
4722 set oldhead [$patchtop.fromhead get]
4723 set newid [$patchtop.tosha1 get]
4724 set newhead [$patchtop.tohead get]
4725 foreach e [list fromsha1 fromhead tosha1 tohead] \
4726 v [list $newid $newhead $oldid $oldhead] {
4727 $patchtop.$e conf -state normal
4728 $patchtop.$e delete 0 end
4729 $patchtop.$e insert 0 $v
4730 $patchtop.$e conf -state readonly
4734 proc mkpatchgo {} {
4735 global patchtop
4737 set oldid [$patchtop.fromsha1 get]
4738 set newid [$patchtop.tosha1 get]
4739 set fname [$patchtop.fname get]
4740 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4741 error_popup "Error creating patch: $err"
4743 catch {destroy $patchtop}
4744 unset patchtop
4747 proc mkpatchcan {} {
4748 global patchtop
4750 catch {destroy $patchtop}
4751 unset patchtop
4754 proc mktag {} {
4755 global rowmenuid mktagtop commitinfo
4757 set top .maketag
4758 set mktagtop $top
4759 catch {destroy $top}
4760 toplevel $top
4761 label $top.title -text "Create tag"
4762 grid $top.title - -pady 10
4763 label $top.id -text "ID:"
4764 entry $top.sha1 -width 40 -relief flat
4765 $top.sha1 insert 0 $rowmenuid
4766 $top.sha1 conf -state readonly
4767 grid $top.id $top.sha1 -sticky w
4768 entry $top.head -width 60 -relief flat
4769 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4770 $top.head conf -state readonly
4771 grid x $top.head -sticky w
4772 label $top.tlab -text "Tag name:"
4773 entry $top.tag -width 60
4774 grid $top.tlab $top.tag -sticky w
4775 frame $top.buts
4776 button $top.buts.gen -text "Create" -command mktaggo
4777 button $top.buts.can -text "Cancel" -command mktagcan
4778 grid $top.buts.gen $top.buts.can
4779 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4780 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4781 grid $top.buts - -pady 10 -sticky ew
4782 focus $top.tag
4785 proc domktag {} {
4786 global mktagtop env tagids idtags
4788 set id [$mktagtop.sha1 get]
4789 set tag [$mktagtop.tag get]
4790 if {$tag == {}} {
4791 error_popup "No tag name specified"
4792 return
4794 if {[info exists tagids($tag)]} {
4795 error_popup "Tag \"$tag\" already exists"
4796 return
4798 if {[catch {
4799 set dir [gitdir]
4800 set fname [file join $dir "refs/tags" $tag]
4801 set f [open $fname w]
4802 puts $f $id
4803 close $f
4804 } err]} {
4805 error_popup "Error creating tag: $err"
4806 return
4809 set tagids($tag) $id
4810 lappend idtags($id) $tag
4811 redrawtags $id
4814 proc redrawtags {id} {
4815 global canv linehtag commitrow idpos selectedline curview
4817 if {![info exists commitrow($curview,$id)]} return
4818 drawcmitrow $commitrow($curview,$id)
4819 $canv delete tag.$id
4820 set xt [eval drawtags $id $idpos($id)]
4821 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4822 if {[info exists selectedline]
4823 && $selectedline == $commitrow($curview,$id)} {
4824 selectline $selectedline 0
4828 proc mktagcan {} {
4829 global mktagtop
4831 catch {destroy $mktagtop}
4832 unset mktagtop
4835 proc mktaggo {} {
4836 domktag
4837 mktagcan
4840 proc writecommit {} {
4841 global rowmenuid wrcomtop commitinfo wrcomcmd
4843 set top .writecommit
4844 set wrcomtop $top
4845 catch {destroy $top}
4846 toplevel $top
4847 label $top.title -text "Write commit to file"
4848 grid $top.title - -pady 10
4849 label $top.id -text "ID:"
4850 entry $top.sha1 -width 40 -relief flat
4851 $top.sha1 insert 0 $rowmenuid
4852 $top.sha1 conf -state readonly
4853 grid $top.id $top.sha1 -sticky w
4854 entry $top.head -width 60 -relief flat
4855 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4856 $top.head conf -state readonly
4857 grid x $top.head -sticky w
4858 label $top.clab -text "Command:"
4859 entry $top.cmd -width 60 -textvariable wrcomcmd
4860 grid $top.clab $top.cmd -sticky w -pady 10
4861 label $top.flab -text "Output file:"
4862 entry $top.fname -width 60
4863 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4864 grid $top.flab $top.fname -sticky w
4865 frame $top.buts
4866 button $top.buts.gen -text "Write" -command wrcomgo
4867 button $top.buts.can -text "Cancel" -command wrcomcan
4868 grid $top.buts.gen $top.buts.can
4869 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4870 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4871 grid $top.buts - -pady 10 -sticky ew
4872 focus $top.fname
4875 proc wrcomgo {} {
4876 global wrcomtop
4878 set id [$wrcomtop.sha1 get]
4879 set cmd "echo $id | [$wrcomtop.cmd get]"
4880 set fname [$wrcomtop.fname get]
4881 if {[catch {exec sh -c $cmd >$fname &} err]} {
4882 error_popup "Error writing commit: $err"
4884 catch {destroy $wrcomtop}
4885 unset wrcomtop
4888 proc wrcomcan {} {
4889 global wrcomtop
4891 catch {destroy $wrcomtop}
4892 unset wrcomtop
4895 proc listrefs {id} {
4896 global idtags idheads idotherrefs
4898 set x {}
4899 if {[info exists idtags($id)]} {
4900 set x $idtags($id)
4902 set y {}
4903 if {[info exists idheads($id)]} {
4904 set y $idheads($id)
4906 set z {}
4907 if {[info exists idotherrefs($id)]} {
4908 set z $idotherrefs($id)
4910 return [list $x $y $z]
4913 proc rereadrefs {} {
4914 global idtags idheads idotherrefs
4916 set refids [concat [array names idtags] \
4917 [array names idheads] [array names idotherrefs]]
4918 foreach id $refids {
4919 if {![info exists ref($id)]} {
4920 set ref($id) [listrefs $id]
4923 readrefs
4924 set refids [lsort -unique [concat $refids [array names idtags] \
4925 [array names idheads] [array names idotherrefs]]]
4926 foreach id $refids {
4927 set v [listrefs $id]
4928 if {![info exists ref($id)] || $ref($id) != $v} {
4929 redrawtags $id
4934 proc showtag {tag isnew} {
4935 global ctext tagcontents tagids linknum
4937 if {$isnew} {
4938 addtohistory [list showtag $tag 0]
4940 $ctext conf -state normal
4941 clear_ctext
4942 set linknum 0
4943 if {[info exists tagcontents($tag)]} {
4944 set text $tagcontents($tag)
4945 } else {
4946 set text "Tag: $tag\nId: $tagids($tag)"
4948 appendwithlinks $text
4949 $ctext conf -state disabled
4950 init_flist {}
4953 proc doquit {} {
4954 global stopped
4955 set stopped 100
4956 destroy .
4959 proc doprefs {} {
4960 global maxwidth maxgraphpct diffopts
4961 global oldprefs prefstop
4963 set top .gitkprefs
4964 set prefstop $top
4965 if {[winfo exists $top]} {
4966 raise $top
4967 return
4969 foreach v {maxwidth maxgraphpct diffopts} {
4970 set oldprefs($v) [set $v]
4972 toplevel $top
4973 wm title $top "Gitk preferences"
4974 label $top.ldisp -text "Commit list display options"
4975 grid $top.ldisp - -sticky w -pady 10
4976 label $top.spacer -text " "
4977 label $top.maxwidthl -text "Maximum graph width (lines)" \
4978 -font optionfont
4979 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4980 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4981 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4982 -font optionfont
4983 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4984 grid x $top.maxpctl $top.maxpct -sticky w
4985 label $top.ddisp -text "Diff display options"
4986 grid $top.ddisp - -sticky w -pady 10
4987 label $top.diffoptl -text "Options for diff program" \
4988 -font optionfont
4989 entry $top.diffopt -width 20 -textvariable diffopts
4990 grid x $top.diffoptl $top.diffopt -sticky w
4991 frame $top.buts
4992 button $top.buts.ok -text "OK" -command prefsok
4993 button $top.buts.can -text "Cancel" -command prefscan
4994 grid $top.buts.ok $top.buts.can
4995 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4996 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4997 grid $top.buts - - -pady 10 -sticky ew
5000 proc prefscan {} {
5001 global maxwidth maxgraphpct diffopts
5002 global oldprefs prefstop
5004 foreach v {maxwidth maxgraphpct diffopts} {
5005 set $v $oldprefs($v)
5007 catch {destroy $prefstop}
5008 unset prefstop
5011 proc prefsok {} {
5012 global maxwidth maxgraphpct
5013 global oldprefs prefstop
5015 catch {destroy $prefstop}
5016 unset prefstop
5017 if {$maxwidth != $oldprefs(maxwidth)
5018 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5019 redisplay
5023 proc formatdate {d} {
5024 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5027 # This list of encoding names and aliases is distilled from
5028 # http://www.iana.org/assignments/character-sets.
5029 # Not all of them are supported by Tcl.
5030 set encoding_aliases {
5031 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5032 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5033 { ISO-10646-UTF-1 csISO10646UTF1 }
5034 { ISO_646.basic:1983 ref csISO646basic1983 }
5035 { INVARIANT csINVARIANT }
5036 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5037 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5038 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5039 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5040 { NATS-DANO iso-ir-9-1 csNATSDANO }
5041 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5042 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5043 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5044 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5045 { ISO-2022-KR csISO2022KR }
5046 { EUC-KR csEUCKR }
5047 { ISO-2022-JP csISO2022JP }
5048 { ISO-2022-JP-2 csISO2022JP2 }
5049 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5050 csISO13JISC6220jp }
5051 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5052 { IT iso-ir-15 ISO646-IT csISO15Italian }
5053 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5054 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5055 { greek7-old iso-ir-18 csISO18Greek7Old }
5056 { latin-greek iso-ir-19 csISO19LatinGreek }
5057 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5058 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5059 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5060 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5061 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5062 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5063 { INIS iso-ir-49 csISO49INIS }
5064 { INIS-8 iso-ir-50 csISO50INIS8 }
5065 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5066 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5067 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5068 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5069 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5070 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5071 csISO60Norwegian1 }
5072 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5073 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5074 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5075 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5076 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5077 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5078 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5079 { greek7 iso-ir-88 csISO88Greek7 }
5080 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5081 { iso-ir-90 csISO90 }
5082 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5083 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5084 csISO92JISC62991984b }
5085 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5086 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5087 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5088 csISO95JIS62291984handadd }
5089 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5090 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5091 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5092 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5093 CP819 csISOLatin1 }
5094 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5095 { T.61-7bit iso-ir-102 csISO102T617bit }
5096 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5097 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5098 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5099 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5100 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5101 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5102 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5103 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5104 arabic csISOLatinArabic }
5105 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5106 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5107 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5108 greek greek8 csISOLatinGreek }
5109 { T.101-G2 iso-ir-128 csISO128T101G2 }
5110 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5111 csISOLatinHebrew }
5112 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5113 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5114 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5115 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5116 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5117 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5118 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5119 csISOLatinCyrillic }
5120 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5121 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5122 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5123 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5124 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5125 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5126 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5127 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5128 { ISO_10367-box iso-ir-155 csISO10367Box }
5129 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5130 { latin-lap lap iso-ir-158 csISO158Lap }
5131 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5132 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5133 { us-dk csUSDK }
5134 { dk-us csDKUS }
5135 { JIS_X0201 X0201 csHalfWidthKatakana }
5136 { KSC5636 ISO646-KR csKSC5636 }
5137 { ISO-10646-UCS-2 csUnicode }
5138 { ISO-10646-UCS-4 csUCS4 }
5139 { DEC-MCS dec csDECMCS }
5140 { hp-roman8 roman8 r8 csHPRoman8 }
5141 { macintosh mac csMacintosh }
5142 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5143 csIBM037 }
5144 { IBM038 EBCDIC-INT cp038 csIBM038 }
5145 { IBM273 CP273 csIBM273 }
5146 { IBM274 EBCDIC-BE CP274 csIBM274 }
5147 { IBM275 EBCDIC-BR cp275 csIBM275 }
5148 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5149 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5150 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5151 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5152 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5153 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5154 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5155 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5156 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5157 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5158 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5159 { IBM437 cp437 437 csPC8CodePage437 }
5160 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5161 { IBM775 cp775 csPC775Baltic }
5162 { IBM850 cp850 850 csPC850Multilingual }
5163 { IBM851 cp851 851 csIBM851 }
5164 { IBM852 cp852 852 csPCp852 }
5165 { IBM855 cp855 855 csIBM855 }
5166 { IBM857 cp857 857 csIBM857 }
5167 { IBM860 cp860 860 csIBM860 }
5168 { IBM861 cp861 861 cp-is csIBM861 }
5169 { IBM862 cp862 862 csPC862LatinHebrew }
5170 { IBM863 cp863 863 csIBM863 }
5171 { IBM864 cp864 csIBM864 }
5172 { IBM865 cp865 865 csIBM865 }
5173 { IBM866 cp866 866 csIBM866 }
5174 { IBM868 CP868 cp-ar csIBM868 }
5175 { IBM869 cp869 869 cp-gr csIBM869 }
5176 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5177 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5178 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5179 { IBM891 cp891 csIBM891 }
5180 { IBM903 cp903 csIBM903 }
5181 { IBM904 cp904 904 csIBBM904 }
5182 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5183 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5184 { IBM1026 CP1026 csIBM1026 }
5185 { EBCDIC-AT-DE csIBMEBCDICATDE }
5186 { EBCDIC-AT-DE-A csEBCDICATDEA }
5187 { EBCDIC-CA-FR csEBCDICCAFR }
5188 { EBCDIC-DK-NO csEBCDICDKNO }
5189 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5190 { EBCDIC-FI-SE csEBCDICFISE }
5191 { EBCDIC-FI-SE-A csEBCDICFISEA }
5192 { EBCDIC-FR csEBCDICFR }
5193 { EBCDIC-IT csEBCDICIT }
5194 { EBCDIC-PT csEBCDICPT }
5195 { EBCDIC-ES csEBCDICES }
5196 { EBCDIC-ES-A csEBCDICESA }
5197 { EBCDIC-ES-S csEBCDICESS }
5198 { EBCDIC-UK csEBCDICUK }
5199 { EBCDIC-US csEBCDICUS }
5200 { UNKNOWN-8BIT csUnknown8BiT }
5201 { MNEMONIC csMnemonic }
5202 { MNEM csMnem }
5203 { VISCII csVISCII }
5204 { VIQR csVIQR }
5205 { KOI8-R csKOI8R }
5206 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5207 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5208 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5209 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5210 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5211 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5212 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5213 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5214 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5215 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5216 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5217 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5218 { IBM1047 IBM-1047 }
5219 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5220 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5221 { UNICODE-1-1 csUnicode11 }
5222 { CESU-8 csCESU-8 }
5223 { BOCU-1 csBOCU-1 }
5224 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5225 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5226 l8 }
5227 { ISO-8859-15 ISO_8859-15 Latin-9 }
5228 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5229 { GBK CP936 MS936 windows-936 }
5230 { JIS_Encoding csJISEncoding }
5231 { Shift_JIS MS_Kanji csShiftJIS }
5232 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5233 EUC-JP }
5234 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5235 { ISO-10646-UCS-Basic csUnicodeASCII }
5236 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5237 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5238 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5239 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5240 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5241 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5242 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5243 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5244 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5245 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5246 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5247 { Ventura-US csVenturaUS }
5248 { Ventura-International csVenturaInternational }
5249 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5250 { PC8-Turkish csPC8Turkish }
5251 { IBM-Symbols csIBMSymbols }
5252 { IBM-Thai csIBMThai }
5253 { HP-Legal csHPLegal }
5254 { HP-Pi-font csHPPiFont }
5255 { HP-Math8 csHPMath8 }
5256 { Adobe-Symbol-Encoding csHPPSMath }
5257 { HP-DeskTop csHPDesktop }
5258 { Ventura-Math csVenturaMath }
5259 { Microsoft-Publishing csMicrosoftPublishing }
5260 { Windows-31J csWindows31J }
5261 { GB2312 csGB2312 }
5262 { Big5 csBig5 }
5265 proc tcl_encoding {enc} {
5266 global encoding_aliases
5267 set names [encoding names]
5268 set lcnames [string tolower $names]
5269 set enc [string tolower $enc]
5270 set i [lsearch -exact $lcnames $enc]
5271 if {$i < 0} {
5272 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5273 if {[regsub {^iso[-_]} $enc iso encx]} {
5274 set i [lsearch -exact $lcnames $encx]
5277 if {$i < 0} {
5278 foreach l $encoding_aliases {
5279 set ll [string tolower $l]
5280 if {[lsearch -exact $ll $enc] < 0} continue
5281 # look through the aliases for one that tcl knows about
5282 foreach e $ll {
5283 set i [lsearch -exact $lcnames $e]
5284 if {$i < 0} {
5285 if {[regsub {^iso[-_]} $e iso ex]} {
5286 set i [lsearch -exact $lcnames $ex]
5289 if {$i >= 0} break
5291 break
5294 if {$i >= 0} {
5295 return [lindex $names $i]
5297 return {}
5300 # defaults...
5301 set datemode 0
5302 set diffopts "-U 5 -p"
5303 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5305 set gitencoding {}
5306 catch {
5307 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5309 if {$gitencoding == ""} {
5310 set gitencoding "utf-8"
5312 set tclencoding [tcl_encoding $gitencoding]
5313 if {$tclencoding == {}} {
5314 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5317 set mainfont {Helvetica 9}
5318 set textfont {Courier 9}
5319 set uifont {Helvetica 9 bold}
5320 set findmergefiles 0
5321 set maxgraphpct 50
5322 set maxwidth 16
5323 set revlistorder 0
5324 set fastdate 0
5325 set uparrowlen 7
5326 set downarrowlen 7
5327 set mingaplen 30
5328 set cmitmode "patch"
5330 set colors {green red blue magenta darkgrey brown orange}
5332 catch {source ~/.gitk}
5334 font create optionfont -family sans-serif -size -12
5336 set revtreeargs {}
5337 foreach arg $argv {
5338 switch -regexp -- $arg {
5339 "^$" { }
5340 "^-d" { set datemode 1 }
5341 default {
5342 lappend revtreeargs $arg
5347 # check that we can find a .git directory somewhere...
5348 set gitdir [gitdir]
5349 if {![file isdirectory $gitdir]} {
5350 show_error . "Cannot find the git directory \"$gitdir\"."
5351 exit 1
5354 set cmdline_files {}
5355 set i [lsearch -exact $revtreeargs "--"]
5356 if {$i >= 0} {
5357 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5358 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5359 } elseif {$revtreeargs ne {}} {
5360 if {[catch {
5361 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5362 set cmdline_files [split $f "\n"]
5363 set n [llength $cmdline_files]
5364 set revtreeargs [lrange $revtreeargs 0 end-$n]
5365 } err]} {
5366 # unfortunately we get both stdout and stderr in $err,
5367 # so look for "fatal:".
5368 set i [string first "fatal:" $err]
5369 if {$i > 0} {
5370 set err [string range [expr {$i + 6}] end]
5372 show_error . "Bad arguments to gitk:\n$err"
5373 exit 1
5377 set history {}
5378 set historyindex 0
5379 set fh_serial 0
5380 set nhl_names {}
5381 set highlight_paths {}
5382 set searchdirn -forwards
5383 set boldrows {}
5384 set boldnamerows {}
5386 set optim_delay 16
5388 set nextviewnum 1
5389 set curview 0
5390 set selectedview 0
5391 set selectedhlview None
5392 set viewfiles(0) {}
5393 set viewperm(0) 0
5394 set viewargs(0) {}
5396 set cmdlineok 0
5397 set stopped 0
5398 set stuffsaved 0
5399 set patchnum 0
5400 setcoords
5401 makewindow
5402 readrefs
5404 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5405 # create a view for the files/dirs specified on the command line
5406 set curview 1
5407 set selectedview 1
5408 set nextviewnum 2
5409 set viewname(1) "Command line"
5410 set viewfiles(1) $cmdline_files
5411 set viewargs(1) $revtreeargs
5412 set viewperm(1) 0
5413 addviewmenu 1
5414 .bar.view entryconf 2 -state normal
5415 .bar.view entryconf 3 -state normal
5418 if {[info exists permviews]} {
5419 foreach v $permviews {
5420 set n $nextviewnum
5421 incr nextviewnum
5422 set viewname($n) [lindex $v 0]
5423 set viewfiles($n) [lindex $v 1]
5424 set viewargs($n) [lindex $v 2]
5425 set viewperm($n) 1
5426 addviewmenu $n
5429 getcommits