Merge branch 'master' into new
[git/dkf.git] / gitk
blob25c86b70af6284eacd079e508f97f16d03f3f88d
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 top msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $top"
366 pack $w.ok -side bottom -fill x
367 bind $top <Visibility> "grab $top; focus $top"
368 bind $top <Key-Return> "destroy $top"
369 tkwait window $top
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $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 wrapcomment
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 comment -wrap $wrapcomment
574 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
575 $ctext tag conf hunksep -fore blue
576 $ctext tag conf d0 -fore red
577 $ctext tag conf d1 -fore "#00a000"
578 $ctext tag conf m0 -fore red
579 $ctext tag conf m1 -fore blue
580 $ctext tag conf m2 -fore green
581 $ctext tag conf m3 -fore purple
582 $ctext tag conf m4 -fore brown
583 $ctext tag conf m5 -fore "#009090"
584 $ctext tag conf m6 -fore magenta
585 $ctext tag conf m7 -fore "#808000"
586 $ctext tag conf m8 -fore "#009000"
587 $ctext tag conf m9 -fore "#ff0080"
588 $ctext tag conf m10 -fore cyan
589 $ctext tag conf m11 -fore "#b07070"
590 $ctext tag conf m12 -fore "#70b0f0"
591 $ctext tag conf m13 -fore "#70f0b0"
592 $ctext tag conf m14 -fore "#f0b070"
593 $ctext tag conf m15 -fore "#ff70b0"
594 $ctext tag conf mmax -fore darkgrey
595 set mergemax 16
596 $ctext tag conf mresult -font [concat $textfont bold]
597 $ctext tag conf msep -font [concat $textfont bold]
598 $ctext tag conf found -back yellow
600 frame .ctop.cdet.right
601 frame .ctop.cdet.right.mode
602 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
603 -command reselectline -variable cmitmode -value "patch"
604 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
605 -command reselectline -variable cmitmode -value "tree"
606 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
607 pack .ctop.cdet.right.mode -side top -fill x
608 set cflist .ctop.cdet.right.cfiles
609 set indent [font measure $mainfont "nn"]
610 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
611 -tabs [list $indent [expr {2 * $indent}]] \
612 -yscrollcommand ".ctop.cdet.right.sb set" \
613 -cursor [. cget -cursor] \
614 -spacing1 1 -spacing3 1
615 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
616 pack .ctop.cdet.right.sb -side right -fill y
617 pack $cflist -side left -fill both -expand 1
618 $cflist tag configure highlight \
619 -background [$cflist cget -selectbackground]
620 $cflist tag configure bold -font [concat $mainfont bold]
621 .ctop.cdet add .ctop.cdet.right
622 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
624 pack .ctop -side top -fill both -expand 1
626 bindall <1> {selcanvline %W %x %y}
627 #bindall <B1-Motion> {selcanvline %W %x %y}
628 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
629 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
630 bindall <2> "canvscan mark %W %x %y"
631 bindall <B2-Motion> "canvscan dragto %W %x %y"
632 bindkey <Home> selfirstline
633 bindkey <End> sellastline
634 bind . <Key-Up> "selnextline -1"
635 bind . <Key-Down> "selnextline 1"
636 bind . <Shift-Key-Up> "next_highlight -1"
637 bind . <Shift-Key-Down> "next_highlight 1"
638 bindkey <Key-Right> "goforw"
639 bindkey <Key-Left> "goback"
640 bind . <Key-Prior> "selnextpage -1"
641 bind . <Key-Next> "selnextpage 1"
642 bind . <Control-Home> "allcanvs yview moveto 0.0"
643 bind . <Control-End> "allcanvs yview moveto 1.0"
644 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
645 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
646 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
647 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
648 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
649 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
650 bindkey <Key-space> "$ctext yview scroll 1 pages"
651 bindkey p "selnextline -1"
652 bindkey n "selnextline 1"
653 bindkey z "goback"
654 bindkey x "goforw"
655 bindkey i "selnextline -1"
656 bindkey k "selnextline 1"
657 bindkey j "goback"
658 bindkey l "goforw"
659 bindkey b "$ctext yview scroll -1 pages"
660 bindkey d "$ctext yview scroll 18 units"
661 bindkey u "$ctext yview scroll -18 units"
662 bindkey / {findnext 1}
663 bindkey <Key-Return> {findnext 0}
664 bindkey ? findprev
665 bindkey f nextfile
666 bind . <Control-q> doquit
667 bind . <Control-f> dofind
668 bind . <Control-g> {findnext 0}
669 bind . <Control-r> dosearchback
670 bind . <Control-s> dosearch
671 bind . <Control-equal> {incrfont 1}
672 bind . <Control-KP_Add> {incrfont 1}
673 bind . <Control-minus> {incrfont -1}
674 bind . <Control-KP_Subtract> {incrfont -1}
675 bind . <Destroy> {savestuff %W}
676 bind . <Button-1> "click %W"
677 bind $fstring <Key-Return> dofind
678 bind $sha1entry <Key-Return> gotocommit
679 bind $sha1entry <<PasteSelection>> clearsha1
680 bind $cflist <1> {sel_flist %W %x %y; break}
681 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
682 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
684 set maincursor [. cget -cursor]
685 set textcursor [$ctext cget -cursor]
686 set curtextcursor $textcursor
688 set rowctxmenu .rowctxmenu
689 menu $rowctxmenu -tearoff 0
690 $rowctxmenu add command -label "Diff this -> selected" \
691 -command {diffvssel 0}
692 $rowctxmenu add command -label "Diff selected -> this" \
693 -command {diffvssel 1}
694 $rowctxmenu add command -label "Make patch" -command mkpatch
695 $rowctxmenu add command -label "Create tag" -command mktag
696 $rowctxmenu add command -label "Write commit to file" -command writecommit
699 # mouse-2 makes all windows scan vertically, but only the one
700 # the cursor is in scans horizontally
701 proc canvscan {op w x y} {
702 global canv canv2 canv3
703 foreach c [list $canv $canv2 $canv3] {
704 if {$c == $w} {
705 $c scan $op $x $y
706 } else {
707 $c scan $op 0 $y
712 proc scrollcanv {cscroll f0 f1} {
713 $cscroll set $f0 $f1
714 drawfrac $f0 $f1
715 flushhighlights
718 # when we make a key binding for the toplevel, make sure
719 # it doesn't get triggered when that key is pressed in the
720 # find string entry widget.
721 proc bindkey {ev script} {
722 global entries
723 bind . $ev $script
724 set escript [bind Entry $ev]
725 if {$escript == {}} {
726 set escript [bind Entry <Key>]
728 foreach e $entries {
729 bind $e $ev "$escript; break"
733 # set the focus back to the toplevel for any click outside
734 # the entry widgets
735 proc click {w} {
736 global entries
737 foreach e $entries {
738 if {$w == $e} return
740 focus .
743 proc savestuff {w} {
744 global canv canv2 canv3 ctext cflist mainfont textfont uifont
745 global stuffsaved findmergefiles maxgraphpct
746 global maxwidth
747 global viewname viewfiles viewargs viewperm nextviewnum
748 global cmitmode wrapcomment
750 if {$stuffsaved} return
751 if {![winfo viewable .]} return
752 catch {
753 set f [open "~/.gitk-new" w]
754 puts $f [list set mainfont $mainfont]
755 puts $f [list set textfont $textfont]
756 puts $f [list set uifont $uifont]
757 puts $f [list set findmergefiles $findmergefiles]
758 puts $f [list set maxgraphpct $maxgraphpct]
759 puts $f [list set maxwidth $maxwidth]
760 puts $f [list set cmitmode $cmitmode]
761 puts $f [list set wrapcomment $wrapcomment]
762 puts $f "set geometry(width) [winfo width .ctop]"
763 puts $f "set geometry(height) [winfo height .ctop]"
764 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
765 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
766 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
767 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
768 set wid [expr {([winfo width $ctext] - 8) \
769 / [font measure $textfont "0"]}]
770 puts $f "set geometry(ctextw) $wid"
771 set wid [expr {([winfo width $cflist] - 11) \
772 / [font measure [$cflist cget -font] "0"]}]
773 puts $f "set geometry(cflistw) $wid"
774 puts -nonewline $f "set permviews {"
775 for {set v 0} {$v < $nextviewnum} {incr v} {
776 if {$viewperm($v)} {
777 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
780 puts $f "}"
781 close $f
782 file rename -force "~/.gitk-new" "~/.gitk"
784 set stuffsaved 1
787 proc resizeclistpanes {win w} {
788 global oldwidth
789 if {[info exists oldwidth($win)]} {
790 set s0 [$win sash coord 0]
791 set s1 [$win sash coord 1]
792 if {$w < 60} {
793 set sash0 [expr {int($w/2 - 2)}]
794 set sash1 [expr {int($w*5/6 - 2)}]
795 } else {
796 set factor [expr {1.0 * $w / $oldwidth($win)}]
797 set sash0 [expr {int($factor * [lindex $s0 0])}]
798 set sash1 [expr {int($factor * [lindex $s1 0])}]
799 if {$sash0 < 30} {
800 set sash0 30
802 if {$sash1 < $sash0 + 20} {
803 set sash1 [expr {$sash0 + 20}]
805 if {$sash1 > $w - 10} {
806 set sash1 [expr {$w - 10}]
807 if {$sash0 > $sash1 - 20} {
808 set sash0 [expr {$sash1 - 20}]
812 $win sash place 0 $sash0 [lindex $s0 1]
813 $win sash place 1 $sash1 [lindex $s1 1]
815 set oldwidth($win) $w
818 proc resizecdetpanes {win w} {
819 global oldwidth
820 if {[info exists oldwidth($win)]} {
821 set s0 [$win sash coord 0]
822 if {$w < 60} {
823 set sash0 [expr {int($w*3/4 - 2)}]
824 } else {
825 set factor [expr {1.0 * $w / $oldwidth($win)}]
826 set sash0 [expr {int($factor * [lindex $s0 0])}]
827 if {$sash0 < 45} {
828 set sash0 45
830 if {$sash0 > $w - 15} {
831 set sash0 [expr {$w - 15}]
834 $win sash place 0 $sash0 [lindex $s0 1]
836 set oldwidth($win) $w
839 proc allcanvs args {
840 global canv canv2 canv3
841 eval $canv $args
842 eval $canv2 $args
843 eval $canv3 $args
846 proc bindall {event action} {
847 global canv canv2 canv3
848 bind $canv $event $action
849 bind $canv2 $event $action
850 bind $canv3 $event $action
853 proc about {} {
854 set w .about
855 if {[winfo exists $w]} {
856 raise $w
857 return
859 toplevel $w
860 wm title $w "About gitk"
861 message $w.m -text {
862 Gitk - a commit viewer for git
864 Copyright © 2005-2006 Paul Mackerras
866 Use and redistribute under the terms of the GNU General Public License} \
867 -justify center -aspect 400
868 pack $w.m -side top -fill x -padx 20 -pady 20
869 button $w.ok -text Close -command "destroy $w"
870 pack $w.ok -side bottom
873 proc keys {} {
874 set w .keys
875 if {[winfo exists $w]} {
876 raise $w
877 return
879 toplevel $w
880 wm title $w "Gitk key bindings"
881 message $w.m -text {
882 Gitk key bindings:
884 <Ctrl-Q> Quit
885 <Home> Move to first commit
886 <End> Move to last commit
887 <Up>, p, i Move up one commit
888 <Down>, n, k Move down one commit
889 <Left>, z, j Go back in history list
890 <Right>, x, l Go forward in history list
891 <PageUp> Move up one page in commit list
892 <PageDown> Move down one page in commit list
893 <Ctrl-Home> Scroll to top of commit list
894 <Ctrl-End> Scroll to bottom of commit list
895 <Ctrl-Up> Scroll commit list up one line
896 <Ctrl-Down> Scroll commit list down one line
897 <Ctrl-PageUp> Scroll commit list up one page
898 <Ctrl-PageDown> Scroll commit list down one page
899 <Shift-Up> Move to previous highlighted line
900 <Shift-Down> Move to next highlighted line
901 <Delete>, b Scroll diff view up one page
902 <Backspace> Scroll diff view up one page
903 <Space> Scroll diff view down one page
904 u Scroll diff view up 18 lines
905 d Scroll diff view down 18 lines
906 <Ctrl-F> Find
907 <Ctrl-G> Move to next find hit
908 <Return> Move to next find hit
909 / Move to next find hit, or redo find
910 ? Move to previous find hit
911 f Scroll diff view to next file
912 <Ctrl-S> Search for next hit in diff view
913 <Ctrl-R> Search for previous hit in diff view
914 <Ctrl-KP+> Increase font size
915 <Ctrl-plus> Increase font size
916 <Ctrl-KP-> Decrease font size
917 <Ctrl-minus> Decrease font size
919 -justify left -bg white -border 2 -relief sunken
920 pack $w.m -side top -fill both
921 button $w.ok -text Close -command "destroy $w"
922 pack $w.ok -side bottom
925 # Procedures for manipulating the file list window at the
926 # bottom right of the overall window.
928 proc treeview {w l openlevs} {
929 global treecontents treediropen treeheight treeparent treeindex
931 set ix 0
932 set treeindex() 0
933 set lev 0
934 set prefix {}
935 set prefixend -1
936 set prefendstack {}
937 set htstack {}
938 set ht 0
939 set treecontents() {}
940 $w conf -state normal
941 foreach f $l {
942 while {[string range $f 0 $prefixend] ne $prefix} {
943 if {$lev <= $openlevs} {
944 $w mark set e:$treeindex($prefix) "end -1c"
945 $w mark gravity e:$treeindex($prefix) left
947 set treeheight($prefix) $ht
948 incr ht [lindex $htstack end]
949 set htstack [lreplace $htstack end end]
950 set prefixend [lindex $prefendstack end]
951 set prefendstack [lreplace $prefendstack end end]
952 set prefix [string range $prefix 0 $prefixend]
953 incr lev -1
955 set tail [string range $f [expr {$prefixend+1}] end]
956 while {[set slash [string first "/" $tail]] >= 0} {
957 lappend htstack $ht
958 set ht 0
959 lappend prefendstack $prefixend
960 incr prefixend [expr {$slash + 1}]
961 set d [string range $tail 0 $slash]
962 lappend treecontents($prefix) $d
963 set oldprefix $prefix
964 append prefix $d
965 set treecontents($prefix) {}
966 set treeindex($prefix) [incr ix]
967 set treeparent($prefix) $oldprefix
968 set tail [string range $tail [expr {$slash+1}] end]
969 if {$lev <= $openlevs} {
970 set ht 1
971 set treediropen($prefix) [expr {$lev < $openlevs}]
972 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
973 $w mark set d:$ix "end -1c"
974 $w mark gravity d:$ix left
975 set str "\n"
976 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
977 $w insert end $str
978 $w image create end -align center -image $bm -padx 1 \
979 -name a:$ix
980 $w insert end $d [highlight_tag $prefix]
981 $w mark set s:$ix "end -1c"
982 $w mark gravity s:$ix left
984 incr lev
986 if {$tail ne {}} {
987 if {$lev <= $openlevs} {
988 incr ht
989 set str "\n"
990 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
991 $w insert end $str
992 $w insert end $tail [highlight_tag $f]
994 lappend treecontents($prefix) $tail
997 while {$htstack ne {}} {
998 set treeheight($prefix) $ht
999 incr ht [lindex $htstack end]
1000 set htstack [lreplace $htstack end end]
1002 $w conf -state disabled
1005 proc linetoelt {l} {
1006 global treeheight treecontents
1008 set y 2
1009 set prefix {}
1010 while {1} {
1011 foreach e $treecontents($prefix) {
1012 if {$y == $l} {
1013 return "$prefix$e"
1015 set n 1
1016 if {[string index $e end] eq "/"} {
1017 set n $treeheight($prefix$e)
1018 if {$y + $n > $l} {
1019 append prefix $e
1020 incr y
1021 break
1024 incr y $n
1029 proc highlight_tree {y prefix} {
1030 global treeheight treecontents cflist
1032 foreach e $treecontents($prefix) {
1033 set path $prefix$e
1034 if {[highlight_tag $path] ne {}} {
1035 $cflist tag add bold $y.0 "$y.0 lineend"
1037 incr y
1038 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1039 set y [highlight_tree $y $path]
1042 return $y
1045 proc treeclosedir {w dir} {
1046 global treediropen treeheight treeparent treeindex
1048 set ix $treeindex($dir)
1049 $w conf -state normal
1050 $w delete s:$ix e:$ix
1051 set treediropen($dir) 0
1052 $w image configure a:$ix -image tri-rt
1053 $w conf -state disabled
1054 set n [expr {1 - $treeheight($dir)}]
1055 while {$dir ne {}} {
1056 incr treeheight($dir) $n
1057 set dir $treeparent($dir)
1061 proc treeopendir {w dir} {
1062 global treediropen treeheight treeparent treecontents treeindex
1064 set ix $treeindex($dir)
1065 $w conf -state normal
1066 $w image configure a:$ix -image tri-dn
1067 $w mark set e:$ix s:$ix
1068 $w mark gravity e:$ix right
1069 set lev 0
1070 set str "\n"
1071 set n [llength $treecontents($dir)]
1072 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1073 incr lev
1074 append str "\t"
1075 incr treeheight($x) $n
1077 foreach e $treecontents($dir) {
1078 set de $dir$e
1079 if {[string index $e end] eq "/"} {
1080 set iy $treeindex($de)
1081 $w mark set d:$iy e:$ix
1082 $w mark gravity d:$iy left
1083 $w insert e:$ix $str
1084 set treediropen($de) 0
1085 $w image create e:$ix -align center -image tri-rt -padx 1 \
1086 -name a:$iy
1087 $w insert e:$ix $e [highlight_tag $de]
1088 $w mark set s:$iy e:$ix
1089 $w mark gravity s:$iy left
1090 set treeheight($de) 1
1091 } else {
1092 $w insert e:$ix $str
1093 $w insert e:$ix $e [highlight_tag $de]
1096 $w mark gravity e:$ix left
1097 $w conf -state disabled
1098 set treediropen($dir) 1
1099 set top [lindex [split [$w index @0,0] .] 0]
1100 set ht [$w cget -height]
1101 set l [lindex [split [$w index s:$ix] .] 0]
1102 if {$l < $top} {
1103 $w yview $l.0
1104 } elseif {$l + $n + 1 > $top + $ht} {
1105 set top [expr {$l + $n + 2 - $ht}]
1106 if {$l < $top} {
1107 set top $l
1109 $w yview $top.0
1113 proc treeclick {w x y} {
1114 global treediropen cmitmode ctext cflist cflist_top
1116 if {$cmitmode ne "tree"} return
1117 if {![info exists cflist_top]} return
1118 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1119 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1120 $cflist tag add highlight $l.0 "$l.0 lineend"
1121 set cflist_top $l
1122 if {$l == 1} {
1123 $ctext yview 1.0
1124 return
1126 set e [linetoelt $l]
1127 if {[string index $e end] ne "/"} {
1128 showfile $e
1129 } elseif {$treediropen($e)} {
1130 treeclosedir $w $e
1131 } else {
1132 treeopendir $w $e
1136 proc setfilelist {id} {
1137 global treefilelist cflist
1139 treeview $cflist $treefilelist($id) 0
1142 image create bitmap tri-rt -background black -foreground blue -data {
1143 #define tri-rt_width 13
1144 #define tri-rt_height 13
1145 static unsigned char tri-rt_bits[] = {
1146 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1147 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1148 0x00, 0x00};
1149 } -maskdata {
1150 #define tri-rt-mask_width 13
1151 #define tri-rt-mask_height 13
1152 static unsigned char tri-rt-mask_bits[] = {
1153 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1154 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1155 0x08, 0x00};
1157 image create bitmap tri-dn -background black -foreground blue -data {
1158 #define tri-dn_width 13
1159 #define tri-dn_height 13
1160 static unsigned char tri-dn_bits[] = {
1161 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1162 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1163 0x00, 0x00};
1164 } -maskdata {
1165 #define tri-dn-mask_width 13
1166 #define tri-dn-mask_height 13
1167 static unsigned char tri-dn-mask_bits[] = {
1168 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1169 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1170 0x00, 0x00};
1173 proc init_flist {first} {
1174 global cflist cflist_top selectedline difffilestart
1176 $cflist conf -state normal
1177 $cflist delete 0.0 end
1178 if {$first ne {}} {
1179 $cflist insert end $first
1180 set cflist_top 1
1181 $cflist tag add highlight 1.0 "1.0 lineend"
1182 } else {
1183 catch {unset cflist_top}
1185 $cflist conf -state disabled
1186 set difffilestart {}
1189 proc highlight_tag {f} {
1190 global highlight_paths
1192 foreach p $highlight_paths {
1193 if {[string match $p $f]} {
1194 return "bold"
1197 return {}
1200 proc highlight_filelist {} {
1201 global cmitmode cflist
1203 $cflist conf -state normal
1204 if {$cmitmode ne "tree"} {
1205 set end [lindex [split [$cflist index end] .] 0]
1206 for {set l 2} {$l < $end} {incr l} {
1207 set line [$cflist get $l.0 "$l.0 lineend"]
1208 if {[highlight_tag $line] ne {}} {
1209 $cflist tag add bold $l.0 "$l.0 lineend"
1212 } else {
1213 highlight_tree 2 {}
1215 $cflist conf -state disabled
1218 proc unhighlight_filelist {} {
1219 global cflist
1221 $cflist conf -state normal
1222 $cflist tag remove bold 1.0 end
1223 $cflist conf -state disabled
1226 proc add_flist {fl} {
1227 global cflist
1229 $cflist conf -state normal
1230 foreach f $fl {
1231 $cflist insert end "\n"
1232 $cflist insert end $f [highlight_tag $f]
1234 $cflist conf -state disabled
1237 proc sel_flist {w x y} {
1238 global ctext difffilestart cflist cflist_top cmitmode
1240 if {$cmitmode eq "tree"} return
1241 if {![info exists cflist_top]} return
1242 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1243 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1244 $cflist tag add highlight $l.0 "$l.0 lineend"
1245 set cflist_top $l
1246 if {$l == 1} {
1247 $ctext yview 1.0
1248 } else {
1249 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1253 # Functions for adding and removing shell-type quoting
1255 proc shellquote {str} {
1256 if {![string match "*\['\"\\ \t]*" $str]} {
1257 return $str
1259 if {![string match "*\['\"\\]*" $str]} {
1260 return "\"$str\""
1262 if {![string match "*'*" $str]} {
1263 return "'$str'"
1265 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1268 proc shellarglist {l} {
1269 set str {}
1270 foreach a $l {
1271 if {$str ne {}} {
1272 append str " "
1274 append str [shellquote $a]
1276 return $str
1279 proc shelldequote {str} {
1280 set ret {}
1281 set used -1
1282 while {1} {
1283 incr used
1284 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1285 append ret [string range $str $used end]
1286 set used [string length $str]
1287 break
1289 set first [lindex $first 0]
1290 set ch [string index $str $first]
1291 if {$first > $used} {
1292 append ret [string range $str $used [expr {$first - 1}]]
1293 set used $first
1295 if {$ch eq " " || $ch eq "\t"} break
1296 incr used
1297 if {$ch eq "'"} {
1298 set first [string first "'" $str $used]
1299 if {$first < 0} {
1300 error "unmatched single-quote"
1302 append ret [string range $str $used [expr {$first - 1}]]
1303 set used $first
1304 continue
1306 if {$ch eq "\\"} {
1307 if {$used >= [string length $str]} {
1308 error "trailing backslash"
1310 append ret [string index $str $used]
1311 continue
1313 # here ch == "\""
1314 while {1} {
1315 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1316 error "unmatched double-quote"
1318 set first [lindex $first 0]
1319 set ch [string index $str $first]
1320 if {$first > $used} {
1321 append ret [string range $str $used [expr {$first - 1}]]
1322 set used $first
1324 if {$ch eq "\""} break
1325 incr used
1326 append ret [string index $str $used]
1327 incr used
1330 return [list $used $ret]
1333 proc shellsplit {str} {
1334 set l {}
1335 while {1} {
1336 set str [string trimleft $str]
1337 if {$str eq {}} break
1338 set dq [shelldequote $str]
1339 set n [lindex $dq 0]
1340 set word [lindex $dq 1]
1341 set str [string range $str $n end]
1342 lappend l $word
1344 return $l
1347 # Code to implement multiple views
1349 proc newview {ishighlight} {
1350 global nextviewnum newviewname newviewperm uifont newishighlight
1351 global newviewargs revtreeargs
1353 set newishighlight $ishighlight
1354 set top .gitkview
1355 if {[winfo exists $top]} {
1356 raise $top
1357 return
1359 set newviewname($nextviewnum) "View $nextviewnum"
1360 set newviewperm($nextviewnum) 0
1361 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1362 vieweditor $top $nextviewnum "Gitk view definition"
1365 proc editview {} {
1366 global curview
1367 global viewname viewperm newviewname newviewperm
1368 global viewargs newviewargs
1370 set top .gitkvedit-$curview
1371 if {[winfo exists $top]} {
1372 raise $top
1373 return
1375 set newviewname($curview) $viewname($curview)
1376 set newviewperm($curview) $viewperm($curview)
1377 set newviewargs($curview) [shellarglist $viewargs($curview)]
1378 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1381 proc vieweditor {top n title} {
1382 global newviewname newviewperm viewfiles
1383 global uifont
1385 toplevel $top
1386 wm title $top $title
1387 label $top.nl -text "Name" -font $uifont
1388 entry $top.name -width 20 -textvariable newviewname($n)
1389 grid $top.nl $top.name -sticky w -pady 5
1390 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1391 grid $top.perm - -pady 5 -sticky w
1392 message $top.al -aspect 1000 -font $uifont \
1393 -text "Commits to include (arguments to git rev-list):"
1394 grid $top.al - -sticky w -pady 5
1395 entry $top.args -width 50 -textvariable newviewargs($n) \
1396 -background white
1397 grid $top.args - -sticky ew -padx 5
1398 message $top.l -aspect 1000 -font $uifont \
1399 -text "Enter files and directories to include, one per line:"
1400 grid $top.l - -sticky w
1401 text $top.t -width 40 -height 10 -background white
1402 if {[info exists viewfiles($n)]} {
1403 foreach f $viewfiles($n) {
1404 $top.t insert end $f
1405 $top.t insert end "\n"
1407 $top.t delete {end - 1c} end
1408 $top.t mark set insert 0.0
1410 grid $top.t - -sticky ew -padx 5
1411 frame $top.buts
1412 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1413 button $top.buts.can -text "Cancel" -command [list destroy $top]
1414 grid $top.buts.ok $top.buts.can
1415 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1416 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1417 grid $top.buts - -pady 10 -sticky ew
1418 focus $top.t
1421 proc doviewmenu {m first cmd op argv} {
1422 set nmenu [$m index end]
1423 for {set i $first} {$i <= $nmenu} {incr i} {
1424 if {[$m entrycget $i -command] eq $cmd} {
1425 eval $m $op $i $argv
1426 break
1431 proc allviewmenus {n op args} {
1432 global viewhlmenu
1434 doviewmenu .bar.view 7 [list showview $n] $op $args
1435 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1438 proc newviewok {top n} {
1439 global nextviewnum newviewperm newviewname newishighlight
1440 global viewname viewfiles viewperm selectedview curview
1441 global viewargs newviewargs viewhlmenu
1443 if {[catch {
1444 set newargs [shellsplit $newviewargs($n)]
1445 } err]} {
1446 error_popup "Error in commit selection arguments: $err"
1447 wm raise $top
1448 focus $top
1449 return
1451 set files {}
1452 foreach f [split [$top.t get 0.0 end] "\n"] {
1453 set ft [string trim $f]
1454 if {$ft ne {}} {
1455 lappend files $ft
1458 if {![info exists viewfiles($n)]} {
1459 # creating a new view
1460 incr nextviewnum
1461 set viewname($n) $newviewname($n)
1462 set viewperm($n) $newviewperm($n)
1463 set viewfiles($n) $files
1464 set viewargs($n) $newargs
1465 addviewmenu $n
1466 if {!$newishighlight} {
1467 after idle showview $n
1468 } else {
1469 after idle addvhighlight $n
1471 } else {
1472 # editing an existing view
1473 set viewperm($n) $newviewperm($n)
1474 if {$newviewname($n) ne $viewname($n)} {
1475 set viewname($n) $newviewname($n)
1476 doviewmenu .bar.view 7 [list showview $n] \
1477 entryconf [list -label $viewname($n)]
1478 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1479 entryconf [list -label $viewname($n) -value $viewname($n)]
1481 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1482 set viewfiles($n) $files
1483 set viewargs($n) $newargs
1484 if {$curview == $n} {
1485 after idle updatecommits
1489 catch {destroy $top}
1492 proc delview {} {
1493 global curview viewdata viewperm hlview selectedhlview
1495 if {$curview == 0} return
1496 if {[info exists hlview] && $hlview == $curview} {
1497 set selectedhlview None
1498 unset hlview
1500 allviewmenus $curview delete
1501 set viewdata($curview) {}
1502 set viewperm($curview) 0
1503 showview 0
1506 proc addviewmenu {n} {
1507 global viewname viewhlmenu
1509 .bar.view add radiobutton -label $viewname($n) \
1510 -command [list showview $n] -variable selectedview -value $n
1511 $viewhlmenu add radiobutton -label $viewname($n) \
1512 -command [list addvhighlight $n] -variable selectedhlview
1515 proc flatten {var} {
1516 global $var
1518 set ret {}
1519 foreach i [array names $var] {
1520 lappend ret $i [set $var\($i\)]
1522 return $ret
1525 proc unflatten {var l} {
1526 global $var
1528 catch {unset $var}
1529 foreach {i v} $l {
1530 set $var\($i\) $v
1534 proc showview {n} {
1535 global curview viewdata viewfiles
1536 global displayorder parentlist childlist rowidlist rowoffsets
1537 global colormap rowtextx commitrow nextcolor canvxmax
1538 global numcommits rowrangelist commitlisted idrowranges
1539 global selectedline currentid canv canvy0
1540 global matchinglines treediffs
1541 global pending_select phase
1542 global commitidx rowlaidout rowoptim linesegends
1543 global commfd nextupdate
1544 global selectedview
1545 global vparentlist vchildlist vdisporder vcmitlisted
1546 global hlview selectedhlview
1548 if {$n == $curview} return
1549 set selid {}
1550 if {[info exists selectedline]} {
1551 set selid $currentid
1552 set y [yc $selectedline]
1553 set ymax [lindex [$canv cget -scrollregion] 3]
1554 set span [$canv yview]
1555 set ytop [expr {[lindex $span 0] * $ymax}]
1556 set ybot [expr {[lindex $span 1] * $ymax}]
1557 if {$ytop < $y && $y < $ybot} {
1558 set yscreen [expr {$y - $ytop}]
1559 } else {
1560 set yscreen [expr {($ybot - $ytop) / 2}]
1563 unselectline
1564 normalline
1565 stopfindproc
1566 if {$curview >= 0} {
1567 set vparentlist($curview) $parentlist
1568 set vchildlist($curview) $childlist
1569 set vdisporder($curview) $displayorder
1570 set vcmitlisted($curview) $commitlisted
1571 if {$phase ne {}} {
1572 set viewdata($curview) \
1573 [list $phase $rowidlist $rowoffsets $rowrangelist \
1574 [flatten idrowranges] [flatten idinlist] \
1575 $rowlaidout $rowoptim $numcommits $linesegends]
1576 } elseif {![info exists viewdata($curview)]
1577 || [lindex $viewdata($curview) 0] ne {}} {
1578 set viewdata($curview) \
1579 [list {} $rowidlist $rowoffsets $rowrangelist]
1582 catch {unset matchinglines}
1583 catch {unset treediffs}
1584 clear_display
1585 if {[info exists hlview] && $hlview == $n} {
1586 unset hlview
1587 set selectedhlview None
1590 set curview $n
1591 set selectedview $n
1592 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1593 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1595 if {![info exists viewdata($n)]} {
1596 set pending_select $selid
1597 getcommits
1598 return
1601 set v $viewdata($n)
1602 set phase [lindex $v 0]
1603 set displayorder $vdisporder($n)
1604 set parentlist $vparentlist($n)
1605 set childlist $vchildlist($n)
1606 set commitlisted $vcmitlisted($n)
1607 set rowidlist [lindex $v 1]
1608 set rowoffsets [lindex $v 2]
1609 set rowrangelist [lindex $v 3]
1610 if {$phase eq {}} {
1611 set numcommits [llength $displayorder]
1612 catch {unset idrowranges}
1613 } else {
1614 unflatten idrowranges [lindex $v 4]
1615 unflatten idinlist [lindex $v 5]
1616 set rowlaidout [lindex $v 6]
1617 set rowoptim [lindex $v 7]
1618 set numcommits [lindex $v 8]
1619 set linesegends [lindex $v 9]
1622 catch {unset colormap}
1623 catch {unset rowtextx}
1624 set nextcolor 0
1625 set canvxmax [$canv cget -width]
1626 set curview $n
1627 set row 0
1628 setcanvscroll
1629 set yf 0
1630 set row 0
1631 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1632 set row $commitrow($n,$selid)
1633 # try to get the selected row in the same position on the screen
1634 set ymax [lindex [$canv cget -scrollregion] 3]
1635 set ytop [expr {[yc $row] - $yscreen}]
1636 if {$ytop < 0} {
1637 set ytop 0
1639 set yf [expr {$ytop * 1.0 / $ymax}]
1641 allcanvs yview moveto $yf
1642 drawvisible
1643 selectline $row 0
1644 if {$phase ne {}} {
1645 if {$phase eq "getcommits"} {
1646 show_status "Reading commits..."
1648 if {[info exists commfd($n)]} {
1649 layoutmore
1650 } else {
1651 finishcommits
1653 } elseif {$numcommits == 0} {
1654 show_status "No commits selected"
1658 # Stuff relating to the highlighting facility
1660 proc ishighlighted {row} {
1661 global vhighlights fhighlights nhighlights rhighlights
1663 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1664 return $nhighlights($row)
1666 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1667 return $vhighlights($row)
1669 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1670 return $fhighlights($row)
1672 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1673 return $rhighlights($row)
1675 return 0
1678 proc bolden {row font} {
1679 global canv linehtag selectedline boldrows
1681 lappend boldrows $row
1682 $canv itemconf $linehtag($row) -font $font
1683 if {[info exists selectedline] && $row == $selectedline} {
1684 $canv delete secsel
1685 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1686 -outline {{}} -tags secsel \
1687 -fill [$canv cget -selectbackground]]
1688 $canv lower $t
1692 proc bolden_name {row font} {
1693 global canv2 linentag selectedline boldnamerows
1695 lappend boldnamerows $row
1696 $canv2 itemconf $linentag($row) -font $font
1697 if {[info exists selectedline] && $row == $selectedline} {
1698 $canv2 delete secsel
1699 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1700 -outline {{}} -tags secsel \
1701 -fill [$canv2 cget -selectbackground]]
1702 $canv2 lower $t
1706 proc unbolden {} {
1707 global mainfont boldrows
1709 set stillbold {}
1710 foreach row $boldrows {
1711 if {![ishighlighted $row]} {
1712 bolden $row $mainfont
1713 } else {
1714 lappend stillbold $row
1717 set boldrows $stillbold
1720 proc addvhighlight {n} {
1721 global hlview curview viewdata vhl_done vhighlights commitidx
1723 if {[info exists hlview]} {
1724 delvhighlight
1726 set hlview $n
1727 if {$n != $curview && ![info exists viewdata($n)]} {
1728 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1729 set vparentlist($n) {}
1730 set vchildlist($n) {}
1731 set vdisporder($n) {}
1732 set vcmitlisted($n) {}
1733 start_rev_list $n
1735 set vhl_done $commitidx($hlview)
1736 if {$vhl_done > 0} {
1737 drawvisible
1741 proc delvhighlight {} {
1742 global hlview vhighlights
1744 if {![info exists hlview]} return
1745 unset hlview
1746 catch {unset vhighlights}
1747 unbolden
1750 proc vhighlightmore {} {
1751 global hlview vhl_done commitidx vhighlights
1752 global displayorder vdisporder curview mainfont
1754 set font [concat $mainfont bold]
1755 set max $commitidx($hlview)
1756 if {$hlview == $curview} {
1757 set disp $displayorder
1758 } else {
1759 set disp $vdisporder($hlview)
1761 set vr [visiblerows]
1762 set r0 [lindex $vr 0]
1763 set r1 [lindex $vr 1]
1764 for {set i $vhl_done} {$i < $max} {incr i} {
1765 set id [lindex $disp $i]
1766 if {[info exists commitrow($curview,$id)]} {
1767 set row $commitrow($curview,$id)
1768 if {$r0 <= $row && $row <= $r1} {
1769 if {![highlighted $row]} {
1770 bolden $row $font
1772 set vhighlights($row) 1
1776 set vhl_done $max
1779 proc askvhighlight {row id} {
1780 global hlview vhighlights commitrow iddrawn mainfont
1782 if {[info exists commitrow($hlview,$id)]} {
1783 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1784 bolden $row [concat $mainfont bold]
1786 set vhighlights($row) 1
1787 } else {
1788 set vhighlights($row) 0
1792 proc hfiles_change {name ix op} {
1793 global highlight_files filehighlight fhighlights fh_serial
1794 global mainfont highlight_paths
1796 if {[info exists filehighlight]} {
1797 # delete previous highlights
1798 catch {close $filehighlight}
1799 unset filehighlight
1800 catch {unset fhighlights}
1801 unbolden
1802 unhighlight_filelist
1804 set highlight_paths {}
1805 after cancel do_file_hl $fh_serial
1806 incr fh_serial
1807 if {$highlight_files ne {}} {
1808 after 300 do_file_hl $fh_serial
1812 proc makepatterns {l} {
1813 set ret {}
1814 foreach e $l {
1815 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1816 if {[string index $ee end] eq "/"} {
1817 lappend ret "$ee*"
1818 } else {
1819 lappend ret $ee
1820 lappend ret "$ee/*"
1823 return $ret
1826 proc do_file_hl {serial} {
1827 global highlight_files filehighlight highlight_paths gdttype fhl_list
1829 if {$gdttype eq "touching paths:"} {
1830 if {[catch {set paths [shellsplit $highlight_files]}]} return
1831 set highlight_paths [makepatterns $paths]
1832 highlight_filelist
1833 set gdtargs [concat -- $paths]
1834 } else {
1835 set gdtargs [list "-S$highlight_files"]
1837 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1838 set filehighlight [open $cmd r+]
1839 fconfigure $filehighlight -blocking 0
1840 fileevent $filehighlight readable readfhighlight
1841 set fhl_list {}
1842 drawvisible
1843 flushhighlights
1846 proc flushhighlights {} {
1847 global filehighlight fhl_list
1849 if {[info exists filehighlight]} {
1850 lappend fhl_list {}
1851 puts $filehighlight ""
1852 flush $filehighlight
1856 proc askfilehighlight {row id} {
1857 global filehighlight fhighlights fhl_list
1859 lappend fhl_list $id
1860 set fhighlights($row) -1
1861 puts $filehighlight $id
1864 proc readfhighlight {} {
1865 global filehighlight fhighlights commitrow curview mainfont iddrawn
1866 global fhl_list
1868 while {[gets $filehighlight line] >= 0} {
1869 set line [string trim $line]
1870 set i [lsearch -exact $fhl_list $line]
1871 if {$i < 0} continue
1872 for {set j 0} {$j < $i} {incr j} {
1873 set id [lindex $fhl_list $j]
1874 if {[info exists commitrow($curview,$id)]} {
1875 set fhighlights($commitrow($curview,$id)) 0
1878 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1879 if {$line eq {}} continue
1880 if {![info exists commitrow($curview,$line)]} continue
1881 set row $commitrow($curview,$line)
1882 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1883 bolden $row [concat $mainfont bold]
1885 set fhighlights($row) 1
1887 if {[eof $filehighlight]} {
1888 # strange...
1889 puts "oops, git-diff-tree died"
1890 catch {close $filehighlight}
1891 unset filehighlight
1893 next_hlcont
1896 proc find_change {name ix op} {
1897 global nhighlights mainfont boldnamerows
1898 global findstring findpattern findtype
1900 # delete previous highlights, if any
1901 foreach row $boldnamerows {
1902 bolden_name $row $mainfont
1904 set boldnamerows {}
1905 catch {unset nhighlights}
1906 unbolden
1907 if {$findtype ne "Regexp"} {
1908 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1909 $findstring]
1910 set findpattern "*$e*"
1912 drawvisible
1915 proc askfindhighlight {row id} {
1916 global nhighlights commitinfo iddrawn mainfont
1917 global findstring findtype findloc findpattern
1919 if {![info exists commitinfo($id)]} {
1920 getcommit $id
1922 set info $commitinfo($id)
1923 set isbold 0
1924 set fldtypes {Headline Author Date Committer CDate Comments}
1925 foreach f $info ty $fldtypes {
1926 if {$findloc ne "All fields" && $findloc ne $ty} {
1927 continue
1929 if {$findtype eq "Regexp"} {
1930 set doesmatch [regexp $findstring $f]
1931 } elseif {$findtype eq "IgnCase"} {
1932 set doesmatch [string match -nocase $findpattern $f]
1933 } else {
1934 set doesmatch [string match $findpattern $f]
1936 if {$doesmatch} {
1937 if {$ty eq "Author"} {
1938 set isbold 2
1939 } else {
1940 set isbold 1
1944 if {[info exists iddrawn($id)]} {
1945 if {$isbold && ![ishighlighted $row]} {
1946 bolden $row [concat $mainfont bold]
1948 if {$isbold >= 2} {
1949 bolden_name $row [concat $mainfont bold]
1952 set nhighlights($row) $isbold
1955 proc vrel_change {name ix op} {
1956 global highlight_related
1958 rhighlight_none
1959 if {$highlight_related ne "None"} {
1960 after idle drawvisible
1964 # prepare for testing whether commits are descendents or ancestors of a
1965 proc rhighlight_sel {a} {
1966 global descendent desc_todo ancestor anc_todo
1967 global highlight_related rhighlights
1969 catch {unset descendent}
1970 set desc_todo [list $a]
1971 catch {unset ancestor}
1972 set anc_todo [list $a]
1973 if {$highlight_related ne "None"} {
1974 rhighlight_none
1975 after idle drawvisible
1979 proc rhighlight_none {} {
1980 global rhighlights
1982 catch {unset rhighlights}
1983 unbolden
1986 proc is_descendent {a} {
1987 global curview children commitrow descendent desc_todo
1989 set v $curview
1990 set la $commitrow($v,$a)
1991 set todo $desc_todo
1992 set leftover {}
1993 set done 0
1994 for {set i 0} {$i < [llength $todo]} {incr i} {
1995 set do [lindex $todo $i]
1996 if {$commitrow($v,$do) < $la} {
1997 lappend leftover $do
1998 continue
2000 foreach nk $children($v,$do) {
2001 if {![info exists descendent($nk)]} {
2002 set descendent($nk) 1
2003 lappend todo $nk
2004 if {$nk eq $a} {
2005 set done 1
2009 if {$done} {
2010 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2011 return
2014 set descendent($a) 0
2015 set desc_todo $leftover
2018 proc is_ancestor {a} {
2019 global curview parentlist commitrow ancestor anc_todo
2021 set v $curview
2022 set la $commitrow($v,$a)
2023 set todo $anc_todo
2024 set leftover {}
2025 set done 0
2026 for {set i 0} {$i < [llength $todo]} {incr i} {
2027 set do [lindex $todo $i]
2028 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2029 lappend leftover $do
2030 continue
2032 foreach np [lindex $parentlist $commitrow($v,$do)] {
2033 if {![info exists ancestor($np)]} {
2034 set ancestor($np) 1
2035 lappend todo $np
2036 if {$np eq $a} {
2037 set done 1
2041 if {$done} {
2042 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2043 return
2046 set ancestor($a) 0
2047 set anc_todo $leftover
2050 proc askrelhighlight {row id} {
2051 global descendent highlight_related iddrawn mainfont rhighlights
2052 global selectedline ancestor
2054 if {![info exists selectedline]} return
2055 set isbold 0
2056 if {$highlight_related eq "Descendent" ||
2057 $highlight_related eq "Not descendent"} {
2058 if {![info exists descendent($id)]} {
2059 is_descendent $id
2061 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2062 set isbold 1
2064 } elseif {$highlight_related eq "Ancestor" ||
2065 $highlight_related eq "Not ancestor"} {
2066 if {![info exists ancestor($id)]} {
2067 is_ancestor $id
2069 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2070 set isbold 1
2073 if {[info exists iddrawn($id)]} {
2074 if {$isbold && ![ishighlighted $row]} {
2075 bolden $row [concat $mainfont bold]
2078 set rhighlights($row) $isbold
2081 proc next_hlcont {} {
2082 global fhl_row fhl_dirn displayorder numcommits
2083 global vhighlights fhighlights nhighlights rhighlights
2084 global hlview filehighlight findstring highlight_related
2086 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2087 set row $fhl_row
2088 while {1} {
2089 if {$row < 0 || $row >= $numcommits} {
2090 bell
2091 set fhl_dirn 0
2092 return
2094 set id [lindex $displayorder $row]
2095 if {[info exists hlview]} {
2096 if {![info exists vhighlights($row)]} {
2097 askvhighlight $row $id
2099 if {$vhighlights($row) > 0} break
2101 if {$findstring ne {}} {
2102 if {![info exists nhighlights($row)]} {
2103 askfindhighlight $row $id
2105 if {$nhighlights($row) > 0} break
2107 if {$highlight_related ne "None"} {
2108 if {![info exists rhighlights($row)]} {
2109 askrelhighlight $row $id
2111 if {$rhighlights($row) > 0} break
2113 if {[info exists filehighlight]} {
2114 if {![info exists fhighlights($row)]} {
2115 # ask for a few more while we're at it...
2116 set r $row
2117 for {set n 0} {$n < 100} {incr n} {
2118 if {![info exists fhighlights($r)]} {
2119 askfilehighlight $r [lindex $displayorder $r]
2121 incr r $fhl_dirn
2122 if {$r < 0 || $r >= $numcommits} break
2124 flushhighlights
2126 if {$fhighlights($row) < 0} {
2127 set fhl_row $row
2128 return
2130 if {$fhighlights($row) > 0} break
2132 incr row $fhl_dirn
2134 set fhl_dirn 0
2135 selectline $row 1
2138 proc next_highlight {dirn} {
2139 global selectedline fhl_row fhl_dirn
2140 global hlview filehighlight findstring highlight_related
2142 if {![info exists selectedline]} return
2143 if {!([info exists hlview] || $findstring ne {} ||
2144 $highlight_related ne "None" || [info exists filehighlight])} return
2145 set fhl_row [expr {$selectedline + $dirn}]
2146 set fhl_dirn $dirn
2147 next_hlcont
2150 proc cancel_next_highlight {} {
2151 global fhl_dirn
2153 set fhl_dirn 0
2156 # Graph layout functions
2158 proc shortids {ids} {
2159 set res {}
2160 foreach id $ids {
2161 if {[llength $id] > 1} {
2162 lappend res [shortids $id]
2163 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2164 lappend res [string range $id 0 7]
2165 } else {
2166 lappend res $id
2169 return $res
2172 proc incrange {l x o} {
2173 set n [llength $l]
2174 while {$x < $n} {
2175 set e [lindex $l $x]
2176 if {$e ne {}} {
2177 lset l $x [expr {$e + $o}]
2179 incr x
2181 return $l
2184 proc ntimes {n o} {
2185 set ret {}
2186 for {} {$n > 0} {incr n -1} {
2187 lappend ret $o
2189 return $ret
2192 proc usedinrange {id l1 l2} {
2193 global children commitrow childlist curview
2195 if {[info exists commitrow($curview,$id)]} {
2196 set r $commitrow($curview,$id)
2197 if {$l1 <= $r && $r <= $l2} {
2198 return [expr {$r - $l1 + 1}]
2200 set kids [lindex $childlist $r]
2201 } else {
2202 set kids $children($curview,$id)
2204 foreach c $kids {
2205 set r $commitrow($curview,$c)
2206 if {$l1 <= $r && $r <= $l2} {
2207 return [expr {$r - $l1 + 1}]
2210 return 0
2213 proc sanity {row {full 0}} {
2214 global rowidlist rowoffsets
2216 set col -1
2217 set ids [lindex $rowidlist $row]
2218 foreach id $ids {
2219 incr col
2220 if {$id eq {}} continue
2221 if {$col < [llength $ids] - 1 &&
2222 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2223 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2225 set o [lindex $rowoffsets $row $col]
2226 set y $row
2227 set x $col
2228 while {$o ne {}} {
2229 incr y -1
2230 incr x $o
2231 if {[lindex $rowidlist $y $x] != $id} {
2232 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2233 puts " id=[shortids $id] check started at row $row"
2234 for {set i $row} {$i >= $y} {incr i -1} {
2235 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2237 break
2239 if {!$full} break
2240 set o [lindex $rowoffsets $y $x]
2245 proc makeuparrow {oid x y z} {
2246 global rowidlist rowoffsets uparrowlen idrowranges
2248 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2249 incr y -1
2250 incr x $z
2251 set off0 [lindex $rowoffsets $y]
2252 for {set x0 $x} {1} {incr x0} {
2253 if {$x0 >= [llength $off0]} {
2254 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2255 break
2257 set z [lindex $off0 $x0]
2258 if {$z ne {}} {
2259 incr x0 $z
2260 break
2263 set z [expr {$x0 - $x}]
2264 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2265 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2267 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2268 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2269 lappend idrowranges($oid) $y
2272 proc initlayout {} {
2273 global rowidlist rowoffsets displayorder commitlisted
2274 global rowlaidout rowoptim
2275 global idinlist rowchk rowrangelist idrowranges
2276 global numcommits canvxmax canv
2277 global nextcolor
2278 global parentlist childlist children
2279 global colormap rowtextx
2280 global linesegends
2282 set numcommits 0
2283 set displayorder {}
2284 set commitlisted {}
2285 set parentlist {}
2286 set childlist {}
2287 set rowrangelist {}
2288 set nextcolor 0
2289 set rowidlist {{}}
2290 set rowoffsets {{}}
2291 catch {unset idinlist}
2292 catch {unset rowchk}
2293 set rowlaidout 0
2294 set rowoptim 0
2295 set canvxmax [$canv cget -width]
2296 catch {unset colormap}
2297 catch {unset rowtextx}
2298 catch {unset idrowranges}
2299 set linesegends {}
2302 proc setcanvscroll {} {
2303 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2305 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2306 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2307 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2308 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2311 proc visiblerows {} {
2312 global canv numcommits linespc
2314 set ymax [lindex [$canv cget -scrollregion] 3]
2315 if {$ymax eq {} || $ymax == 0} return
2316 set f [$canv yview]
2317 set y0 [expr {int([lindex $f 0] * $ymax)}]
2318 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2319 if {$r0 < 0} {
2320 set r0 0
2322 set y1 [expr {int([lindex $f 1] * $ymax)}]
2323 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2324 if {$r1 >= $numcommits} {
2325 set r1 [expr {$numcommits - 1}]
2327 return [list $r0 $r1]
2330 proc layoutmore {} {
2331 global rowlaidout rowoptim commitidx numcommits optim_delay
2332 global uparrowlen curview
2334 set row $rowlaidout
2335 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2336 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2337 if {$orow > $rowoptim} {
2338 optimize_rows $rowoptim 0 $orow
2339 set rowoptim $orow
2341 set canshow [expr {$rowoptim - $optim_delay}]
2342 if {$canshow > $numcommits} {
2343 showstuff $canshow
2347 proc showstuff {canshow} {
2348 global numcommits commitrow pending_select selectedline
2349 global linesegends idrowranges idrangedrawn curview
2351 if {$numcommits == 0} {
2352 global phase
2353 set phase "incrdraw"
2354 allcanvs delete all
2356 set row $numcommits
2357 set numcommits $canshow
2358 setcanvscroll
2359 set rows [visiblerows]
2360 set r0 [lindex $rows 0]
2361 set r1 [lindex $rows 1]
2362 set selrow -1
2363 for {set r $row} {$r < $canshow} {incr r} {
2364 foreach id [lindex $linesegends [expr {$r+1}]] {
2365 set i -1
2366 foreach {s e} [rowranges $id] {
2367 incr i
2368 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2369 && ![info exists idrangedrawn($id,$i)]} {
2370 drawlineseg $id $i
2371 set idrangedrawn($id,$i) 1
2376 if {$canshow > $r1} {
2377 set canshow $r1
2379 while {$row < $canshow} {
2380 drawcmitrow $row
2381 incr row
2383 if {[info exists pending_select] &&
2384 [info exists commitrow($curview,$pending_select)] &&
2385 $commitrow($curview,$pending_select) < $numcommits} {
2386 selectline $commitrow($curview,$pending_select) 1
2388 if {![info exists selectedline] && ![info exists pending_select]} {
2389 selectline 0 1
2393 proc layoutrows {row endrow last} {
2394 global rowidlist rowoffsets displayorder
2395 global uparrowlen downarrowlen maxwidth mingaplen
2396 global childlist parentlist
2397 global idrowranges linesegends
2398 global commitidx curview
2399 global idinlist rowchk rowrangelist
2401 set idlist [lindex $rowidlist $row]
2402 set offs [lindex $rowoffsets $row]
2403 while {$row < $endrow} {
2404 set id [lindex $displayorder $row]
2405 set oldolds {}
2406 set newolds {}
2407 foreach p [lindex $parentlist $row] {
2408 if {![info exists idinlist($p)]} {
2409 lappend newolds $p
2410 } elseif {!$idinlist($p)} {
2411 lappend oldolds $p
2414 set lse {}
2415 set nev [expr {[llength $idlist] + [llength $newolds]
2416 + [llength $oldolds] - $maxwidth + 1}]
2417 if {$nev > 0} {
2418 if {!$last &&
2419 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2420 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2421 set i [lindex $idlist $x]
2422 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2423 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2424 [expr {$row + $uparrowlen + $mingaplen}]]
2425 if {$r == 0} {
2426 set idlist [lreplace $idlist $x $x]
2427 set offs [lreplace $offs $x $x]
2428 set offs [incrange $offs $x 1]
2429 set idinlist($i) 0
2430 set rm1 [expr {$row - 1}]
2431 lappend lse $i
2432 lappend idrowranges($i) $rm1
2433 if {[incr nev -1] <= 0} break
2434 continue
2436 set rowchk($id) [expr {$row + $r}]
2439 lset rowidlist $row $idlist
2440 lset rowoffsets $row $offs
2442 lappend linesegends $lse
2443 set col [lsearch -exact $idlist $id]
2444 if {$col < 0} {
2445 set col [llength $idlist]
2446 lappend idlist $id
2447 lset rowidlist $row $idlist
2448 set z {}
2449 if {[lindex $childlist $row] ne {}} {
2450 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2451 unset idinlist($id)
2453 lappend offs $z
2454 lset rowoffsets $row $offs
2455 if {$z ne {}} {
2456 makeuparrow $id $col $row $z
2458 } else {
2459 unset idinlist($id)
2461 set ranges {}
2462 if {[info exists idrowranges($id)]} {
2463 set ranges $idrowranges($id)
2464 lappend ranges $row
2465 unset idrowranges($id)
2467 lappend rowrangelist $ranges
2468 incr row
2469 set offs [ntimes [llength $idlist] 0]
2470 set l [llength $newolds]
2471 set idlist [eval lreplace \$idlist $col $col $newolds]
2472 set o 0
2473 if {$l != 1} {
2474 set offs [lrange $offs 0 [expr {$col - 1}]]
2475 foreach x $newolds {
2476 lappend offs {}
2477 incr o -1
2479 incr o
2480 set tmp [expr {[llength $idlist] - [llength $offs]}]
2481 if {$tmp > 0} {
2482 set offs [concat $offs [ntimes $tmp $o]]
2484 } else {
2485 lset offs $col {}
2487 foreach i $newolds {
2488 set idinlist($i) 1
2489 set idrowranges($i) $row
2491 incr col $l
2492 foreach oid $oldolds {
2493 set idinlist($oid) 1
2494 set idlist [linsert $idlist $col $oid]
2495 set offs [linsert $offs $col $o]
2496 makeuparrow $oid $col $row $o
2497 incr col
2499 lappend rowidlist $idlist
2500 lappend rowoffsets $offs
2502 return $row
2505 proc addextraid {id row} {
2506 global displayorder commitrow commitinfo
2507 global commitidx commitlisted
2508 global parentlist childlist children curview
2510 incr commitidx($curview)
2511 lappend displayorder $id
2512 lappend commitlisted 0
2513 lappend parentlist {}
2514 set commitrow($curview,$id) $row
2515 readcommit $id
2516 if {![info exists commitinfo($id)]} {
2517 set commitinfo($id) {"No commit information available"}
2519 if {![info exists children($curview,$id)]} {
2520 set children($curview,$id) {}
2522 lappend childlist $children($curview,$id)
2525 proc layouttail {} {
2526 global rowidlist rowoffsets idinlist commitidx curview
2527 global idrowranges rowrangelist
2529 set row $commitidx($curview)
2530 set idlist [lindex $rowidlist $row]
2531 while {$idlist ne {}} {
2532 set col [expr {[llength $idlist] - 1}]
2533 set id [lindex $idlist $col]
2534 addextraid $id $row
2535 unset idinlist($id)
2536 lappend idrowranges($id) $row
2537 lappend rowrangelist $idrowranges($id)
2538 unset idrowranges($id)
2539 incr row
2540 set offs [ntimes $col 0]
2541 set idlist [lreplace $idlist $col $col]
2542 lappend rowidlist $idlist
2543 lappend rowoffsets $offs
2546 foreach id [array names idinlist] {
2547 addextraid $id $row
2548 lset rowidlist $row [list $id]
2549 lset rowoffsets $row 0
2550 makeuparrow $id 0 $row 0
2551 lappend idrowranges($id) $row
2552 lappend rowrangelist $idrowranges($id)
2553 unset idrowranges($id)
2554 incr row
2555 lappend rowidlist {}
2556 lappend rowoffsets {}
2560 proc insert_pad {row col npad} {
2561 global rowidlist rowoffsets
2563 set pad [ntimes $npad {}]
2564 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2565 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2566 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2569 proc optimize_rows {row col endrow} {
2570 global rowidlist rowoffsets idrowranges displayorder
2572 for {} {$row < $endrow} {incr row} {
2573 set idlist [lindex $rowidlist $row]
2574 set offs [lindex $rowoffsets $row]
2575 set haspad 0
2576 for {} {$col < [llength $offs]} {incr col} {
2577 if {[lindex $idlist $col] eq {}} {
2578 set haspad 1
2579 continue
2581 set z [lindex $offs $col]
2582 if {$z eq {}} continue
2583 set isarrow 0
2584 set x0 [expr {$col + $z}]
2585 set y0 [expr {$row - 1}]
2586 set z0 [lindex $rowoffsets $y0 $x0]
2587 if {$z0 eq {}} {
2588 set id [lindex $idlist $col]
2589 set ranges [rowranges $id]
2590 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2591 set isarrow 1
2594 if {$z < -1 || ($z < 0 && $isarrow)} {
2595 set npad [expr {-1 - $z + $isarrow}]
2596 set offs [incrange $offs $col $npad]
2597 insert_pad $y0 $x0 $npad
2598 if {$y0 > 0} {
2599 optimize_rows $y0 $x0 $row
2601 set z [lindex $offs $col]
2602 set x0 [expr {$col + $z}]
2603 set z0 [lindex $rowoffsets $y0 $x0]
2604 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2605 set npad [expr {$z - 1 + $isarrow}]
2606 set y1 [expr {$row + 1}]
2607 set offs2 [lindex $rowoffsets $y1]
2608 set x1 -1
2609 foreach z $offs2 {
2610 incr x1
2611 if {$z eq {} || $x1 + $z < $col} continue
2612 if {$x1 + $z > $col} {
2613 incr npad
2615 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2616 break
2618 set pad [ntimes $npad {}]
2619 set idlist [eval linsert \$idlist $col $pad]
2620 set tmp [eval linsert \$offs $col $pad]
2621 incr col $npad
2622 set offs [incrange $tmp $col [expr {-$npad}]]
2623 set z [lindex $offs $col]
2624 set haspad 1
2626 if {$z0 eq {} && !$isarrow} {
2627 # this line links to its first child on row $row-2
2628 set rm2 [expr {$row - 2}]
2629 set id [lindex $displayorder $rm2]
2630 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2631 if {$xc >= 0} {
2632 set z0 [expr {$xc - $x0}]
2635 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2636 insert_pad $y0 $x0 1
2637 set offs [incrange $offs $col 1]
2638 optimize_rows $y0 [expr {$x0 + 1}] $row
2641 if {!$haspad} {
2642 set o {}
2643 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2644 set o [lindex $offs $col]
2645 if {$o eq {}} {
2646 # check if this is the link to the first child
2647 set id [lindex $idlist $col]
2648 set ranges [rowranges $id]
2649 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2650 # it is, work out offset to child
2651 set y0 [expr {$row - 1}]
2652 set id [lindex $displayorder $y0]
2653 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2654 if {$x0 >= 0} {
2655 set o [expr {$x0 - $col}]
2659 if {$o eq {} || $o <= 0} break
2661 if {$o ne {} && [incr col] < [llength $idlist]} {
2662 set y1 [expr {$row + 1}]
2663 set offs2 [lindex $rowoffsets $y1]
2664 set x1 -1
2665 foreach z $offs2 {
2666 incr x1
2667 if {$z eq {} || $x1 + $z < $col} continue
2668 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2669 break
2671 set idlist [linsert $idlist $col {}]
2672 set tmp [linsert $offs $col {}]
2673 incr col
2674 set offs [incrange $tmp $col -1]
2677 lset rowidlist $row $idlist
2678 lset rowoffsets $row $offs
2679 set col 0
2683 proc xc {row col} {
2684 global canvx0 linespc
2685 return [expr {$canvx0 + $col * $linespc}]
2688 proc yc {row} {
2689 global canvy0 linespc
2690 return [expr {$canvy0 + $row * $linespc}]
2693 proc linewidth {id} {
2694 global thickerline lthickness
2696 set wid $lthickness
2697 if {[info exists thickerline] && $id eq $thickerline} {
2698 set wid [expr {2 * $lthickness}]
2700 return $wid
2703 proc rowranges {id} {
2704 global phase idrowranges commitrow rowlaidout rowrangelist curview
2706 set ranges {}
2707 if {$phase eq {} ||
2708 ([info exists commitrow($curview,$id)]
2709 && $commitrow($curview,$id) < $rowlaidout)} {
2710 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2711 } elseif {[info exists idrowranges($id)]} {
2712 set ranges $idrowranges($id)
2714 return $ranges
2717 proc drawlineseg {id i} {
2718 global rowoffsets rowidlist
2719 global displayorder
2720 global canv colormap linespc
2721 global numcommits commitrow curview
2723 set ranges [rowranges $id]
2724 set downarrow 1
2725 if {[info exists commitrow($curview,$id)]
2726 && $commitrow($curview,$id) < $numcommits} {
2727 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2728 } else {
2729 set downarrow 1
2731 set startrow [lindex $ranges [expr {2 * $i}]]
2732 set row [lindex $ranges [expr {2 * $i + 1}]]
2733 if {$startrow == $row} return
2734 assigncolor $id
2735 set coords {}
2736 set col [lsearch -exact [lindex $rowidlist $row] $id]
2737 if {$col < 0} {
2738 puts "oops: drawline: id $id not on row $row"
2739 return
2741 set lasto {}
2742 set ns 0
2743 while {1} {
2744 set o [lindex $rowoffsets $row $col]
2745 if {$o eq {}} break
2746 if {$o ne $lasto} {
2747 # changing direction
2748 set x [xc $row $col]
2749 set y [yc $row]
2750 lappend coords $x $y
2751 set lasto $o
2753 incr col $o
2754 incr row -1
2756 set x [xc $row $col]
2757 set y [yc $row]
2758 lappend coords $x $y
2759 if {$i == 0} {
2760 # draw the link to the first child as part of this line
2761 incr row -1
2762 set child [lindex $displayorder $row]
2763 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2764 if {$ccol >= 0} {
2765 set x [xc $row $ccol]
2766 set y [yc $row]
2767 if {$ccol < $col - 1} {
2768 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2769 } elseif {$ccol > $col + 1} {
2770 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2772 lappend coords $x $y
2775 if {[llength $coords] < 4} return
2776 if {$downarrow} {
2777 # This line has an arrow at the lower end: check if the arrow is
2778 # on a diagonal segment, and if so, work around the Tk 8.4
2779 # refusal to draw arrows on diagonal lines.
2780 set x0 [lindex $coords 0]
2781 set x1 [lindex $coords 2]
2782 if {$x0 != $x1} {
2783 set y0 [lindex $coords 1]
2784 set y1 [lindex $coords 3]
2785 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2786 # we have a nearby vertical segment, just trim off the diag bit
2787 set coords [lrange $coords 2 end]
2788 } else {
2789 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2790 set xi [expr {$x0 - $slope * $linespc / 2}]
2791 set yi [expr {$y0 - $linespc / 2}]
2792 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2796 set arrow [expr {2 * ($i > 0) + $downarrow}]
2797 set arrow [lindex {none first last both} $arrow]
2798 set t [$canv create line $coords -width [linewidth $id] \
2799 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2800 $canv lower $t
2801 bindline $t $id
2804 proc drawparentlinks {id row col olds} {
2805 global rowidlist canv colormap
2807 set row2 [expr {$row + 1}]
2808 set x [xc $row $col]
2809 set y [yc $row]
2810 set y2 [yc $row2]
2811 set ids [lindex $rowidlist $row2]
2812 # rmx = right-most X coord used
2813 set rmx 0
2814 foreach p $olds {
2815 set i [lsearch -exact $ids $p]
2816 if {$i < 0} {
2817 puts "oops, parent $p of $id not in list"
2818 continue
2820 set x2 [xc $row2 $i]
2821 if {$x2 > $rmx} {
2822 set rmx $x2
2824 set ranges [rowranges $p]
2825 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2826 && $row2 < [lindex $ranges 1]} {
2827 # drawlineseg will do this one for us
2828 continue
2830 assigncolor $p
2831 # should handle duplicated parents here...
2832 set coords [list $x $y]
2833 if {$i < $col - 1} {
2834 lappend coords [xc $row [expr {$i + 1}]] $y
2835 } elseif {$i > $col + 1} {
2836 lappend coords [xc $row [expr {$i - 1}]] $y
2838 lappend coords $x2 $y2
2839 set t [$canv create line $coords -width [linewidth $p] \
2840 -fill $colormap($p) -tags lines.$p]
2841 $canv lower $t
2842 bindline $t $p
2844 return $rmx
2847 proc drawlines {id} {
2848 global colormap canv
2849 global idrangedrawn
2850 global children iddrawn commitrow rowidlist curview
2852 $canv delete lines.$id
2853 set nr [expr {[llength [rowranges $id]] / 2}]
2854 for {set i 0} {$i < $nr} {incr i} {
2855 if {[info exists idrangedrawn($id,$i)]} {
2856 drawlineseg $id $i
2859 foreach child $children($curview,$id) {
2860 if {[info exists iddrawn($child)]} {
2861 set row $commitrow($curview,$child)
2862 set col [lsearch -exact [lindex $rowidlist $row] $child]
2863 if {$col >= 0} {
2864 drawparentlinks $child $row $col [list $id]
2870 proc drawcmittext {id row col rmx} {
2871 global linespc canv canv2 canv3 canvy0
2872 global commitlisted commitinfo rowidlist
2873 global rowtextx idpos idtags idheads idotherrefs
2874 global linehtag linentag linedtag
2875 global mainfont canvxmax boldrows boldnamerows
2877 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2878 set x [xc $row $col]
2879 set y [yc $row]
2880 set orad [expr {$linespc / 3}]
2881 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2882 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2883 -fill $ofill -outline black -width 1]
2884 $canv raise $t
2885 $canv bind $t <1> {selcanvline {} %x %y}
2886 set xt [xc $row [llength [lindex $rowidlist $row]]]
2887 if {$xt < $rmx} {
2888 set xt $rmx
2890 set rowtextx($row) $xt
2891 set idpos($id) [list $x $xt $y]
2892 if {[info exists idtags($id)] || [info exists idheads($id)]
2893 || [info exists idotherrefs($id)]} {
2894 set xt [drawtags $id $x $xt $y]
2896 set headline [lindex $commitinfo($id) 0]
2897 set name [lindex $commitinfo($id) 1]
2898 set date [lindex $commitinfo($id) 2]
2899 set date [formatdate $date]
2900 set font $mainfont
2901 set nfont $mainfont
2902 set isbold [ishighlighted $row]
2903 if {$isbold > 0} {
2904 lappend boldrows $row
2905 lappend font bold
2906 if {$isbold > 1} {
2907 lappend boldnamerows $row
2908 lappend nfont bold
2911 set linehtag($row) [$canv create text $xt $y -anchor w \
2912 -text $headline -font $font]
2913 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2914 set linentag($row) [$canv2 create text 3 $y -anchor w \
2915 -text $name -font $nfont]
2916 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2917 -text $date -font $mainfont]
2918 set xr [expr {$xt + [font measure $mainfont $headline]}]
2919 if {$xr > $canvxmax} {
2920 set canvxmax $xr
2921 setcanvscroll
2925 proc drawcmitrow {row} {
2926 global displayorder rowidlist
2927 global idrangedrawn iddrawn
2928 global commitinfo parentlist numcommits
2929 global filehighlight fhighlights findstring nhighlights
2930 global hlview vhighlights
2931 global highlight_related rhighlights
2933 if {$row >= $numcommits} return
2934 foreach id [lindex $rowidlist $row] {
2935 if {$id eq {}} continue
2936 set i -1
2937 foreach {s e} [rowranges $id] {
2938 incr i
2939 if {$row < $s} continue
2940 if {$e eq {}} break
2941 if {$row <= $e} {
2942 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2943 drawlineseg $id $i
2944 set idrangedrawn($id,$i) 1
2946 break
2951 set id [lindex $displayorder $row]
2952 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2953 askvhighlight $row $id
2955 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2956 askfilehighlight $row $id
2958 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2959 askfindhighlight $row $id
2961 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2962 askrelhighlight $row $id
2964 if {[info exists iddrawn($id)]} return
2965 set col [lsearch -exact [lindex $rowidlist $row] $id]
2966 if {$col < 0} {
2967 puts "oops, row $row id $id not in list"
2968 return
2970 if {![info exists commitinfo($id)]} {
2971 getcommit $id
2973 assigncolor $id
2974 set olds [lindex $parentlist $row]
2975 if {$olds ne {}} {
2976 set rmx [drawparentlinks $id $row $col $olds]
2977 } else {
2978 set rmx 0
2980 drawcmittext $id $row $col $rmx
2981 set iddrawn($id) 1
2984 proc drawfrac {f0 f1} {
2985 global numcommits canv
2986 global linespc
2988 set ymax [lindex [$canv cget -scrollregion] 3]
2989 if {$ymax eq {} || $ymax == 0} return
2990 set y0 [expr {int($f0 * $ymax)}]
2991 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2992 if {$row < 0} {
2993 set row 0
2995 set y1 [expr {int($f1 * $ymax)}]
2996 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2997 if {$endrow >= $numcommits} {
2998 set endrow [expr {$numcommits - 1}]
3000 for {} {$row <= $endrow} {incr row} {
3001 drawcmitrow $row
3005 proc drawvisible {} {
3006 global canv
3007 eval drawfrac [$canv yview]
3010 proc clear_display {} {
3011 global iddrawn idrangedrawn
3012 global vhighlights fhighlights nhighlights rhighlights
3014 allcanvs delete all
3015 catch {unset iddrawn}
3016 catch {unset idrangedrawn}
3017 catch {unset vhighlights}
3018 catch {unset fhighlights}
3019 catch {unset nhighlights}
3020 catch {unset rhighlights}
3023 proc findcrossings {id} {
3024 global rowidlist parentlist numcommits rowoffsets displayorder
3026 set cross {}
3027 set ccross {}
3028 foreach {s e} [rowranges $id] {
3029 if {$e >= $numcommits} {
3030 set e [expr {$numcommits - 1}]
3032 if {$e <= $s} continue
3033 set x [lsearch -exact [lindex $rowidlist $e] $id]
3034 if {$x < 0} {
3035 puts "findcrossings: oops, no [shortids $id] in row $e"
3036 continue
3038 for {set row $e} {[incr row -1] >= $s} {} {
3039 set olds [lindex $parentlist $row]
3040 set kid [lindex $displayorder $row]
3041 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3042 if {$kidx < 0} continue
3043 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3044 foreach p $olds {
3045 set px [lsearch -exact $nextrow $p]
3046 if {$px < 0} continue
3047 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3048 if {[lsearch -exact $ccross $p] >= 0} continue
3049 if {$x == $px + ($kidx < $px? -1: 1)} {
3050 lappend ccross $p
3051 } elseif {[lsearch -exact $cross $p] < 0} {
3052 lappend cross $p
3056 set inc [lindex $rowoffsets $row $x]
3057 if {$inc eq {}} break
3058 incr x $inc
3061 return [concat $ccross {{}} $cross]
3064 proc assigncolor {id} {
3065 global colormap colors nextcolor
3066 global commitrow parentlist children children curview
3068 if {[info exists colormap($id)]} return
3069 set ncolors [llength $colors]
3070 if {[info exists children($curview,$id)]} {
3071 set kids $children($curview,$id)
3072 } else {
3073 set kids {}
3075 if {[llength $kids] == 1} {
3076 set child [lindex $kids 0]
3077 if {[info exists colormap($child)]
3078 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3079 set colormap($id) $colormap($child)
3080 return
3083 set badcolors {}
3084 set origbad {}
3085 foreach x [findcrossings $id] {
3086 if {$x eq {}} {
3087 # delimiter between corner crossings and other crossings
3088 if {[llength $badcolors] >= $ncolors - 1} break
3089 set origbad $badcolors
3091 if {[info exists colormap($x)]
3092 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3093 lappend badcolors $colormap($x)
3096 if {[llength $badcolors] >= $ncolors} {
3097 set badcolors $origbad
3099 set origbad $badcolors
3100 if {[llength $badcolors] < $ncolors - 1} {
3101 foreach child $kids {
3102 if {[info exists colormap($child)]
3103 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3104 lappend badcolors $colormap($child)
3106 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3107 if {[info exists colormap($p)]
3108 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3109 lappend badcolors $colormap($p)
3113 if {[llength $badcolors] >= $ncolors} {
3114 set badcolors $origbad
3117 for {set i 0} {$i <= $ncolors} {incr i} {
3118 set c [lindex $colors $nextcolor]
3119 if {[incr nextcolor] >= $ncolors} {
3120 set nextcolor 0
3122 if {[lsearch -exact $badcolors $c]} break
3124 set colormap($id) $c
3127 proc bindline {t id} {
3128 global canv
3130 $canv bind $t <Enter> "lineenter %x %y $id"
3131 $canv bind $t <Motion> "linemotion %x %y $id"
3132 $canv bind $t <Leave> "lineleave $id"
3133 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3136 proc drawtags {id x xt y1} {
3137 global idtags idheads idotherrefs
3138 global linespc lthickness
3139 global canv mainfont commitrow rowtextx curview
3141 set marks {}
3142 set ntags 0
3143 set nheads 0
3144 if {[info exists idtags($id)]} {
3145 set marks $idtags($id)
3146 set ntags [llength $marks]
3148 if {[info exists idheads($id)]} {
3149 set marks [concat $marks $idheads($id)]
3150 set nheads [llength $idheads($id)]
3152 if {[info exists idotherrefs($id)]} {
3153 set marks [concat $marks $idotherrefs($id)]
3155 if {$marks eq {}} {
3156 return $xt
3159 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3160 set yt [expr {$y1 - 0.5 * $linespc}]
3161 set yb [expr {$yt + $linespc - 1}]
3162 set xvals {}
3163 set wvals {}
3164 foreach tag $marks {
3165 set wid [font measure $mainfont $tag]
3166 lappend xvals $xt
3167 lappend wvals $wid
3168 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3170 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3171 -width $lthickness -fill black -tags tag.$id]
3172 $canv lower $t
3173 foreach tag $marks x $xvals wid $wvals {
3174 set xl [expr {$x + $delta}]
3175 set xr [expr {$x + $delta + $wid + $lthickness}]
3176 if {[incr ntags -1] >= 0} {
3177 # draw a tag
3178 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3179 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3180 -width 1 -outline black -fill yellow -tags tag.$id]
3181 $canv bind $t <1> [list showtag $tag 1]
3182 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3183 } else {
3184 # draw a head or other ref
3185 if {[incr nheads -1] >= 0} {
3186 set col green
3187 } else {
3188 set col "#ddddff"
3190 set xl [expr {$xl - $delta/2}]
3191 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3192 -width 1 -outline black -fill $col -tags tag.$id
3193 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3194 set rwid [font measure $mainfont $remoteprefix]
3195 set xi [expr {$x + 1}]
3196 set yti [expr {$yt + 1}]
3197 set xri [expr {$x + $rwid}]
3198 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3199 -width 0 -fill "#ffddaa" -tags tag.$id
3202 set t [$canv create text $xl $y1 -anchor w -text $tag \
3203 -font $mainfont -tags tag.$id]
3204 if {$ntags >= 0} {
3205 $canv bind $t <1> [list showtag $tag 1]
3208 return $xt
3211 proc xcoord {i level ln} {
3212 global canvx0 xspc1 xspc2
3214 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3215 if {$i > 0 && $i == $level} {
3216 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3217 } elseif {$i > $level} {
3218 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3220 return $x
3223 proc show_status {msg} {
3224 global canv mainfont
3226 clear_display
3227 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3230 proc finishcommits {} {
3231 global commitidx phase curview
3232 global canv mainfont ctext maincursor textcursor
3233 global findinprogress pending_select
3235 if {$commitidx($curview) > 0} {
3236 drawrest
3237 } else {
3238 show_status "No commits selected"
3240 set phase {}
3241 catch {unset pending_select}
3244 # Don't change the text pane cursor if it is currently the hand cursor,
3245 # showing that we are over a sha1 ID link.
3246 proc settextcursor {c} {
3247 global ctext curtextcursor
3249 if {[$ctext cget -cursor] == $curtextcursor} {
3250 $ctext config -cursor $c
3252 set curtextcursor $c
3255 proc nowbusy {what} {
3256 global isbusy
3258 if {[array names isbusy] eq {}} {
3259 . config -cursor watch
3260 settextcursor watch
3262 set isbusy($what) 1
3265 proc notbusy {what} {
3266 global isbusy maincursor textcursor
3268 catch {unset isbusy($what)}
3269 if {[array names isbusy] eq {}} {
3270 . config -cursor $maincursor
3271 settextcursor $textcursor
3275 proc drawrest {} {
3276 global numcommits
3277 global startmsecs
3278 global canvy0 numcommits linespc
3279 global rowlaidout commitidx curview
3280 global pending_select
3282 set row $rowlaidout
3283 layoutrows $rowlaidout $commitidx($curview) 1
3284 layouttail
3285 optimize_rows $row 0 $commitidx($curview)
3286 showstuff $commitidx($curview)
3287 if {[info exists pending_select]} {
3288 selectline 0 1
3291 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3292 #puts "overall $drawmsecs ms for $numcommits commits"
3295 proc findmatches {f} {
3296 global findtype foundstring foundstrlen
3297 if {$findtype == "Regexp"} {
3298 set matches [regexp -indices -all -inline $foundstring $f]
3299 } else {
3300 if {$findtype == "IgnCase"} {
3301 set str [string tolower $f]
3302 } else {
3303 set str $f
3305 set matches {}
3306 set i 0
3307 while {[set j [string first $foundstring $str $i]] >= 0} {
3308 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3309 set i [expr {$j + $foundstrlen}]
3312 return $matches
3315 proc dofind {} {
3316 global findtype findloc findstring markedmatches commitinfo
3317 global numcommits displayorder linehtag linentag linedtag
3318 global mainfont canv canv2 canv3 selectedline
3319 global matchinglines foundstring foundstrlen matchstring
3320 global commitdata
3322 stopfindproc
3323 unmarkmatches
3324 cancel_next_highlight
3325 focus .
3326 set matchinglines {}
3327 if {$findtype == "IgnCase"} {
3328 set foundstring [string tolower $findstring]
3329 } else {
3330 set foundstring $findstring
3332 set foundstrlen [string length $findstring]
3333 if {$foundstrlen == 0} return
3334 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3335 set matchstring "*$matchstring*"
3336 if {![info exists selectedline]} {
3337 set oldsel -1
3338 } else {
3339 set oldsel $selectedline
3341 set didsel 0
3342 set fldtypes {Headline Author Date Committer CDate Comments}
3343 set l -1
3344 foreach id $displayorder {
3345 set d $commitdata($id)
3346 incr l
3347 if {$findtype == "Regexp"} {
3348 set doesmatch [regexp $foundstring $d]
3349 } elseif {$findtype == "IgnCase"} {
3350 set doesmatch [string match -nocase $matchstring $d]
3351 } else {
3352 set doesmatch [string match $matchstring $d]
3354 if {!$doesmatch} continue
3355 if {![info exists commitinfo($id)]} {
3356 getcommit $id
3358 set info $commitinfo($id)
3359 set doesmatch 0
3360 foreach f $info ty $fldtypes {
3361 if {$findloc != "All fields" && $findloc != $ty} {
3362 continue
3364 set matches [findmatches $f]
3365 if {$matches == {}} continue
3366 set doesmatch 1
3367 if {$ty == "Headline"} {
3368 drawcmitrow $l
3369 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3370 } elseif {$ty == "Author"} {
3371 drawcmitrow $l
3372 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3373 } elseif {$ty == "Date"} {
3374 drawcmitrow $l
3375 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3378 if {$doesmatch} {
3379 lappend matchinglines $l
3380 if {!$didsel && $l > $oldsel} {
3381 findselectline $l
3382 set didsel 1
3386 if {$matchinglines == {}} {
3387 bell
3388 } elseif {!$didsel} {
3389 findselectline [lindex $matchinglines 0]
3393 proc findselectline {l} {
3394 global findloc commentend ctext
3395 selectline $l 1
3396 if {$findloc == "All fields" || $findloc == "Comments"} {
3397 # highlight the matches in the comments
3398 set f [$ctext get 1.0 $commentend]
3399 set matches [findmatches $f]
3400 foreach match $matches {
3401 set start [lindex $match 0]
3402 set end [expr {[lindex $match 1] + 1}]
3403 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3408 proc findnext {restart} {
3409 global matchinglines selectedline
3410 if {![info exists matchinglines]} {
3411 if {$restart} {
3412 dofind
3414 return
3416 if {![info exists selectedline]} return
3417 foreach l $matchinglines {
3418 if {$l > $selectedline} {
3419 findselectline $l
3420 return
3423 bell
3426 proc findprev {} {
3427 global matchinglines selectedline
3428 if {![info exists matchinglines]} {
3429 dofind
3430 return
3432 if {![info exists selectedline]} return
3433 set prev {}
3434 foreach l $matchinglines {
3435 if {$l >= $selectedline} break
3436 set prev $l
3438 if {$prev != {}} {
3439 findselectline $prev
3440 } else {
3441 bell
3445 proc stopfindproc {{done 0}} {
3446 global findprocpid findprocfile findids
3447 global ctext findoldcursor phase maincursor textcursor
3448 global findinprogress
3450 catch {unset findids}
3451 if {[info exists findprocpid]} {
3452 if {!$done} {
3453 catch {exec kill $findprocpid}
3455 catch {close $findprocfile}
3456 unset findprocpid
3458 catch {unset findinprogress}
3459 notbusy find
3462 # mark a commit as matching by putting a yellow background
3463 # behind the headline
3464 proc markheadline {l id} {
3465 global canv mainfont linehtag
3467 drawcmitrow $l
3468 set bbox [$canv bbox $linehtag($l)]
3469 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3470 $canv lower $t
3473 # mark the bits of a headline, author or date that match a find string
3474 proc markmatches {canv l str tag matches font} {
3475 set bbox [$canv bbox $tag]
3476 set x0 [lindex $bbox 0]
3477 set y0 [lindex $bbox 1]
3478 set y1 [lindex $bbox 3]
3479 foreach match $matches {
3480 set start [lindex $match 0]
3481 set end [lindex $match 1]
3482 if {$start > $end} continue
3483 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3484 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3485 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3486 [expr {$x0+$xlen+2}] $y1 \
3487 -outline {} -tags matches -fill yellow]
3488 $canv lower $t
3492 proc unmarkmatches {} {
3493 global matchinglines findids
3494 allcanvs delete matches
3495 catch {unset matchinglines}
3496 catch {unset findids}
3499 proc selcanvline {w x y} {
3500 global canv canvy0 ctext linespc
3501 global rowtextx
3502 set ymax [lindex [$canv cget -scrollregion] 3]
3503 if {$ymax == {}} return
3504 set yfrac [lindex [$canv yview] 0]
3505 set y [expr {$y + $yfrac * $ymax}]
3506 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3507 if {$l < 0} {
3508 set l 0
3510 if {$w eq $canv} {
3511 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3513 unmarkmatches
3514 selectline $l 1
3517 proc commit_descriptor {p} {
3518 global commitinfo
3519 if {![info exists commitinfo($p)]} {
3520 getcommit $p
3522 set l "..."
3523 if {[llength $commitinfo($p)] > 1} {
3524 set l [lindex $commitinfo($p) 0]
3526 return "$p ($l)"
3529 # append some text to the ctext widget, and make any SHA1 ID
3530 # that we know about be a clickable link.
3531 proc appendwithlinks {text tags} {
3532 global ctext commitrow linknum curview
3534 set start [$ctext index "end - 1c"]
3535 $ctext insert end $text $tags
3536 $ctext insert end "\n"
3537 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3538 foreach l $links {
3539 set s [lindex $l 0]
3540 set e [lindex $l 1]
3541 set linkid [string range $text $s $e]
3542 if {![info exists commitrow($curview,$linkid)]} continue
3543 incr e
3544 $ctext tag add link "$start + $s c" "$start + $e c"
3545 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3546 $ctext tag bind link$linknum <1> \
3547 [list selectline $commitrow($curview,$linkid) 1]
3548 incr linknum
3550 $ctext tag conf link -foreground blue -underline 1
3551 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3552 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3555 proc viewnextline {dir} {
3556 global canv linespc
3558 $canv delete hover
3559 set ymax [lindex [$canv cget -scrollregion] 3]
3560 set wnow [$canv yview]
3561 set wtop [expr {[lindex $wnow 0] * $ymax}]
3562 set newtop [expr {$wtop + $dir * $linespc}]
3563 if {$newtop < 0} {
3564 set newtop 0
3565 } elseif {$newtop > $ymax} {
3566 set newtop $ymax
3568 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3571 proc selectline {l isnew} {
3572 global canv canv2 canv3 ctext commitinfo selectedline
3573 global displayorder linehtag linentag linedtag
3574 global canvy0 linespc parentlist childlist
3575 global currentid sha1entry
3576 global commentend idtags linknum
3577 global mergemax numcommits pending_select
3578 global cmitmode
3580 catch {unset pending_select}
3581 $canv delete hover
3582 normalline
3583 cancel_next_highlight
3584 if {$l < 0 || $l >= $numcommits} return
3585 set y [expr {$canvy0 + $l * $linespc}]
3586 set ymax [lindex [$canv cget -scrollregion] 3]
3587 set ytop [expr {$y - $linespc - 1}]
3588 set ybot [expr {$y + $linespc + 1}]
3589 set wnow [$canv yview]
3590 set wtop [expr {[lindex $wnow 0] * $ymax}]
3591 set wbot [expr {[lindex $wnow 1] * $ymax}]
3592 set wh [expr {$wbot - $wtop}]
3593 set newtop $wtop
3594 if {$ytop < $wtop} {
3595 if {$ybot < $wtop} {
3596 set newtop [expr {$y - $wh / 2.0}]
3597 } else {
3598 set newtop $ytop
3599 if {$newtop > $wtop - $linespc} {
3600 set newtop [expr {$wtop - $linespc}]
3603 } elseif {$ybot > $wbot} {
3604 if {$ytop > $wbot} {
3605 set newtop [expr {$y - $wh / 2.0}]
3606 } else {
3607 set newtop [expr {$ybot - $wh}]
3608 if {$newtop < $wtop + $linespc} {
3609 set newtop [expr {$wtop + $linespc}]
3613 if {$newtop != $wtop} {
3614 if {$newtop < 0} {
3615 set newtop 0
3617 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3618 drawvisible
3621 if {![info exists linehtag($l)]} return
3622 $canv delete secsel
3623 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3624 -tags secsel -fill [$canv cget -selectbackground]]
3625 $canv lower $t
3626 $canv2 delete secsel
3627 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3628 -tags secsel -fill [$canv2 cget -selectbackground]]
3629 $canv2 lower $t
3630 $canv3 delete secsel
3631 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3632 -tags secsel -fill [$canv3 cget -selectbackground]]
3633 $canv3 lower $t
3635 if {$isnew} {
3636 addtohistory [list selectline $l 0]
3639 set selectedline $l
3641 set id [lindex $displayorder $l]
3642 set currentid $id
3643 $sha1entry delete 0 end
3644 $sha1entry insert 0 $id
3645 $sha1entry selection from 0
3646 $sha1entry selection to end
3647 rhighlight_sel $id
3649 $ctext conf -state normal
3650 clear_ctext
3651 set linknum 0
3652 set info $commitinfo($id)
3653 set date [formatdate [lindex $info 2]]
3654 $ctext insert end "Author: [lindex $info 1] $date\n"
3655 set date [formatdate [lindex $info 4]]
3656 $ctext insert end "Committer: [lindex $info 3] $date\n"
3657 if {[info exists idtags($id)]} {
3658 $ctext insert end "Tags:"
3659 foreach tag $idtags($id) {
3660 $ctext insert end " $tag"
3662 $ctext insert end "\n"
3665 set headers {}
3666 set olds [lindex $parentlist $l]
3667 if {[llength $olds] > 1} {
3668 set np 0
3669 foreach p $olds {
3670 if {$np >= $mergemax} {
3671 set tag mmax
3672 } else {
3673 set tag m$np
3675 $ctext insert end "Parent: " $tag
3676 appendwithlinks [commit_descriptor $p] {}
3677 incr np
3679 } else {
3680 foreach p $olds {
3681 append headers "Parent: [commit_descriptor $p]\n"
3685 foreach c [lindex $childlist $l] {
3686 append headers "Child: [commit_descriptor $c]\n"
3689 # make anything that looks like a SHA1 ID be a clickable link
3690 appendwithlinks $headers {}
3691 appendwithlinks [lindex $info 5] {comment}
3693 $ctext tag delete Comments
3694 $ctext tag remove found 1.0 end
3695 $ctext conf -state disabled
3696 set commentend [$ctext index "end - 1c"]
3698 init_flist "Comments"
3699 if {$cmitmode eq "tree"} {
3700 gettree $id
3701 } elseif {[llength $olds] <= 1} {
3702 startdiff $id
3703 } else {
3704 mergediff $id $l
3708 proc selfirstline {} {
3709 unmarkmatches
3710 selectline 0 1
3713 proc sellastline {} {
3714 global numcommits
3715 unmarkmatches
3716 set l [expr {$numcommits - 1}]
3717 selectline $l 1
3720 proc selnextline {dir} {
3721 global selectedline
3722 if {![info exists selectedline]} return
3723 set l [expr {$selectedline + $dir}]
3724 unmarkmatches
3725 selectline $l 1
3728 proc selnextpage {dir} {
3729 global canv linespc selectedline numcommits
3731 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3732 if {$lpp < 1} {
3733 set lpp 1
3735 allcanvs yview scroll [expr {$dir * $lpp}] units
3736 drawvisible
3737 if {![info exists selectedline]} return
3738 set l [expr {$selectedline + $dir * $lpp}]
3739 if {$l < 0} {
3740 set l 0
3741 } elseif {$l >= $numcommits} {
3742 set l [expr $numcommits - 1]
3744 unmarkmatches
3745 selectline $l 1
3748 proc unselectline {} {
3749 global selectedline currentid
3751 catch {unset selectedline}
3752 catch {unset currentid}
3753 allcanvs delete secsel
3754 rhighlight_none
3755 cancel_next_highlight
3758 proc reselectline {} {
3759 global selectedline
3761 if {[info exists selectedline]} {
3762 selectline $selectedline 0
3766 proc addtohistory {cmd} {
3767 global history historyindex curview
3769 set elt [list $curview $cmd]
3770 if {$historyindex > 0
3771 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3772 return
3775 if {$historyindex < [llength $history]} {
3776 set history [lreplace $history $historyindex end $elt]
3777 } else {
3778 lappend history $elt
3780 incr historyindex
3781 if {$historyindex > 1} {
3782 .ctop.top.bar.leftbut conf -state normal
3783 } else {
3784 .ctop.top.bar.leftbut conf -state disabled
3786 .ctop.top.bar.rightbut conf -state disabled
3789 proc godo {elt} {
3790 global curview
3792 set view [lindex $elt 0]
3793 set cmd [lindex $elt 1]
3794 if {$curview != $view} {
3795 showview $view
3797 eval $cmd
3800 proc goback {} {
3801 global history historyindex
3803 if {$historyindex > 1} {
3804 incr historyindex -1
3805 godo [lindex $history [expr {$historyindex - 1}]]
3806 .ctop.top.bar.rightbut conf -state normal
3808 if {$historyindex <= 1} {
3809 .ctop.top.bar.leftbut conf -state disabled
3813 proc goforw {} {
3814 global history historyindex
3816 if {$historyindex < [llength $history]} {
3817 set cmd [lindex $history $historyindex]
3818 incr historyindex
3819 godo $cmd
3820 .ctop.top.bar.leftbut conf -state normal
3822 if {$historyindex >= [llength $history]} {
3823 .ctop.top.bar.rightbut conf -state disabled
3827 proc gettree {id} {
3828 global treefilelist treeidlist diffids diffmergeid treepending
3830 set diffids $id
3831 catch {unset diffmergeid}
3832 if {![info exists treefilelist($id)]} {
3833 if {![info exists treepending]} {
3834 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3835 return
3837 set treepending $id
3838 set treefilelist($id) {}
3839 set treeidlist($id) {}
3840 fconfigure $gtf -blocking 0
3841 fileevent $gtf readable [list gettreeline $gtf $id]
3843 } else {
3844 setfilelist $id
3848 proc gettreeline {gtf id} {
3849 global treefilelist treeidlist treepending cmitmode diffids
3851 while {[gets $gtf line] >= 0} {
3852 if {[lindex $line 1] ne "blob"} continue
3853 set sha1 [lindex $line 2]
3854 set fname [lindex $line 3]
3855 lappend treefilelist($id) $fname
3856 lappend treeidlist($id) $sha1
3858 if {![eof $gtf]} return
3859 close $gtf
3860 unset treepending
3861 if {$cmitmode ne "tree"} {
3862 if {![info exists diffmergeid]} {
3863 gettreediffs $diffids
3865 } elseif {$id ne $diffids} {
3866 gettree $diffids
3867 } else {
3868 setfilelist $id
3872 proc showfile {f} {
3873 global treefilelist treeidlist diffids
3874 global ctext commentend
3876 set i [lsearch -exact $treefilelist($diffids) $f]
3877 if {$i < 0} {
3878 puts "oops, $f not in list for id $diffids"
3879 return
3881 set blob [lindex $treeidlist($diffids) $i]
3882 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3883 puts "oops, error reading blob $blob: $err"
3884 return
3886 fconfigure $bf -blocking 0
3887 fileevent $bf readable [list getblobline $bf $diffids]
3888 $ctext config -state normal
3889 clear_ctext $commentend
3890 $ctext insert end "\n"
3891 $ctext insert end "$f\n" filesep
3892 $ctext config -state disabled
3893 $ctext yview $commentend
3896 proc getblobline {bf id} {
3897 global diffids cmitmode ctext
3899 if {$id ne $diffids || $cmitmode ne "tree"} {
3900 catch {close $bf}
3901 return
3903 $ctext config -state normal
3904 while {[gets $bf line] >= 0} {
3905 $ctext insert end "$line\n"
3907 if {[eof $bf]} {
3908 # delete last newline
3909 $ctext delete "end - 2c" "end - 1c"
3910 close $bf
3912 $ctext config -state disabled
3915 proc mergediff {id l} {
3916 global diffmergeid diffopts mdifffd
3917 global diffids
3918 global parentlist
3920 set diffmergeid $id
3921 set diffids $id
3922 # this doesn't seem to actually affect anything...
3923 set env(GIT_DIFF_OPTS) $diffopts
3924 set cmd [concat | git diff-tree --no-commit-id --cc $id]
3925 if {[catch {set mdf [open $cmd r]} err]} {
3926 error_popup "Error getting merge diffs: $err"
3927 return
3929 fconfigure $mdf -blocking 0
3930 set mdifffd($id) $mdf
3931 set np [llength [lindex $parentlist $l]]
3932 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3933 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3936 proc getmergediffline {mdf id np} {
3937 global diffmergeid ctext cflist nextupdate mergemax
3938 global difffilestart mdifffd
3940 set n [gets $mdf line]
3941 if {$n < 0} {
3942 if {[eof $mdf]} {
3943 close $mdf
3945 return
3947 if {![info exists diffmergeid] || $id != $diffmergeid
3948 || $mdf != $mdifffd($id)} {
3949 return
3951 $ctext conf -state normal
3952 if {[regexp {^diff --cc (.*)} $line match fname]} {
3953 # start of a new file
3954 $ctext insert end "\n"
3955 set here [$ctext index "end - 1c"]
3956 lappend difffilestart $here
3957 add_flist [list $fname]
3958 set l [expr {(78 - [string length $fname]) / 2}]
3959 set pad [string range "----------------------------------------" 1 $l]
3960 $ctext insert end "$pad $fname $pad\n" filesep
3961 } elseif {[regexp {^@@} $line]} {
3962 $ctext insert end "$line\n" hunksep
3963 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3964 # do nothing
3965 } else {
3966 # parse the prefix - one ' ', '-' or '+' for each parent
3967 set spaces {}
3968 set minuses {}
3969 set pluses {}
3970 set isbad 0
3971 for {set j 0} {$j < $np} {incr j} {
3972 set c [string range $line $j $j]
3973 if {$c == " "} {
3974 lappend spaces $j
3975 } elseif {$c == "-"} {
3976 lappend minuses $j
3977 } elseif {$c == "+"} {
3978 lappend pluses $j
3979 } else {
3980 set isbad 1
3981 break
3984 set tags {}
3985 set num {}
3986 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3987 # line doesn't appear in result, parents in $minuses have the line
3988 set num [lindex $minuses 0]
3989 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3990 # line appears in result, parents in $pluses don't have the line
3991 lappend tags mresult
3992 set num [lindex $spaces 0]
3994 if {$num ne {}} {
3995 if {$num >= $mergemax} {
3996 set num "max"
3998 lappend tags m$num
4000 $ctext insert end "$line\n" $tags
4002 $ctext conf -state disabled
4003 if {[clock clicks -milliseconds] >= $nextupdate} {
4004 incr nextupdate 100
4005 fileevent $mdf readable {}
4006 update
4007 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4011 proc startdiff {ids} {
4012 global treediffs diffids treepending diffmergeid
4014 set diffids $ids
4015 catch {unset diffmergeid}
4016 if {![info exists treediffs($ids)]} {
4017 if {![info exists treepending]} {
4018 gettreediffs $ids
4020 } else {
4021 addtocflist $ids
4025 proc addtocflist {ids} {
4026 global treediffs cflist
4027 add_flist $treediffs($ids)
4028 getblobdiffs $ids
4031 proc gettreediffs {ids} {
4032 global treediff treepending
4033 set treepending $ids
4034 set treediff {}
4035 if {[catch \
4036 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4037 ]} return
4038 fconfigure $gdtf -blocking 0
4039 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4042 proc gettreediffline {gdtf ids} {
4043 global treediff treediffs treepending diffids diffmergeid
4044 global cmitmode
4046 set n [gets $gdtf line]
4047 if {$n < 0} {
4048 if {![eof $gdtf]} return
4049 close $gdtf
4050 set treediffs($ids) $treediff
4051 unset treepending
4052 if {$cmitmode eq "tree"} {
4053 gettree $diffids
4054 } elseif {$ids != $diffids} {
4055 if {![info exists diffmergeid]} {
4056 gettreediffs $diffids
4058 } else {
4059 addtocflist $ids
4061 return
4063 set file [lindex $line 5]
4064 lappend treediff $file
4067 proc getblobdiffs {ids} {
4068 global diffopts blobdifffd diffids env curdifftag curtagstart
4069 global nextupdate diffinhdr treediffs
4071 set env(GIT_DIFF_OPTS) $diffopts
4072 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4073 if {[catch {set bdf [open $cmd r]} err]} {
4074 puts "error getting diffs: $err"
4075 return
4077 set diffinhdr 0
4078 fconfigure $bdf -blocking 0
4079 set blobdifffd($ids) $bdf
4080 set curdifftag Comments
4081 set curtagstart 0.0
4082 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4083 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4086 proc setinlist {var i val} {
4087 global $var
4089 while {[llength [set $var]] < $i} {
4090 lappend $var {}
4092 if {[llength [set $var]] == $i} {
4093 lappend $var $val
4094 } else {
4095 lset $var $i $val
4099 proc getblobdiffline {bdf ids} {
4100 global diffids blobdifffd ctext curdifftag curtagstart
4101 global diffnexthead diffnextnote difffilestart
4102 global nextupdate diffinhdr treediffs
4104 set n [gets $bdf line]
4105 if {$n < 0} {
4106 if {[eof $bdf]} {
4107 close $bdf
4108 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4109 $ctext tag add $curdifftag $curtagstart end
4112 return
4114 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4115 return
4117 $ctext conf -state normal
4118 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4119 # start of a new file
4120 $ctext insert end "\n"
4121 $ctext tag add $curdifftag $curtagstart end
4122 set here [$ctext index "end - 1c"]
4123 set curtagstart $here
4124 set header $newname
4125 set i [lsearch -exact $treediffs($ids) $fname]
4126 if {$i >= 0} {
4127 setinlist difffilestart $i $here
4129 if {$newname ne $fname} {
4130 set i [lsearch -exact $treediffs($ids) $newname]
4131 if {$i >= 0} {
4132 setinlist difffilestart $i $here
4135 set curdifftag "f:$fname"
4136 $ctext tag delete $curdifftag
4137 set l [expr {(78 - [string length $header]) / 2}]
4138 set pad [string range "----------------------------------------" 1 $l]
4139 $ctext insert end "$pad $header $pad\n" filesep
4140 set diffinhdr 1
4141 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4142 # do nothing
4143 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4144 set diffinhdr 0
4145 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4146 $line match f1l f1c f2l f2c rest]} {
4147 $ctext insert end "$line\n" hunksep
4148 set diffinhdr 0
4149 } else {
4150 set x [string range $line 0 0]
4151 if {$x == "-" || $x == "+"} {
4152 set tag [expr {$x == "+"}]
4153 $ctext insert end "$line\n" d$tag
4154 } elseif {$x == " "} {
4155 $ctext insert end "$line\n"
4156 } elseif {$diffinhdr || $x == "\\"} {
4157 # e.g. "\ No newline at end of file"
4158 $ctext insert end "$line\n" filesep
4159 } else {
4160 # Something else we don't recognize
4161 if {$curdifftag != "Comments"} {
4162 $ctext insert end "\n"
4163 $ctext tag add $curdifftag $curtagstart end
4164 set curtagstart [$ctext index "end - 1c"]
4165 set curdifftag Comments
4167 $ctext insert end "$line\n" filesep
4170 $ctext conf -state disabled
4171 if {[clock clicks -milliseconds] >= $nextupdate} {
4172 incr nextupdate 100
4173 fileevent $bdf readable {}
4174 update
4175 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4179 proc nextfile {} {
4180 global difffilestart ctext
4181 set here [$ctext index @0,0]
4182 foreach loc $difffilestart {
4183 if {[$ctext compare $loc > $here]} {
4184 $ctext yview $loc
4189 proc clear_ctext {{first 1.0}} {
4190 global ctext smarktop smarkbot
4192 set l [lindex [split $first .] 0]
4193 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4194 set smarktop $l
4196 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4197 set smarkbot $l
4199 $ctext delete $first end
4202 proc incrsearch {name ix op} {
4203 global ctext searchstring searchdirn
4205 $ctext tag remove found 1.0 end
4206 if {[catch {$ctext index anchor}]} {
4207 # no anchor set, use start of selection, or of visible area
4208 set sel [$ctext tag ranges sel]
4209 if {$sel ne {}} {
4210 $ctext mark set anchor [lindex $sel 0]
4211 } elseif {$searchdirn eq "-forwards"} {
4212 $ctext mark set anchor @0,0
4213 } else {
4214 $ctext mark set anchor @0,[winfo height $ctext]
4217 if {$searchstring ne {}} {
4218 set here [$ctext search $searchdirn -- $searchstring anchor]
4219 if {$here ne {}} {
4220 $ctext see $here
4222 searchmarkvisible 1
4226 proc dosearch {} {
4227 global sstring ctext searchstring searchdirn
4229 focus $sstring
4230 $sstring icursor end
4231 set searchdirn -forwards
4232 if {$searchstring ne {}} {
4233 set sel [$ctext tag ranges sel]
4234 if {$sel ne {}} {
4235 set start "[lindex $sel 0] + 1c"
4236 } elseif {[catch {set start [$ctext index anchor]}]} {
4237 set start "@0,0"
4239 set match [$ctext search -count mlen -- $searchstring $start]
4240 $ctext tag remove sel 1.0 end
4241 if {$match eq {}} {
4242 bell
4243 return
4245 $ctext see $match
4246 set mend "$match + $mlen c"
4247 $ctext tag add sel $match $mend
4248 $ctext mark unset anchor
4252 proc dosearchback {} {
4253 global sstring ctext searchstring searchdirn
4255 focus $sstring
4256 $sstring icursor end
4257 set searchdirn -backwards
4258 if {$searchstring ne {}} {
4259 set sel [$ctext tag ranges sel]
4260 if {$sel ne {}} {
4261 set start [lindex $sel 0]
4262 } elseif {[catch {set start [$ctext index anchor]}]} {
4263 set start @0,[winfo height $ctext]
4265 set match [$ctext search -backwards -count ml -- $searchstring $start]
4266 $ctext tag remove sel 1.0 end
4267 if {$match eq {}} {
4268 bell
4269 return
4271 $ctext see $match
4272 set mend "$match + $ml c"
4273 $ctext tag add sel $match $mend
4274 $ctext mark unset anchor
4278 proc searchmark {first last} {
4279 global ctext searchstring
4281 set mend $first.0
4282 while {1} {
4283 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4284 if {$match eq {}} break
4285 set mend "$match + $mlen c"
4286 $ctext tag add found $match $mend
4290 proc searchmarkvisible {doall} {
4291 global ctext smarktop smarkbot
4293 set topline [lindex [split [$ctext index @0,0] .] 0]
4294 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4295 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4296 # no overlap with previous
4297 searchmark $topline $botline
4298 set smarktop $topline
4299 set smarkbot $botline
4300 } else {
4301 if {$topline < $smarktop} {
4302 searchmark $topline [expr {$smarktop-1}]
4303 set smarktop $topline
4305 if {$botline > $smarkbot} {
4306 searchmark [expr {$smarkbot+1}] $botline
4307 set smarkbot $botline
4312 proc scrolltext {f0 f1} {
4313 global searchstring
4315 .ctop.cdet.left.sb set $f0 $f1
4316 if {$searchstring ne {}} {
4317 searchmarkvisible 0
4321 proc setcoords {} {
4322 global linespc charspc canvx0 canvy0 mainfont
4323 global xspc1 xspc2 lthickness
4325 set linespc [font metrics $mainfont -linespace]
4326 set charspc [font measure $mainfont "m"]
4327 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4328 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4329 set lthickness [expr {int($linespc / 9) + 1}]
4330 set xspc1(0) $linespc
4331 set xspc2 $linespc
4334 proc redisplay {} {
4335 global canv
4336 global selectedline
4338 set ymax [lindex [$canv cget -scrollregion] 3]
4339 if {$ymax eq {} || $ymax == 0} return
4340 set span [$canv yview]
4341 clear_display
4342 setcanvscroll
4343 allcanvs yview moveto [lindex $span 0]
4344 drawvisible
4345 if {[info exists selectedline]} {
4346 selectline $selectedline 0
4350 proc incrfont {inc} {
4351 global mainfont textfont ctext canv phase
4352 global stopped entries
4353 unmarkmatches
4354 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4355 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4356 setcoords
4357 $ctext conf -font $textfont
4358 $ctext tag conf filesep -font [concat $textfont bold]
4359 foreach e $entries {
4360 $e conf -font $mainfont
4362 if {$phase eq "getcommits"} {
4363 $canv itemconf textitems -font $mainfont
4365 redisplay
4368 proc clearsha1 {} {
4369 global sha1entry sha1string
4370 if {[string length $sha1string] == 40} {
4371 $sha1entry delete 0 end
4375 proc sha1change {n1 n2 op} {
4376 global sha1string currentid sha1but
4377 if {$sha1string == {}
4378 || ([info exists currentid] && $sha1string == $currentid)} {
4379 set state disabled
4380 } else {
4381 set state normal
4383 if {[$sha1but cget -state] == $state} return
4384 if {$state == "normal"} {
4385 $sha1but conf -state normal -relief raised -text "Goto: "
4386 } else {
4387 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4391 proc gotocommit {} {
4392 global sha1string currentid commitrow tagids headids
4393 global displayorder numcommits curview
4395 if {$sha1string == {}
4396 || ([info exists currentid] && $sha1string == $currentid)} return
4397 if {[info exists tagids($sha1string)]} {
4398 set id $tagids($sha1string)
4399 } elseif {[info exists headids($sha1string)]} {
4400 set id $headids($sha1string)
4401 } else {
4402 set id [string tolower $sha1string]
4403 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4404 set matches {}
4405 foreach i $displayorder {
4406 if {[string match $id* $i]} {
4407 lappend matches $i
4410 if {$matches ne {}} {
4411 if {[llength $matches] > 1} {
4412 error_popup "Short SHA1 id $id is ambiguous"
4413 return
4415 set id [lindex $matches 0]
4419 if {[info exists commitrow($curview,$id)]} {
4420 selectline $commitrow($curview,$id) 1
4421 return
4423 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4424 set type "SHA1 id"
4425 } else {
4426 set type "Tag/Head"
4428 error_popup "$type $sha1string is not known"
4431 proc lineenter {x y id} {
4432 global hoverx hovery hoverid hovertimer
4433 global commitinfo canv
4435 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4436 set hoverx $x
4437 set hovery $y
4438 set hoverid $id
4439 if {[info exists hovertimer]} {
4440 after cancel $hovertimer
4442 set hovertimer [after 500 linehover]
4443 $canv delete hover
4446 proc linemotion {x y id} {
4447 global hoverx hovery hoverid hovertimer
4449 if {[info exists hoverid] && $id == $hoverid} {
4450 set hoverx $x
4451 set hovery $y
4452 if {[info exists hovertimer]} {
4453 after cancel $hovertimer
4455 set hovertimer [after 500 linehover]
4459 proc lineleave {id} {
4460 global hoverid hovertimer canv
4462 if {[info exists hoverid] && $id == $hoverid} {
4463 $canv delete hover
4464 if {[info exists hovertimer]} {
4465 after cancel $hovertimer
4466 unset hovertimer
4468 unset hoverid
4472 proc linehover {} {
4473 global hoverx hovery hoverid hovertimer
4474 global canv linespc lthickness
4475 global commitinfo mainfont
4477 set text [lindex $commitinfo($hoverid) 0]
4478 set ymax [lindex [$canv cget -scrollregion] 3]
4479 if {$ymax == {}} return
4480 set yfrac [lindex [$canv yview] 0]
4481 set x [expr {$hoverx + 2 * $linespc}]
4482 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4483 set x0 [expr {$x - 2 * $lthickness}]
4484 set y0 [expr {$y - 2 * $lthickness}]
4485 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4486 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4487 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4488 -fill \#ffff80 -outline black -width 1 -tags hover]
4489 $canv raise $t
4490 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4491 $canv raise $t
4494 proc clickisonarrow {id y} {
4495 global lthickness
4497 set ranges [rowranges $id]
4498 set thresh [expr {2 * $lthickness + 6}]
4499 set n [expr {[llength $ranges] - 1}]
4500 for {set i 1} {$i < $n} {incr i} {
4501 set row [lindex $ranges $i]
4502 if {abs([yc $row] - $y) < $thresh} {
4503 return $i
4506 return {}
4509 proc arrowjump {id n y} {
4510 global canv
4512 # 1 <-> 2, 3 <-> 4, etc...
4513 set n [expr {(($n - 1) ^ 1) + 1}]
4514 set row [lindex [rowranges $id] $n]
4515 set yt [yc $row]
4516 set ymax [lindex [$canv cget -scrollregion] 3]
4517 if {$ymax eq {} || $ymax <= 0} return
4518 set view [$canv yview]
4519 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4520 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4521 if {$yfrac < 0} {
4522 set yfrac 0
4524 allcanvs yview moveto $yfrac
4527 proc lineclick {x y id isnew} {
4528 global ctext commitinfo children canv thickerline curview
4530 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4531 unmarkmatches
4532 unselectline
4533 normalline
4534 $canv delete hover
4535 # draw this line thicker than normal
4536 set thickerline $id
4537 drawlines $id
4538 if {$isnew} {
4539 set ymax [lindex [$canv cget -scrollregion] 3]
4540 if {$ymax eq {}} return
4541 set yfrac [lindex [$canv yview] 0]
4542 set y [expr {$y + $yfrac * $ymax}]
4544 set dirn [clickisonarrow $id $y]
4545 if {$dirn ne {}} {
4546 arrowjump $id $dirn $y
4547 return
4550 if {$isnew} {
4551 addtohistory [list lineclick $x $y $id 0]
4553 # fill the details pane with info about this line
4554 $ctext conf -state normal
4555 clear_ctext
4556 $ctext tag conf link -foreground blue -underline 1
4557 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4558 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4559 $ctext insert end "Parent:\t"
4560 $ctext insert end $id [list link link0]
4561 $ctext tag bind link0 <1> [list selbyid $id]
4562 set info $commitinfo($id)
4563 $ctext insert end "\n\t[lindex $info 0]\n"
4564 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4565 set date [formatdate [lindex $info 2]]
4566 $ctext insert end "\tDate:\t$date\n"
4567 set kids $children($curview,$id)
4568 if {$kids ne {}} {
4569 $ctext insert end "\nChildren:"
4570 set i 0
4571 foreach child $kids {
4572 incr i
4573 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4574 set info $commitinfo($child)
4575 $ctext insert end "\n\t"
4576 $ctext insert end $child [list link link$i]
4577 $ctext tag bind link$i <1> [list selbyid $child]
4578 $ctext insert end "\n\t[lindex $info 0]"
4579 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4580 set date [formatdate [lindex $info 2]]
4581 $ctext insert end "\n\tDate:\t$date\n"
4584 $ctext conf -state disabled
4585 init_flist {}
4588 proc normalline {} {
4589 global thickerline
4590 if {[info exists thickerline]} {
4591 set id $thickerline
4592 unset thickerline
4593 drawlines $id
4597 proc selbyid {id} {
4598 global commitrow curview
4599 if {[info exists commitrow($curview,$id)]} {
4600 selectline $commitrow($curview,$id) 1
4604 proc mstime {} {
4605 global startmstime
4606 if {![info exists startmstime]} {
4607 set startmstime [clock clicks -milliseconds]
4609 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4612 proc rowmenu {x y id} {
4613 global rowctxmenu commitrow selectedline rowmenuid curview
4615 if {![info exists selectedline]
4616 || $commitrow($curview,$id) eq $selectedline} {
4617 set state disabled
4618 } else {
4619 set state normal
4621 $rowctxmenu entryconfigure 0 -state $state
4622 $rowctxmenu entryconfigure 1 -state $state
4623 $rowctxmenu entryconfigure 2 -state $state
4624 set rowmenuid $id
4625 tk_popup $rowctxmenu $x $y
4628 proc diffvssel {dirn} {
4629 global rowmenuid selectedline displayorder
4631 if {![info exists selectedline]} return
4632 if {$dirn} {
4633 set oldid [lindex $displayorder $selectedline]
4634 set newid $rowmenuid
4635 } else {
4636 set oldid $rowmenuid
4637 set newid [lindex $displayorder $selectedline]
4639 addtohistory [list doseldiff $oldid $newid]
4640 doseldiff $oldid $newid
4643 proc doseldiff {oldid newid} {
4644 global ctext
4645 global commitinfo
4647 $ctext conf -state normal
4648 clear_ctext
4649 init_flist "Top"
4650 $ctext insert end "From "
4651 $ctext tag conf link -foreground blue -underline 1
4652 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4653 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4654 $ctext tag bind link0 <1> [list selbyid $oldid]
4655 $ctext insert end $oldid [list link link0]
4656 $ctext insert end "\n "
4657 $ctext insert end [lindex $commitinfo($oldid) 0]
4658 $ctext insert end "\n\nTo "
4659 $ctext tag bind link1 <1> [list selbyid $newid]
4660 $ctext insert end $newid [list link link1]
4661 $ctext insert end "\n "
4662 $ctext insert end [lindex $commitinfo($newid) 0]
4663 $ctext insert end "\n"
4664 $ctext conf -state disabled
4665 $ctext tag delete Comments
4666 $ctext tag remove found 1.0 end
4667 startdiff [list $oldid $newid]
4670 proc mkpatch {} {
4671 global rowmenuid currentid commitinfo patchtop patchnum
4673 if {![info exists currentid]} return
4674 set oldid $currentid
4675 set oldhead [lindex $commitinfo($oldid) 0]
4676 set newid $rowmenuid
4677 set newhead [lindex $commitinfo($newid) 0]
4678 set top .patch
4679 set patchtop $top
4680 catch {destroy $top}
4681 toplevel $top
4682 label $top.title -text "Generate patch"
4683 grid $top.title - -pady 10
4684 label $top.from -text "From:"
4685 entry $top.fromsha1 -width 40 -relief flat
4686 $top.fromsha1 insert 0 $oldid
4687 $top.fromsha1 conf -state readonly
4688 grid $top.from $top.fromsha1 -sticky w
4689 entry $top.fromhead -width 60 -relief flat
4690 $top.fromhead insert 0 $oldhead
4691 $top.fromhead conf -state readonly
4692 grid x $top.fromhead -sticky w
4693 label $top.to -text "To:"
4694 entry $top.tosha1 -width 40 -relief flat
4695 $top.tosha1 insert 0 $newid
4696 $top.tosha1 conf -state readonly
4697 grid $top.to $top.tosha1 -sticky w
4698 entry $top.tohead -width 60 -relief flat
4699 $top.tohead insert 0 $newhead
4700 $top.tohead conf -state readonly
4701 grid x $top.tohead -sticky w
4702 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4703 grid $top.rev x -pady 10
4704 label $top.flab -text "Output file:"
4705 entry $top.fname -width 60
4706 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4707 incr patchnum
4708 grid $top.flab $top.fname -sticky w
4709 frame $top.buts
4710 button $top.buts.gen -text "Generate" -command mkpatchgo
4711 button $top.buts.can -text "Cancel" -command mkpatchcan
4712 grid $top.buts.gen $top.buts.can
4713 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4714 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4715 grid $top.buts - -pady 10 -sticky ew
4716 focus $top.fname
4719 proc mkpatchrev {} {
4720 global patchtop
4722 set oldid [$patchtop.fromsha1 get]
4723 set oldhead [$patchtop.fromhead get]
4724 set newid [$patchtop.tosha1 get]
4725 set newhead [$patchtop.tohead get]
4726 foreach e [list fromsha1 fromhead tosha1 tohead] \
4727 v [list $newid $newhead $oldid $oldhead] {
4728 $patchtop.$e conf -state normal
4729 $patchtop.$e delete 0 end
4730 $patchtop.$e insert 0 $v
4731 $patchtop.$e conf -state readonly
4735 proc mkpatchgo {} {
4736 global patchtop
4738 set oldid [$patchtop.fromsha1 get]
4739 set newid [$patchtop.tosha1 get]
4740 set fname [$patchtop.fname get]
4741 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4742 error_popup "Error creating patch: $err"
4744 catch {destroy $patchtop}
4745 unset patchtop
4748 proc mkpatchcan {} {
4749 global patchtop
4751 catch {destroy $patchtop}
4752 unset patchtop
4755 proc mktag {} {
4756 global rowmenuid mktagtop commitinfo
4758 set top .maketag
4759 set mktagtop $top
4760 catch {destroy $top}
4761 toplevel $top
4762 label $top.title -text "Create tag"
4763 grid $top.title - -pady 10
4764 label $top.id -text "ID:"
4765 entry $top.sha1 -width 40 -relief flat
4766 $top.sha1 insert 0 $rowmenuid
4767 $top.sha1 conf -state readonly
4768 grid $top.id $top.sha1 -sticky w
4769 entry $top.head -width 60 -relief flat
4770 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4771 $top.head conf -state readonly
4772 grid x $top.head -sticky w
4773 label $top.tlab -text "Tag name:"
4774 entry $top.tag -width 60
4775 grid $top.tlab $top.tag -sticky w
4776 frame $top.buts
4777 button $top.buts.gen -text "Create" -command mktaggo
4778 button $top.buts.can -text "Cancel" -command mktagcan
4779 grid $top.buts.gen $top.buts.can
4780 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4781 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4782 grid $top.buts - -pady 10 -sticky ew
4783 focus $top.tag
4786 proc domktag {} {
4787 global mktagtop env tagids idtags
4789 set id [$mktagtop.sha1 get]
4790 set tag [$mktagtop.tag get]
4791 if {$tag == {}} {
4792 error_popup "No tag name specified"
4793 return
4795 if {[info exists tagids($tag)]} {
4796 error_popup "Tag \"$tag\" already exists"
4797 return
4799 if {[catch {
4800 set dir [gitdir]
4801 set fname [file join $dir "refs/tags" $tag]
4802 set f [open $fname w]
4803 puts $f $id
4804 close $f
4805 } err]} {
4806 error_popup "Error creating tag: $err"
4807 return
4810 set tagids($tag) $id
4811 lappend idtags($id) $tag
4812 redrawtags $id
4815 proc redrawtags {id} {
4816 global canv linehtag commitrow idpos selectedline curview
4818 if {![info exists commitrow($curview,$id)]} return
4819 drawcmitrow $commitrow($curview,$id)
4820 $canv delete tag.$id
4821 set xt [eval drawtags $id $idpos($id)]
4822 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4823 if {[info exists selectedline]
4824 && $selectedline == $commitrow($curview,$id)} {
4825 selectline $selectedline 0
4829 proc mktagcan {} {
4830 global mktagtop
4832 catch {destroy $mktagtop}
4833 unset mktagtop
4836 proc mktaggo {} {
4837 domktag
4838 mktagcan
4841 proc writecommit {} {
4842 global rowmenuid wrcomtop commitinfo wrcomcmd
4844 set top .writecommit
4845 set wrcomtop $top
4846 catch {destroy $top}
4847 toplevel $top
4848 label $top.title -text "Write commit to file"
4849 grid $top.title - -pady 10
4850 label $top.id -text "ID:"
4851 entry $top.sha1 -width 40 -relief flat
4852 $top.sha1 insert 0 $rowmenuid
4853 $top.sha1 conf -state readonly
4854 grid $top.id $top.sha1 -sticky w
4855 entry $top.head -width 60 -relief flat
4856 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4857 $top.head conf -state readonly
4858 grid x $top.head -sticky w
4859 label $top.clab -text "Command:"
4860 entry $top.cmd -width 60 -textvariable wrcomcmd
4861 grid $top.clab $top.cmd -sticky w -pady 10
4862 label $top.flab -text "Output file:"
4863 entry $top.fname -width 60
4864 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4865 grid $top.flab $top.fname -sticky w
4866 frame $top.buts
4867 button $top.buts.gen -text "Write" -command wrcomgo
4868 button $top.buts.can -text "Cancel" -command wrcomcan
4869 grid $top.buts.gen $top.buts.can
4870 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4871 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4872 grid $top.buts - -pady 10 -sticky ew
4873 focus $top.fname
4876 proc wrcomgo {} {
4877 global wrcomtop
4879 set id [$wrcomtop.sha1 get]
4880 set cmd "echo $id | [$wrcomtop.cmd get]"
4881 set fname [$wrcomtop.fname get]
4882 if {[catch {exec sh -c $cmd >$fname &} err]} {
4883 error_popup "Error writing commit: $err"
4885 catch {destroy $wrcomtop}
4886 unset wrcomtop
4889 proc wrcomcan {} {
4890 global wrcomtop
4892 catch {destroy $wrcomtop}
4893 unset wrcomtop
4896 proc listrefs {id} {
4897 global idtags idheads idotherrefs
4899 set x {}
4900 if {[info exists idtags($id)]} {
4901 set x $idtags($id)
4903 set y {}
4904 if {[info exists idheads($id)]} {
4905 set y $idheads($id)
4907 set z {}
4908 if {[info exists idotherrefs($id)]} {
4909 set z $idotherrefs($id)
4911 return [list $x $y $z]
4914 proc rereadrefs {} {
4915 global idtags idheads idotherrefs
4917 set refids [concat [array names idtags] \
4918 [array names idheads] [array names idotherrefs]]
4919 foreach id $refids {
4920 if {![info exists ref($id)]} {
4921 set ref($id) [listrefs $id]
4924 readrefs
4925 set refids [lsort -unique [concat $refids [array names idtags] \
4926 [array names idheads] [array names idotherrefs]]]
4927 foreach id $refids {
4928 set v [listrefs $id]
4929 if {![info exists ref($id)] || $ref($id) != $v} {
4930 redrawtags $id
4935 proc showtag {tag isnew} {
4936 global ctext tagcontents tagids linknum
4938 if {$isnew} {
4939 addtohistory [list showtag $tag 0]
4941 $ctext conf -state normal
4942 clear_ctext
4943 set linknum 0
4944 if {[info exists tagcontents($tag)]} {
4945 set text $tagcontents($tag)
4946 } else {
4947 set text "Tag: $tag\nId: $tagids($tag)"
4949 appendwithlinks $text {}
4950 $ctext conf -state disabled
4951 init_flist {}
4954 proc doquit {} {
4955 global stopped
4956 set stopped 100
4957 destroy .
4960 proc doprefs {} {
4961 global maxwidth maxgraphpct diffopts
4962 global oldprefs prefstop
4964 set top .gitkprefs
4965 set prefstop $top
4966 if {[winfo exists $top]} {
4967 raise $top
4968 return
4970 foreach v {maxwidth maxgraphpct diffopts} {
4971 set oldprefs($v) [set $v]
4973 toplevel $top
4974 wm title $top "Gitk preferences"
4975 label $top.ldisp -text "Commit list display options"
4976 grid $top.ldisp - -sticky w -pady 10
4977 label $top.spacer -text " "
4978 label $top.maxwidthl -text "Maximum graph width (lines)" \
4979 -font optionfont
4980 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4981 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4982 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4983 -font optionfont
4984 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4985 grid x $top.maxpctl $top.maxpct -sticky w
4986 label $top.ddisp -text "Diff display options"
4987 grid $top.ddisp - -sticky w -pady 10
4988 label $top.diffoptl -text "Options for diff program" \
4989 -font optionfont
4990 entry $top.diffopt -width 20 -textvariable diffopts
4991 grid x $top.diffoptl $top.diffopt -sticky w
4992 frame $top.buts
4993 button $top.buts.ok -text "OK" -command prefsok
4994 button $top.buts.can -text "Cancel" -command prefscan
4995 grid $top.buts.ok $top.buts.can
4996 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4997 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4998 grid $top.buts - - -pady 10 -sticky ew
5001 proc prefscan {} {
5002 global maxwidth maxgraphpct diffopts
5003 global oldprefs prefstop
5005 foreach v {maxwidth maxgraphpct diffopts} {
5006 set $v $oldprefs($v)
5008 catch {destroy $prefstop}
5009 unset prefstop
5012 proc prefsok {} {
5013 global maxwidth maxgraphpct
5014 global oldprefs prefstop
5016 catch {destroy $prefstop}
5017 unset prefstop
5018 if {$maxwidth != $oldprefs(maxwidth)
5019 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5020 redisplay
5024 proc formatdate {d} {
5025 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5028 # This list of encoding names and aliases is distilled from
5029 # http://www.iana.org/assignments/character-sets.
5030 # Not all of them are supported by Tcl.
5031 set encoding_aliases {
5032 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5033 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5034 { ISO-10646-UTF-1 csISO10646UTF1 }
5035 { ISO_646.basic:1983 ref csISO646basic1983 }
5036 { INVARIANT csINVARIANT }
5037 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5038 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5039 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5040 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5041 { NATS-DANO iso-ir-9-1 csNATSDANO }
5042 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5043 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5044 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5045 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5046 { ISO-2022-KR csISO2022KR }
5047 { EUC-KR csEUCKR }
5048 { ISO-2022-JP csISO2022JP }
5049 { ISO-2022-JP-2 csISO2022JP2 }
5050 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5051 csISO13JISC6220jp }
5052 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5053 { IT iso-ir-15 ISO646-IT csISO15Italian }
5054 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5055 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5056 { greek7-old iso-ir-18 csISO18Greek7Old }
5057 { latin-greek iso-ir-19 csISO19LatinGreek }
5058 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5059 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5060 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5061 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5062 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5063 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5064 { INIS iso-ir-49 csISO49INIS }
5065 { INIS-8 iso-ir-50 csISO50INIS8 }
5066 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5067 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5068 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5069 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5070 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5071 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5072 csISO60Norwegian1 }
5073 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5074 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5075 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5076 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5077 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5078 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5079 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5080 { greek7 iso-ir-88 csISO88Greek7 }
5081 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5082 { iso-ir-90 csISO90 }
5083 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5084 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5085 csISO92JISC62991984b }
5086 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5087 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5088 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5089 csISO95JIS62291984handadd }
5090 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5091 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5092 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5093 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5094 CP819 csISOLatin1 }
5095 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5096 { T.61-7bit iso-ir-102 csISO102T617bit }
5097 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5098 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5099 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5100 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5101 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5102 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5103 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5104 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5105 arabic csISOLatinArabic }
5106 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5107 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5108 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5109 greek greek8 csISOLatinGreek }
5110 { T.101-G2 iso-ir-128 csISO128T101G2 }
5111 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5112 csISOLatinHebrew }
5113 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5114 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5115 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5116 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5117 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5118 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5119 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5120 csISOLatinCyrillic }
5121 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5122 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5123 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5124 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5125 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5126 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5127 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5128 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5129 { ISO_10367-box iso-ir-155 csISO10367Box }
5130 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5131 { latin-lap lap iso-ir-158 csISO158Lap }
5132 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5133 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5134 { us-dk csUSDK }
5135 { dk-us csDKUS }
5136 { JIS_X0201 X0201 csHalfWidthKatakana }
5137 { KSC5636 ISO646-KR csKSC5636 }
5138 { ISO-10646-UCS-2 csUnicode }
5139 { ISO-10646-UCS-4 csUCS4 }
5140 { DEC-MCS dec csDECMCS }
5141 { hp-roman8 roman8 r8 csHPRoman8 }
5142 { macintosh mac csMacintosh }
5143 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5144 csIBM037 }
5145 { IBM038 EBCDIC-INT cp038 csIBM038 }
5146 { IBM273 CP273 csIBM273 }
5147 { IBM274 EBCDIC-BE CP274 csIBM274 }
5148 { IBM275 EBCDIC-BR cp275 csIBM275 }
5149 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5150 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5151 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5152 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5153 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5154 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5155 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5156 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5157 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5158 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5159 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5160 { IBM437 cp437 437 csPC8CodePage437 }
5161 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5162 { IBM775 cp775 csPC775Baltic }
5163 { IBM850 cp850 850 csPC850Multilingual }
5164 { IBM851 cp851 851 csIBM851 }
5165 { IBM852 cp852 852 csPCp852 }
5166 { IBM855 cp855 855 csIBM855 }
5167 { IBM857 cp857 857 csIBM857 }
5168 { IBM860 cp860 860 csIBM860 }
5169 { IBM861 cp861 861 cp-is csIBM861 }
5170 { IBM862 cp862 862 csPC862LatinHebrew }
5171 { IBM863 cp863 863 csIBM863 }
5172 { IBM864 cp864 csIBM864 }
5173 { IBM865 cp865 865 csIBM865 }
5174 { IBM866 cp866 866 csIBM866 }
5175 { IBM868 CP868 cp-ar csIBM868 }
5176 { IBM869 cp869 869 cp-gr csIBM869 }
5177 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5178 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5179 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5180 { IBM891 cp891 csIBM891 }
5181 { IBM903 cp903 csIBM903 }
5182 { IBM904 cp904 904 csIBBM904 }
5183 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5184 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5185 { IBM1026 CP1026 csIBM1026 }
5186 { EBCDIC-AT-DE csIBMEBCDICATDE }
5187 { EBCDIC-AT-DE-A csEBCDICATDEA }
5188 { EBCDIC-CA-FR csEBCDICCAFR }
5189 { EBCDIC-DK-NO csEBCDICDKNO }
5190 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5191 { EBCDIC-FI-SE csEBCDICFISE }
5192 { EBCDIC-FI-SE-A csEBCDICFISEA }
5193 { EBCDIC-FR csEBCDICFR }
5194 { EBCDIC-IT csEBCDICIT }
5195 { EBCDIC-PT csEBCDICPT }
5196 { EBCDIC-ES csEBCDICES }
5197 { EBCDIC-ES-A csEBCDICESA }
5198 { EBCDIC-ES-S csEBCDICESS }
5199 { EBCDIC-UK csEBCDICUK }
5200 { EBCDIC-US csEBCDICUS }
5201 { UNKNOWN-8BIT csUnknown8BiT }
5202 { MNEMONIC csMnemonic }
5203 { MNEM csMnem }
5204 { VISCII csVISCII }
5205 { VIQR csVIQR }
5206 { KOI8-R csKOI8R }
5207 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5208 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5209 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5210 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5211 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5212 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5213 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5214 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5215 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5216 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5217 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5218 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5219 { IBM1047 IBM-1047 }
5220 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5221 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5222 { UNICODE-1-1 csUnicode11 }
5223 { CESU-8 csCESU-8 }
5224 { BOCU-1 csBOCU-1 }
5225 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5226 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5227 l8 }
5228 { ISO-8859-15 ISO_8859-15 Latin-9 }
5229 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5230 { GBK CP936 MS936 windows-936 }
5231 { JIS_Encoding csJISEncoding }
5232 { Shift_JIS MS_Kanji csShiftJIS }
5233 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5234 EUC-JP }
5235 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5236 { ISO-10646-UCS-Basic csUnicodeASCII }
5237 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5238 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5239 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5240 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5241 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5242 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5243 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5244 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5245 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5246 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5247 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5248 { Ventura-US csVenturaUS }
5249 { Ventura-International csVenturaInternational }
5250 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5251 { PC8-Turkish csPC8Turkish }
5252 { IBM-Symbols csIBMSymbols }
5253 { IBM-Thai csIBMThai }
5254 { HP-Legal csHPLegal }
5255 { HP-Pi-font csHPPiFont }
5256 { HP-Math8 csHPMath8 }
5257 { Adobe-Symbol-Encoding csHPPSMath }
5258 { HP-DeskTop csHPDesktop }
5259 { Ventura-Math csVenturaMath }
5260 { Microsoft-Publishing csMicrosoftPublishing }
5261 { Windows-31J csWindows31J }
5262 { GB2312 csGB2312 }
5263 { Big5 csBig5 }
5266 proc tcl_encoding {enc} {
5267 global encoding_aliases
5268 set names [encoding names]
5269 set lcnames [string tolower $names]
5270 set enc [string tolower $enc]
5271 set i [lsearch -exact $lcnames $enc]
5272 if {$i < 0} {
5273 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5274 if {[regsub {^iso[-_]} $enc iso encx]} {
5275 set i [lsearch -exact $lcnames $encx]
5278 if {$i < 0} {
5279 foreach l $encoding_aliases {
5280 set ll [string tolower $l]
5281 if {[lsearch -exact $ll $enc] < 0} continue
5282 # look through the aliases for one that tcl knows about
5283 foreach e $ll {
5284 set i [lsearch -exact $lcnames $e]
5285 if {$i < 0} {
5286 if {[regsub {^iso[-_]} $e iso ex]} {
5287 set i [lsearch -exact $lcnames $ex]
5290 if {$i >= 0} break
5292 break
5295 if {$i >= 0} {
5296 return [lindex $names $i]
5298 return {}
5301 # defaults...
5302 set datemode 0
5303 set diffopts "-U 5 -p"
5304 set wrcomcmd "git diff-tree --stdin -p --pretty"
5306 set gitencoding {}
5307 catch {
5308 set gitencoding [exec git repo-config --get i18n.commitencoding]
5310 if {$gitencoding == ""} {
5311 set gitencoding "utf-8"
5313 set tclencoding [tcl_encoding $gitencoding]
5314 if {$tclencoding == {}} {
5315 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5318 set mainfont {Helvetica 9}
5319 set textfont {Courier 9}
5320 set uifont {Helvetica 9 bold}
5321 set findmergefiles 0
5322 set maxgraphpct 50
5323 set maxwidth 16
5324 set revlistorder 0
5325 set fastdate 0
5326 set uparrowlen 7
5327 set downarrowlen 7
5328 set mingaplen 30
5329 set cmitmode "patch"
5330 set wrapcomment "none"
5332 set colors {green red blue magenta darkgrey brown orange}
5334 catch {source ~/.gitk}
5336 font create optionfont -family sans-serif -size -12
5338 set revtreeargs {}
5339 foreach arg $argv {
5340 switch -regexp -- $arg {
5341 "^$" { }
5342 "^-d" { set datemode 1 }
5343 default {
5344 lappend revtreeargs $arg
5349 # check that we can find a .git directory somewhere...
5350 set gitdir [gitdir]
5351 if {![file isdirectory $gitdir]} {
5352 show_error {} . "Cannot find the git directory \"$gitdir\"."
5353 exit 1
5356 set cmdline_files {}
5357 set i [lsearch -exact $revtreeargs "--"]
5358 if {$i >= 0} {
5359 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5360 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5361 } elseif {$revtreeargs ne {}} {
5362 if {[catch {
5363 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5364 set cmdline_files [split $f "\n"]
5365 set n [llength $cmdline_files]
5366 set revtreeargs [lrange $revtreeargs 0 end-$n]
5367 } err]} {
5368 # unfortunately we get both stdout and stderr in $err,
5369 # so look for "fatal:".
5370 set i [string first "fatal:" $err]
5371 if {$i > 0} {
5372 set err [string range $err [expr {$i + 6}] end]
5374 show_error {} . "Bad arguments to gitk:\n$err"
5375 exit 1
5379 set history {}
5380 set historyindex 0
5381 set fh_serial 0
5382 set nhl_names {}
5383 set highlight_paths {}
5384 set searchdirn -forwards
5385 set boldrows {}
5386 set boldnamerows {}
5388 set optim_delay 16
5390 set nextviewnum 1
5391 set curview 0
5392 set selectedview 0
5393 set selectedhlview None
5394 set viewfiles(0) {}
5395 set viewperm(0) 0
5396 set viewargs(0) {}
5398 set cmdlineok 0
5399 set stopped 0
5400 set stuffsaved 0
5401 set patchnum 0
5402 setcoords
5403 makewindow
5404 readrefs
5406 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5407 # create a view for the files/dirs specified on the command line
5408 set curview 1
5409 set selectedview 1
5410 set nextviewnum 2
5411 set viewname(1) "Command line"
5412 set viewfiles(1) $cmdline_files
5413 set viewargs(1) $revtreeargs
5414 set viewperm(1) 0
5415 addviewmenu 1
5416 .bar.view entryconf 2 -state normal
5417 .bar.view entryconf 3 -state normal
5420 if {[info exists permviews]} {
5421 foreach v $permviews {
5422 set n $nextviewnum
5423 incr nextviewnum
5424 set viewname($n) [lindex $v 0]
5425 set viewfiles($n) [lindex $v 1]
5426 set viewargs($n) [lindex $v 2]
5427 set viewperm($n) 1
5428 addviewmenu $n
5431 getcommits