Git.pm: Add support for subdirectories inside of working copies
[git/platforms.git] / gitk
blobba4644f450215682d7465ada26878d626f72fa00
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 discardallcommits
242 readrefs
243 showview $n
246 proc parsecommit {id contents listed} {
247 global commitinfo cdate
249 set inhdr 1
250 set comment {}
251 set headline {}
252 set auname {}
253 set audate {}
254 set comname {}
255 set comdate {}
256 set hdrend [string first "\n\n" $contents]
257 if {$hdrend < 0} {
258 # should never happen...
259 set hdrend [string length $contents]
261 set header [string range $contents 0 [expr {$hdrend - 1}]]
262 set comment [string range $contents [expr {$hdrend + 2}] end]
263 foreach line [split $header "\n"] {
264 set tag [lindex $line 0]
265 if {$tag == "author"} {
266 set audate [lindex $line end-1]
267 set auname [lrange $line 1 end-2]
268 } elseif {$tag == "committer"} {
269 set comdate [lindex $line end-1]
270 set comname [lrange $line 1 end-2]
273 set headline {}
274 # take the first line of the comment as the headline
275 set i [string first "\n" $comment]
276 if {$i >= 0} {
277 set headline [string trim [string range $comment 0 $i]]
278 } else {
279 set headline $comment
281 if {!$listed} {
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
284 set newcomment {}
285 foreach line [split $comment "\n"] {
286 append newcomment " "
287 append newcomment $line
288 append newcomment "\n"
290 set comment $newcomment
292 if {$comdate != {}} {
293 set cdate($id) $comdate
295 set commitinfo($id) [list $headline $auname $audate \
296 $comname $comdate $comment]
299 proc getcommit {id} {
300 global commitdata commitinfo
302 if {[info exists commitdata($id)]} {
303 parsecommit $id $commitdata($id) 1
304 } else {
305 readcommit $id
306 if {![info exists commitinfo($id)]} {
307 set commitinfo($id) {"No commit information available"}
310 return 1
313 proc readrefs {} {
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs
317 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
318 catch {unset $v}
320 set refd [open [list | git ls-remote [gitdir]] r]
321 while {0 <= [set n [gets $refd line]]} {
322 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
323 match id path]} {
324 continue
326 if {[regexp {^remotes/.*/HEAD$} $path match]} {
327 continue
329 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
330 set type others
331 set name $path
333 if {[regexp {^remotes/} $path match]} {
334 set type heads
336 if {$type == "tags"} {
337 set tagids($name) $id
338 lappend idtags($id) $name
339 set obj {}
340 set type {}
341 set tag {}
342 catch {
343 set commit [exec git rev-parse "$id^0"]
344 if {"$commit" != "$id"} {
345 set tagids($name) $commit
346 lappend idtags($commit) $name
349 catch {
350 set tagcontents($name) [exec git cat-file tag "$id"]
352 } elseif { $type == "heads" } {
353 set headids($name) $id
354 lappend idheads($id) $name
355 } else {
356 set otherrefids($name) $id
357 lappend idotherrefs($id) $name
360 close $refd
363 proc show_error {w top msg} {
364 message $w.m -text $msg -justify center -aspect 400
365 pack $w.m -side top -fill x -padx 20 -pady 20
366 button $w.ok -text OK -command "destroy $top"
367 pack $w.ok -side bottom -fill x
368 bind $top <Visibility> "grab $top; focus $top"
369 bind $top <Key-Return> "destroy $top"
370 tkwait window $top
373 proc error_popup msg {
374 set w .error
375 toplevel $w
376 wm transient $w .
377 show_error $w $w $msg
380 proc makewindow {} {
381 global canv canv2 canv3 linespc charspc ctext cflist
382 global textfont mainfont uifont
383 global findtype findtypemenu findloc findstring fstring geometry
384 global entries sha1entry sha1string sha1but
385 global maincursor textcursor curtextcursor
386 global rowctxmenu mergemax wrapcomment
387 global highlight_files gdttype
388 global searchstring sstring
390 menu .bar
391 .bar add cascade -label "File" -menu .bar.file
392 .bar configure -font $uifont
393 menu .bar.file
394 .bar.file add command -label "Update" -command updatecommits
395 .bar.file add command -label "Reread references" -command rereadrefs
396 .bar.file add command -label "Quit" -command doquit
397 .bar.file configure -font $uifont
398 menu .bar.edit
399 .bar add cascade -label "Edit" -menu .bar.edit
400 .bar.edit add command -label "Preferences" -command doprefs
401 .bar.edit configure -font $uifont
403 menu .bar.view -font $uifont
404 .bar add cascade -label "View" -menu .bar.view
405 .bar.view add command -label "New view..." -command {newview 0}
406 .bar.view add command -label "Edit view..." -command editview \
407 -state disabled
408 .bar.view add command -label "Delete view" -command delview -state disabled
409 .bar.view add separator
410 .bar.view add radiobutton -label "All files" -command {showview 0} \
411 -variable selectedview -value 0
413 menu .bar.help
414 .bar add cascade -label "Help" -menu .bar.help
415 .bar.help add command -label "About gitk" -command about
416 .bar.help add command -label "Key bindings" -command keys
417 .bar.help configure -font $uifont
418 . configure -menu .bar
420 if {![info exists geometry(canv1)]} {
421 set geometry(canv1) [expr {45 * $charspc}]
422 set geometry(canv2) [expr {30 * $charspc}]
423 set geometry(canv3) [expr {15 * $charspc}]
424 set geometry(canvh) [expr {25 * $linespc + 4}]
425 set geometry(ctextw) 80
426 set geometry(ctexth) 30
427 set geometry(cflistw) 30
429 panedwindow .ctop -orient vertical
430 if {[info exists geometry(width)]} {
431 .ctop conf -width $geometry(width) -height $geometry(height)
432 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
433 set geometry(ctexth) [expr {($texth - 8) /
434 [font metrics $textfont -linespace]}]
436 frame .ctop.top
437 frame .ctop.top.bar
438 frame .ctop.top.lbar
439 pack .ctop.top.lbar -side bottom -fill x
440 pack .ctop.top.bar -side bottom -fill x
441 set cscroll .ctop.top.csb
442 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
443 pack $cscroll -side right -fill y
444 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
445 pack .ctop.top.clist -side top -fill both -expand 1
446 .ctop add .ctop.top
447 set canv .ctop.top.clist.canv
448 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
449 -bg white -bd 0 \
450 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
451 .ctop.top.clist add $canv
452 set canv2 .ctop.top.clist.canv2
453 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
454 -bg white -bd 0 -yscrollincr $linespc
455 .ctop.top.clist add $canv2
456 set canv3 .ctop.top.clist.canv3
457 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
458 -bg white -bd 0 -yscrollincr $linespc
459 .ctop.top.clist add $canv3
460 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
462 set sha1entry .ctop.top.bar.sha1
463 set entries $sha1entry
464 set sha1but .ctop.top.bar.sha1label
465 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
466 -command gotocommit -width 8 -font $uifont
467 $sha1but conf -disabledforeground [$sha1but cget -foreground]
468 pack .ctop.top.bar.sha1label -side left
469 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
470 trace add variable sha1string write sha1change
471 pack $sha1entry -side left -pady 2
473 image create bitmap bm-left -data {
474 #define left_width 16
475 #define left_height 16
476 static unsigned char left_bits[] = {
477 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
478 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
479 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
481 image create bitmap bm-right -data {
482 #define right_width 16
483 #define right_height 16
484 static unsigned char right_bits[] = {
485 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
486 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
487 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
489 button .ctop.top.bar.leftbut -image bm-left -command goback \
490 -state disabled -width 26
491 pack .ctop.top.bar.leftbut -side left -fill y
492 button .ctop.top.bar.rightbut -image bm-right -command goforw \
493 -state disabled -width 26
494 pack .ctop.top.bar.rightbut -side left -fill y
496 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
497 pack .ctop.top.bar.findbut -side left
498 set findstring {}
499 set fstring .ctop.top.bar.findstring
500 lappend entries $fstring
501 entry $fstring -width 30 -font $textfont -textvariable findstring
502 trace add variable findstring write find_change
503 pack $fstring -side left -expand 1 -fill x
504 set findtype Exact
505 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
506 findtype Exact IgnCase Regexp]
507 trace add variable findtype write find_change
508 .ctop.top.bar.findtype configure -font $uifont
509 .ctop.top.bar.findtype.menu configure -font $uifont
510 set findloc "All fields"
511 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
512 Comments Author Committer
513 trace add variable findloc write find_change
514 .ctop.top.bar.findloc configure -font $uifont
515 .ctop.top.bar.findloc.menu configure -font $uifont
516 pack .ctop.top.bar.findloc -side right
517 pack .ctop.top.bar.findtype -side right
519 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
520 -font $uifont
521 pack .ctop.top.lbar.flabel -side left -fill y
522 set gdttype "touching paths:"
523 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
524 "adding/removing string:"]
525 trace add variable gdttype write hfiles_change
526 $gm conf -font $uifont
527 .ctop.top.lbar.gdttype conf -font $uifont
528 pack .ctop.top.lbar.gdttype -side left -fill y
529 entry .ctop.top.lbar.fent -width 25 -font $textfont \
530 -textvariable highlight_files
531 trace add variable highlight_files write hfiles_change
532 lappend entries .ctop.top.lbar.fent
533 pack .ctop.top.lbar.fent -side left -fill x -expand 1
534 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
535 pack .ctop.top.lbar.vlabel -side left -fill y
536 global viewhlmenu selectedhlview
537 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
538 $viewhlmenu entryconf 0 -command delvhighlight
539 $viewhlmenu conf -font $uifont
540 .ctop.top.lbar.vhl conf -font $uifont
541 pack .ctop.top.lbar.vhl -side left -fill y
542 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
543 pack .ctop.top.lbar.rlabel -side left -fill y
544 global highlight_related
545 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
546 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
547 $m conf -font $uifont
548 .ctop.top.lbar.relm conf -font $uifont
549 trace add variable highlight_related write vrel_change
550 pack .ctop.top.lbar.relm -side left -fill y
552 panedwindow .ctop.cdet -orient horizontal
553 .ctop add .ctop.cdet
554 frame .ctop.cdet.left
555 frame .ctop.cdet.left.bot
556 pack .ctop.cdet.left.bot -side bottom -fill x
557 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
558 -font $uifont
559 pack .ctop.cdet.left.bot.search -side left -padx 5
560 set sstring .ctop.cdet.left.bot.sstring
561 entry $sstring -width 20 -font $textfont -textvariable searchstring
562 lappend entries $sstring
563 trace add variable searchstring write incrsearch
564 pack $sstring -side left -expand 1 -fill x
565 set ctext .ctop.cdet.left.ctext
566 text $ctext -bg white -state disabled -font $textfont \
567 -width $geometry(ctextw) -height $geometry(ctexth) \
568 -yscrollcommand scrolltext -wrap none
569 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
570 pack .ctop.cdet.left.sb -side right -fill y
571 pack $ctext -side left -fill both -expand 1
572 .ctop.cdet add .ctop.cdet.left
574 $ctext tag conf comment -wrap $wrapcomment
575 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
576 $ctext tag conf hunksep -fore blue
577 $ctext tag conf d0 -fore red
578 $ctext tag conf d1 -fore "#00a000"
579 $ctext tag conf m0 -fore red
580 $ctext tag conf m1 -fore blue
581 $ctext tag conf m2 -fore green
582 $ctext tag conf m3 -fore purple
583 $ctext tag conf m4 -fore brown
584 $ctext tag conf m5 -fore "#009090"
585 $ctext tag conf m6 -fore magenta
586 $ctext tag conf m7 -fore "#808000"
587 $ctext tag conf m8 -fore "#009000"
588 $ctext tag conf m9 -fore "#ff0080"
589 $ctext tag conf m10 -fore cyan
590 $ctext tag conf m11 -fore "#b07070"
591 $ctext tag conf m12 -fore "#70b0f0"
592 $ctext tag conf m13 -fore "#70f0b0"
593 $ctext tag conf m14 -fore "#f0b070"
594 $ctext tag conf m15 -fore "#ff70b0"
595 $ctext tag conf mmax -fore darkgrey
596 set mergemax 16
597 $ctext tag conf mresult -font [concat $textfont bold]
598 $ctext tag conf msep -font [concat $textfont bold]
599 $ctext tag conf found -back yellow
601 frame .ctop.cdet.right
602 frame .ctop.cdet.right.mode
603 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
604 -command reselectline -variable cmitmode -value "patch"
605 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
606 -command reselectline -variable cmitmode -value "tree"
607 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
608 pack .ctop.cdet.right.mode -side top -fill x
609 set cflist .ctop.cdet.right.cfiles
610 set indent [font measure $mainfont "nn"]
611 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
612 -tabs [list $indent [expr {2 * $indent}]] \
613 -yscrollcommand ".ctop.cdet.right.sb set" \
614 -cursor [. cget -cursor] \
615 -spacing1 1 -spacing3 1
616 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
617 pack .ctop.cdet.right.sb -side right -fill y
618 pack $cflist -side left -fill both -expand 1
619 $cflist tag configure highlight \
620 -background [$cflist cget -selectbackground]
621 $cflist tag configure bold -font [concat $mainfont bold]
622 .ctop.cdet add .ctop.cdet.right
623 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
625 pack .ctop -side top -fill both -expand 1
627 bindall <1> {selcanvline %W %x %y}
628 #bindall <B1-Motion> {selcanvline %W %x %y}
629 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
630 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
631 bindall <2> "canvscan mark %W %x %y"
632 bindall <B2-Motion> "canvscan dragto %W %x %y"
633 bindkey <Home> selfirstline
634 bindkey <End> sellastline
635 bind . <Key-Up> "selnextline -1"
636 bind . <Key-Down> "selnextline 1"
637 bind . <Shift-Key-Up> "next_highlight -1"
638 bind . <Shift-Key-Down> "next_highlight 1"
639 bindkey <Key-Right> "goforw"
640 bindkey <Key-Left> "goback"
641 bind . <Key-Prior> "selnextpage -1"
642 bind . <Key-Next> "selnextpage 1"
643 bind . <Control-Home> "allcanvs yview moveto 0.0"
644 bind . <Control-End> "allcanvs yview moveto 1.0"
645 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
646 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
647 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
648 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
649 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
650 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
651 bindkey <Key-space> "$ctext yview scroll 1 pages"
652 bindkey p "selnextline -1"
653 bindkey n "selnextline 1"
654 bindkey z "goback"
655 bindkey x "goforw"
656 bindkey i "selnextline -1"
657 bindkey k "selnextline 1"
658 bindkey j "goback"
659 bindkey l "goforw"
660 bindkey b "$ctext yview scroll -1 pages"
661 bindkey d "$ctext yview scroll 18 units"
662 bindkey u "$ctext yview scroll -18 units"
663 bindkey / {findnext 1}
664 bindkey <Key-Return> {findnext 0}
665 bindkey ? findprev
666 bindkey f nextfile
667 bind . <Control-q> doquit
668 bind . <Control-f> dofind
669 bind . <Control-g> {findnext 0}
670 bind . <Control-r> dosearchback
671 bind . <Control-s> dosearch
672 bind . <Control-equal> {incrfont 1}
673 bind . <Control-KP_Add> {incrfont 1}
674 bind . <Control-minus> {incrfont -1}
675 bind . <Control-KP_Subtract> {incrfont -1}
676 bind . <Destroy> {savestuff %W}
677 bind . <Button-1> "click %W"
678 bind $fstring <Key-Return> dofind
679 bind $sha1entry <Key-Return> gotocommit
680 bind $sha1entry <<PasteSelection>> clearsha1
681 bind $cflist <1> {sel_flist %W %x %y; break}
682 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
683 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
685 set maincursor [. cget -cursor]
686 set textcursor [$ctext cget -cursor]
687 set curtextcursor $textcursor
689 set rowctxmenu .rowctxmenu
690 menu $rowctxmenu -tearoff 0
691 $rowctxmenu add command -label "Diff this -> selected" \
692 -command {diffvssel 0}
693 $rowctxmenu add command -label "Diff selected -> this" \
694 -command {diffvssel 1}
695 $rowctxmenu add command -label "Make patch" -command mkpatch
696 $rowctxmenu add command -label "Create tag" -command mktag
697 $rowctxmenu add command -label "Write commit to file" -command writecommit
700 # mouse-2 makes all windows scan vertically, but only the one
701 # the cursor is in scans horizontally
702 proc canvscan {op w x y} {
703 global canv canv2 canv3
704 foreach c [list $canv $canv2 $canv3] {
705 if {$c == $w} {
706 $c scan $op $x $y
707 } else {
708 $c scan $op 0 $y
713 proc scrollcanv {cscroll f0 f1} {
714 $cscroll set $f0 $f1
715 drawfrac $f0 $f1
716 flushhighlights
719 # when we make a key binding for the toplevel, make sure
720 # it doesn't get triggered when that key is pressed in the
721 # find string entry widget.
722 proc bindkey {ev script} {
723 global entries
724 bind . $ev $script
725 set escript [bind Entry $ev]
726 if {$escript == {}} {
727 set escript [bind Entry <Key>]
729 foreach e $entries {
730 bind $e $ev "$escript; break"
734 # set the focus back to the toplevel for any click outside
735 # the entry widgets
736 proc click {w} {
737 global entries
738 foreach e $entries {
739 if {$w == $e} return
741 focus .
744 proc savestuff {w} {
745 global canv canv2 canv3 ctext cflist mainfont textfont uifont
746 global stuffsaved findmergefiles maxgraphpct
747 global maxwidth showneartags
748 global viewname viewfiles viewargs viewperm nextviewnum
749 global cmitmode wrapcomment
751 if {$stuffsaved} return
752 if {![winfo viewable .]} return
753 catch {
754 set f [open "~/.gitk-new" w]
755 puts $f [list set mainfont $mainfont]
756 puts $f [list set textfont $textfont]
757 puts $f [list set uifont $uifont]
758 puts $f [list set findmergefiles $findmergefiles]
759 puts $f [list set maxgraphpct $maxgraphpct]
760 puts $f [list set maxwidth $maxwidth]
761 puts $f [list set cmitmode $cmitmode]
762 puts $f [list set wrapcomment $wrapcomment]
763 puts $f [list set showneartags $showneartags]
764 puts $f "set geometry(width) [winfo width .ctop]"
765 puts $f "set geometry(height) [winfo height .ctop]"
766 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
767 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
768 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
769 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
770 set wid [expr {([winfo width $ctext] - 8) \
771 / [font measure $textfont "0"]}]
772 puts $f "set geometry(ctextw) $wid"
773 set wid [expr {([winfo width $cflist] - 11) \
774 / [font measure [$cflist cget -font] "0"]}]
775 puts $f "set geometry(cflistw) $wid"
776 puts -nonewline $f "set permviews {"
777 for {set v 0} {$v < $nextviewnum} {incr v} {
778 if {$viewperm($v)} {
779 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
782 puts $f "}"
783 close $f
784 file rename -force "~/.gitk-new" "~/.gitk"
786 set stuffsaved 1
789 proc resizeclistpanes {win w} {
790 global oldwidth
791 if {[info exists oldwidth($win)]} {
792 set s0 [$win sash coord 0]
793 set s1 [$win sash coord 1]
794 if {$w < 60} {
795 set sash0 [expr {int($w/2 - 2)}]
796 set sash1 [expr {int($w*5/6 - 2)}]
797 } else {
798 set factor [expr {1.0 * $w / $oldwidth($win)}]
799 set sash0 [expr {int($factor * [lindex $s0 0])}]
800 set sash1 [expr {int($factor * [lindex $s1 0])}]
801 if {$sash0 < 30} {
802 set sash0 30
804 if {$sash1 < $sash0 + 20} {
805 set sash1 [expr {$sash0 + 20}]
807 if {$sash1 > $w - 10} {
808 set sash1 [expr {$w - 10}]
809 if {$sash0 > $sash1 - 20} {
810 set sash0 [expr {$sash1 - 20}]
814 $win sash place 0 $sash0 [lindex $s0 1]
815 $win sash place 1 $sash1 [lindex $s1 1]
817 set oldwidth($win) $w
820 proc resizecdetpanes {win w} {
821 global oldwidth
822 if {[info exists oldwidth($win)]} {
823 set s0 [$win sash coord 0]
824 if {$w < 60} {
825 set sash0 [expr {int($w*3/4 - 2)}]
826 } else {
827 set factor [expr {1.0 * $w / $oldwidth($win)}]
828 set sash0 [expr {int($factor * [lindex $s0 0])}]
829 if {$sash0 < 45} {
830 set sash0 45
832 if {$sash0 > $w - 15} {
833 set sash0 [expr {$w - 15}]
836 $win sash place 0 $sash0 [lindex $s0 1]
838 set oldwidth($win) $w
841 proc allcanvs args {
842 global canv canv2 canv3
843 eval $canv $args
844 eval $canv2 $args
845 eval $canv3 $args
848 proc bindall {event action} {
849 global canv canv2 canv3
850 bind $canv $event $action
851 bind $canv2 $event $action
852 bind $canv3 $event $action
855 proc about {} {
856 set w .about
857 if {[winfo exists $w]} {
858 raise $w
859 return
861 toplevel $w
862 wm title $w "About gitk"
863 message $w.m -text {
864 Gitk - a commit viewer for git
866 Copyright © 2005-2006 Paul Mackerras
868 Use and redistribute under the terms of the GNU General Public License} \
869 -justify center -aspect 400
870 pack $w.m -side top -fill x -padx 20 -pady 20
871 button $w.ok -text Close -command "destroy $w"
872 pack $w.ok -side bottom
875 proc keys {} {
876 set w .keys
877 if {[winfo exists $w]} {
878 raise $w
879 return
881 toplevel $w
882 wm title $w "Gitk key bindings"
883 message $w.m -text {
884 Gitk key bindings:
886 <Ctrl-Q> Quit
887 <Home> Move to first commit
888 <End> Move to last commit
889 <Up>, p, i Move up one commit
890 <Down>, n, k Move down one commit
891 <Left>, z, j Go back in history list
892 <Right>, x, l Go forward in history list
893 <PageUp> Move up one page in commit list
894 <PageDown> Move down one page in commit list
895 <Ctrl-Home> Scroll to top of commit list
896 <Ctrl-End> Scroll to bottom of commit list
897 <Ctrl-Up> Scroll commit list up one line
898 <Ctrl-Down> Scroll commit list down one line
899 <Ctrl-PageUp> Scroll commit list up one page
900 <Ctrl-PageDown> Scroll commit list down one page
901 <Shift-Up> Move to previous highlighted line
902 <Shift-Down> Move to next highlighted line
903 <Delete>, b Scroll diff view up one page
904 <Backspace> Scroll diff view up one page
905 <Space> Scroll diff view down one page
906 u Scroll diff view up 18 lines
907 d Scroll diff view down 18 lines
908 <Ctrl-F> Find
909 <Ctrl-G> Move to next find hit
910 <Return> Move to next find hit
911 / Move to next find hit, or redo find
912 ? Move to previous find hit
913 f Scroll diff view to next file
914 <Ctrl-S> Search for next hit in diff view
915 <Ctrl-R> Search for previous hit in diff view
916 <Ctrl-KP+> Increase font size
917 <Ctrl-plus> Increase font size
918 <Ctrl-KP-> Decrease font size
919 <Ctrl-minus> Decrease font size
921 -justify left -bg white -border 2 -relief sunken
922 pack $w.m -side top -fill both
923 button $w.ok -text Close -command "destroy $w"
924 pack $w.ok -side bottom
927 # Procedures for manipulating the file list window at the
928 # bottom right of the overall window.
930 proc treeview {w l openlevs} {
931 global treecontents treediropen treeheight treeparent treeindex
933 set ix 0
934 set treeindex() 0
935 set lev 0
936 set prefix {}
937 set prefixend -1
938 set prefendstack {}
939 set htstack {}
940 set ht 0
941 set treecontents() {}
942 $w conf -state normal
943 foreach f $l {
944 while {[string range $f 0 $prefixend] ne $prefix} {
945 if {$lev <= $openlevs} {
946 $w mark set e:$treeindex($prefix) "end -1c"
947 $w mark gravity e:$treeindex($prefix) left
949 set treeheight($prefix) $ht
950 incr ht [lindex $htstack end]
951 set htstack [lreplace $htstack end end]
952 set prefixend [lindex $prefendstack end]
953 set prefendstack [lreplace $prefendstack end end]
954 set prefix [string range $prefix 0 $prefixend]
955 incr lev -1
957 set tail [string range $f [expr {$prefixend+1}] end]
958 while {[set slash [string first "/" $tail]] >= 0} {
959 lappend htstack $ht
960 set ht 0
961 lappend prefendstack $prefixend
962 incr prefixend [expr {$slash + 1}]
963 set d [string range $tail 0 $slash]
964 lappend treecontents($prefix) $d
965 set oldprefix $prefix
966 append prefix $d
967 set treecontents($prefix) {}
968 set treeindex($prefix) [incr ix]
969 set treeparent($prefix) $oldprefix
970 set tail [string range $tail [expr {$slash+1}] end]
971 if {$lev <= $openlevs} {
972 set ht 1
973 set treediropen($prefix) [expr {$lev < $openlevs}]
974 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
975 $w mark set d:$ix "end -1c"
976 $w mark gravity d:$ix left
977 set str "\n"
978 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
979 $w insert end $str
980 $w image create end -align center -image $bm -padx 1 \
981 -name a:$ix
982 $w insert end $d [highlight_tag $prefix]
983 $w mark set s:$ix "end -1c"
984 $w mark gravity s:$ix left
986 incr lev
988 if {$tail ne {}} {
989 if {$lev <= $openlevs} {
990 incr ht
991 set str "\n"
992 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
993 $w insert end $str
994 $w insert end $tail [highlight_tag $f]
996 lappend treecontents($prefix) $tail
999 while {$htstack ne {}} {
1000 set treeheight($prefix) $ht
1001 incr ht [lindex $htstack end]
1002 set htstack [lreplace $htstack end end]
1004 $w conf -state disabled
1007 proc linetoelt {l} {
1008 global treeheight treecontents
1010 set y 2
1011 set prefix {}
1012 while {1} {
1013 foreach e $treecontents($prefix) {
1014 if {$y == $l} {
1015 return "$prefix$e"
1017 set n 1
1018 if {[string index $e end] eq "/"} {
1019 set n $treeheight($prefix$e)
1020 if {$y + $n > $l} {
1021 append prefix $e
1022 incr y
1023 break
1026 incr y $n
1031 proc highlight_tree {y prefix} {
1032 global treeheight treecontents cflist
1034 foreach e $treecontents($prefix) {
1035 set path $prefix$e
1036 if {[highlight_tag $path] ne {}} {
1037 $cflist tag add bold $y.0 "$y.0 lineend"
1039 incr y
1040 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1041 set y [highlight_tree $y $path]
1044 return $y
1047 proc treeclosedir {w dir} {
1048 global treediropen treeheight treeparent treeindex
1050 set ix $treeindex($dir)
1051 $w conf -state normal
1052 $w delete s:$ix e:$ix
1053 set treediropen($dir) 0
1054 $w image configure a:$ix -image tri-rt
1055 $w conf -state disabled
1056 set n [expr {1 - $treeheight($dir)}]
1057 while {$dir ne {}} {
1058 incr treeheight($dir) $n
1059 set dir $treeparent($dir)
1063 proc treeopendir {w dir} {
1064 global treediropen treeheight treeparent treecontents treeindex
1066 set ix $treeindex($dir)
1067 $w conf -state normal
1068 $w image configure a:$ix -image tri-dn
1069 $w mark set e:$ix s:$ix
1070 $w mark gravity e:$ix right
1071 set lev 0
1072 set str "\n"
1073 set n [llength $treecontents($dir)]
1074 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1075 incr lev
1076 append str "\t"
1077 incr treeheight($x) $n
1079 foreach e $treecontents($dir) {
1080 set de $dir$e
1081 if {[string index $e end] eq "/"} {
1082 set iy $treeindex($de)
1083 $w mark set d:$iy e:$ix
1084 $w mark gravity d:$iy left
1085 $w insert e:$ix $str
1086 set treediropen($de) 0
1087 $w image create e:$ix -align center -image tri-rt -padx 1 \
1088 -name a:$iy
1089 $w insert e:$ix $e [highlight_tag $de]
1090 $w mark set s:$iy e:$ix
1091 $w mark gravity s:$iy left
1092 set treeheight($de) 1
1093 } else {
1094 $w insert e:$ix $str
1095 $w insert e:$ix $e [highlight_tag $de]
1098 $w mark gravity e:$ix left
1099 $w conf -state disabled
1100 set treediropen($dir) 1
1101 set top [lindex [split [$w index @0,0] .] 0]
1102 set ht [$w cget -height]
1103 set l [lindex [split [$w index s:$ix] .] 0]
1104 if {$l < $top} {
1105 $w yview $l.0
1106 } elseif {$l + $n + 1 > $top + $ht} {
1107 set top [expr {$l + $n + 2 - $ht}]
1108 if {$l < $top} {
1109 set top $l
1111 $w yview $top.0
1115 proc treeclick {w x y} {
1116 global treediropen cmitmode ctext cflist cflist_top
1118 if {$cmitmode ne "tree"} return
1119 if {![info exists cflist_top]} return
1120 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1121 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1122 $cflist tag add highlight $l.0 "$l.0 lineend"
1123 set cflist_top $l
1124 if {$l == 1} {
1125 $ctext yview 1.0
1126 return
1128 set e [linetoelt $l]
1129 if {[string index $e end] ne "/"} {
1130 showfile $e
1131 } elseif {$treediropen($e)} {
1132 treeclosedir $w $e
1133 } else {
1134 treeopendir $w $e
1138 proc setfilelist {id} {
1139 global treefilelist cflist
1141 treeview $cflist $treefilelist($id) 0
1144 image create bitmap tri-rt -background black -foreground blue -data {
1145 #define tri-rt_width 13
1146 #define tri-rt_height 13
1147 static unsigned char tri-rt_bits[] = {
1148 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1149 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1150 0x00, 0x00};
1151 } -maskdata {
1152 #define tri-rt-mask_width 13
1153 #define tri-rt-mask_height 13
1154 static unsigned char tri-rt-mask_bits[] = {
1155 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1156 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1157 0x08, 0x00};
1159 image create bitmap tri-dn -background black -foreground blue -data {
1160 #define tri-dn_width 13
1161 #define tri-dn_height 13
1162 static unsigned char tri-dn_bits[] = {
1163 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1164 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1165 0x00, 0x00};
1166 } -maskdata {
1167 #define tri-dn-mask_width 13
1168 #define tri-dn-mask_height 13
1169 static unsigned char tri-dn-mask_bits[] = {
1170 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1171 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1172 0x00, 0x00};
1175 proc init_flist {first} {
1176 global cflist cflist_top selectedline difffilestart
1178 $cflist conf -state normal
1179 $cflist delete 0.0 end
1180 if {$first ne {}} {
1181 $cflist insert end $first
1182 set cflist_top 1
1183 $cflist tag add highlight 1.0 "1.0 lineend"
1184 } else {
1185 catch {unset cflist_top}
1187 $cflist conf -state disabled
1188 set difffilestart {}
1191 proc highlight_tag {f} {
1192 global highlight_paths
1194 foreach p $highlight_paths {
1195 if {[string match $p $f]} {
1196 return "bold"
1199 return {}
1202 proc highlight_filelist {} {
1203 global cmitmode cflist
1205 $cflist conf -state normal
1206 if {$cmitmode ne "tree"} {
1207 set end [lindex [split [$cflist index end] .] 0]
1208 for {set l 2} {$l < $end} {incr l} {
1209 set line [$cflist get $l.0 "$l.0 lineend"]
1210 if {[highlight_tag $line] ne {}} {
1211 $cflist tag add bold $l.0 "$l.0 lineend"
1214 } else {
1215 highlight_tree 2 {}
1217 $cflist conf -state disabled
1220 proc unhighlight_filelist {} {
1221 global cflist
1223 $cflist conf -state normal
1224 $cflist tag remove bold 1.0 end
1225 $cflist conf -state disabled
1228 proc add_flist {fl} {
1229 global cflist
1231 $cflist conf -state normal
1232 foreach f $fl {
1233 $cflist insert end "\n"
1234 $cflist insert end $f [highlight_tag $f]
1236 $cflist conf -state disabled
1239 proc sel_flist {w x y} {
1240 global ctext difffilestart cflist cflist_top cmitmode
1242 if {$cmitmode eq "tree"} return
1243 if {![info exists cflist_top]} return
1244 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1245 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1246 $cflist tag add highlight $l.0 "$l.0 lineend"
1247 set cflist_top $l
1248 if {$l == 1} {
1249 $ctext yview 1.0
1250 } else {
1251 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1255 # Functions for adding and removing shell-type quoting
1257 proc shellquote {str} {
1258 if {![string match "*\['\"\\ \t]*" $str]} {
1259 return $str
1261 if {![string match "*\['\"\\]*" $str]} {
1262 return "\"$str\""
1264 if {![string match "*'*" $str]} {
1265 return "'$str'"
1267 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1270 proc shellarglist {l} {
1271 set str {}
1272 foreach a $l {
1273 if {$str ne {}} {
1274 append str " "
1276 append str [shellquote $a]
1278 return $str
1281 proc shelldequote {str} {
1282 set ret {}
1283 set used -1
1284 while {1} {
1285 incr used
1286 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1287 append ret [string range $str $used end]
1288 set used [string length $str]
1289 break
1291 set first [lindex $first 0]
1292 set ch [string index $str $first]
1293 if {$first > $used} {
1294 append ret [string range $str $used [expr {$first - 1}]]
1295 set used $first
1297 if {$ch eq " " || $ch eq "\t"} break
1298 incr used
1299 if {$ch eq "'"} {
1300 set first [string first "'" $str $used]
1301 if {$first < 0} {
1302 error "unmatched single-quote"
1304 append ret [string range $str $used [expr {$first - 1}]]
1305 set used $first
1306 continue
1308 if {$ch eq "\\"} {
1309 if {$used >= [string length $str]} {
1310 error "trailing backslash"
1312 append ret [string index $str $used]
1313 continue
1315 # here ch == "\""
1316 while {1} {
1317 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1318 error "unmatched double-quote"
1320 set first [lindex $first 0]
1321 set ch [string index $str $first]
1322 if {$first > $used} {
1323 append ret [string range $str $used [expr {$first - 1}]]
1324 set used $first
1326 if {$ch eq "\""} break
1327 incr used
1328 append ret [string index $str $used]
1329 incr used
1332 return [list $used $ret]
1335 proc shellsplit {str} {
1336 set l {}
1337 while {1} {
1338 set str [string trimleft $str]
1339 if {$str eq {}} break
1340 set dq [shelldequote $str]
1341 set n [lindex $dq 0]
1342 set word [lindex $dq 1]
1343 set str [string range $str $n end]
1344 lappend l $word
1346 return $l
1349 # Code to implement multiple views
1351 proc newview {ishighlight} {
1352 global nextviewnum newviewname newviewperm uifont newishighlight
1353 global newviewargs revtreeargs
1355 set newishighlight $ishighlight
1356 set top .gitkview
1357 if {[winfo exists $top]} {
1358 raise $top
1359 return
1361 set newviewname($nextviewnum) "View $nextviewnum"
1362 set newviewperm($nextviewnum) 0
1363 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1364 vieweditor $top $nextviewnum "Gitk view definition"
1367 proc editview {} {
1368 global curview
1369 global viewname viewperm newviewname newviewperm
1370 global viewargs newviewargs
1372 set top .gitkvedit-$curview
1373 if {[winfo exists $top]} {
1374 raise $top
1375 return
1377 set newviewname($curview) $viewname($curview)
1378 set newviewperm($curview) $viewperm($curview)
1379 set newviewargs($curview) [shellarglist $viewargs($curview)]
1380 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1383 proc vieweditor {top n title} {
1384 global newviewname newviewperm viewfiles
1385 global uifont
1387 toplevel $top
1388 wm title $top $title
1389 label $top.nl -text "Name" -font $uifont
1390 entry $top.name -width 20 -textvariable newviewname($n)
1391 grid $top.nl $top.name -sticky w -pady 5
1392 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1393 grid $top.perm - -pady 5 -sticky w
1394 message $top.al -aspect 1000 -font $uifont \
1395 -text "Commits to include (arguments to git rev-list):"
1396 grid $top.al - -sticky w -pady 5
1397 entry $top.args -width 50 -textvariable newviewargs($n) \
1398 -background white
1399 grid $top.args - -sticky ew -padx 5
1400 message $top.l -aspect 1000 -font $uifont \
1401 -text "Enter files and directories to include, one per line:"
1402 grid $top.l - -sticky w
1403 text $top.t -width 40 -height 10 -background white
1404 if {[info exists viewfiles($n)]} {
1405 foreach f $viewfiles($n) {
1406 $top.t insert end $f
1407 $top.t insert end "\n"
1409 $top.t delete {end - 1c} end
1410 $top.t mark set insert 0.0
1412 grid $top.t - -sticky ew -padx 5
1413 frame $top.buts
1414 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1415 button $top.buts.can -text "Cancel" -command [list destroy $top]
1416 grid $top.buts.ok $top.buts.can
1417 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1418 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1419 grid $top.buts - -pady 10 -sticky ew
1420 focus $top.t
1423 proc doviewmenu {m first cmd op argv} {
1424 set nmenu [$m index end]
1425 for {set i $first} {$i <= $nmenu} {incr i} {
1426 if {[$m entrycget $i -command] eq $cmd} {
1427 eval $m $op $i $argv
1428 break
1433 proc allviewmenus {n op args} {
1434 global viewhlmenu
1436 doviewmenu .bar.view 7 [list showview $n] $op $args
1437 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1440 proc newviewok {top n} {
1441 global nextviewnum newviewperm newviewname newishighlight
1442 global viewname viewfiles viewperm selectedview curview
1443 global viewargs newviewargs viewhlmenu
1445 if {[catch {
1446 set newargs [shellsplit $newviewargs($n)]
1447 } err]} {
1448 error_popup "Error in commit selection arguments: $err"
1449 wm raise $top
1450 focus $top
1451 return
1453 set files {}
1454 foreach f [split [$top.t get 0.0 end] "\n"] {
1455 set ft [string trim $f]
1456 if {$ft ne {}} {
1457 lappend files $ft
1460 if {![info exists viewfiles($n)]} {
1461 # creating a new view
1462 incr nextviewnum
1463 set viewname($n) $newviewname($n)
1464 set viewperm($n) $newviewperm($n)
1465 set viewfiles($n) $files
1466 set viewargs($n) $newargs
1467 addviewmenu $n
1468 if {!$newishighlight} {
1469 after idle showview $n
1470 } else {
1471 after idle addvhighlight $n
1473 } else {
1474 # editing an existing view
1475 set viewperm($n) $newviewperm($n)
1476 if {$newviewname($n) ne $viewname($n)} {
1477 set viewname($n) $newviewname($n)
1478 doviewmenu .bar.view 7 [list showview $n] \
1479 entryconf [list -label $viewname($n)]
1480 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1481 entryconf [list -label $viewname($n) -value $viewname($n)]
1483 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1484 set viewfiles($n) $files
1485 set viewargs($n) $newargs
1486 if {$curview == $n} {
1487 after idle updatecommits
1491 catch {destroy $top}
1494 proc delview {} {
1495 global curview viewdata viewperm hlview selectedhlview
1497 if {$curview == 0} return
1498 if {[info exists hlview] && $hlview == $curview} {
1499 set selectedhlview None
1500 unset hlview
1502 allviewmenus $curview delete
1503 set viewdata($curview) {}
1504 set viewperm($curview) 0
1505 showview 0
1508 proc addviewmenu {n} {
1509 global viewname viewhlmenu
1511 .bar.view add radiobutton -label $viewname($n) \
1512 -command [list showview $n] -variable selectedview -value $n
1513 $viewhlmenu add radiobutton -label $viewname($n) \
1514 -command [list addvhighlight $n] -variable selectedhlview
1517 proc flatten {var} {
1518 global $var
1520 set ret {}
1521 foreach i [array names $var] {
1522 lappend ret $i [set $var\($i\)]
1524 return $ret
1527 proc unflatten {var l} {
1528 global $var
1530 catch {unset $var}
1531 foreach {i v} $l {
1532 set $var\($i\) $v
1536 proc showview {n} {
1537 global curview viewdata viewfiles
1538 global displayorder parentlist childlist rowidlist rowoffsets
1539 global colormap rowtextx commitrow nextcolor canvxmax
1540 global numcommits rowrangelist commitlisted idrowranges
1541 global selectedline currentid canv canvy0
1542 global matchinglines treediffs
1543 global pending_select phase
1544 global commitidx rowlaidout rowoptim linesegends
1545 global commfd nextupdate
1546 global selectedview
1547 global vparentlist vchildlist vdisporder vcmitlisted
1548 global hlview selectedhlview
1550 if {$n == $curview} return
1551 set selid {}
1552 if {[info exists selectedline]} {
1553 set selid $currentid
1554 set y [yc $selectedline]
1555 set ymax [lindex [$canv cget -scrollregion] 3]
1556 set span [$canv yview]
1557 set ytop [expr {[lindex $span 0] * $ymax}]
1558 set ybot [expr {[lindex $span 1] * $ymax}]
1559 if {$ytop < $y && $y < $ybot} {
1560 set yscreen [expr {$y - $ytop}]
1561 } else {
1562 set yscreen [expr {($ybot - $ytop) / 2}]
1565 unselectline
1566 normalline
1567 stopfindproc
1568 if {$curview >= 0} {
1569 set vparentlist($curview) $parentlist
1570 set vchildlist($curview) $childlist
1571 set vdisporder($curview) $displayorder
1572 set vcmitlisted($curview) $commitlisted
1573 if {$phase ne {}} {
1574 set viewdata($curview) \
1575 [list $phase $rowidlist $rowoffsets $rowrangelist \
1576 [flatten idrowranges] [flatten idinlist] \
1577 $rowlaidout $rowoptim $numcommits $linesegends]
1578 } elseif {![info exists viewdata($curview)]
1579 || [lindex $viewdata($curview) 0] ne {}} {
1580 set viewdata($curview) \
1581 [list {} $rowidlist $rowoffsets $rowrangelist]
1584 catch {unset matchinglines}
1585 catch {unset treediffs}
1586 clear_display
1587 if {[info exists hlview] && $hlview == $n} {
1588 unset hlview
1589 set selectedhlview None
1592 set curview $n
1593 set selectedview $n
1594 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1595 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1597 if {![info exists viewdata($n)]} {
1598 set pending_select $selid
1599 getcommits
1600 return
1603 set v $viewdata($n)
1604 set phase [lindex $v 0]
1605 set displayorder $vdisporder($n)
1606 set parentlist $vparentlist($n)
1607 set childlist $vchildlist($n)
1608 set commitlisted $vcmitlisted($n)
1609 set rowidlist [lindex $v 1]
1610 set rowoffsets [lindex $v 2]
1611 set rowrangelist [lindex $v 3]
1612 if {$phase eq {}} {
1613 set numcommits [llength $displayorder]
1614 catch {unset idrowranges}
1615 } else {
1616 unflatten idrowranges [lindex $v 4]
1617 unflatten idinlist [lindex $v 5]
1618 set rowlaidout [lindex $v 6]
1619 set rowoptim [lindex $v 7]
1620 set numcommits [lindex $v 8]
1621 set linesegends [lindex $v 9]
1624 catch {unset colormap}
1625 catch {unset rowtextx}
1626 set nextcolor 0
1627 set canvxmax [$canv cget -width]
1628 set curview $n
1629 set row 0
1630 setcanvscroll
1631 set yf 0
1632 set row 0
1633 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1634 set row $commitrow($n,$selid)
1635 # try to get the selected row in the same position on the screen
1636 set ymax [lindex [$canv cget -scrollregion] 3]
1637 set ytop [expr {[yc $row] - $yscreen}]
1638 if {$ytop < 0} {
1639 set ytop 0
1641 set yf [expr {$ytop * 1.0 / $ymax}]
1643 allcanvs yview moveto $yf
1644 drawvisible
1645 selectline $row 0
1646 if {$phase ne {}} {
1647 if {$phase eq "getcommits"} {
1648 show_status "Reading commits..."
1650 if {[info exists commfd($n)]} {
1651 layoutmore
1652 } else {
1653 finishcommits
1655 } elseif {$numcommits == 0} {
1656 show_status "No commits selected"
1660 # Stuff relating to the highlighting facility
1662 proc ishighlighted {row} {
1663 global vhighlights fhighlights nhighlights rhighlights
1665 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1666 return $nhighlights($row)
1668 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1669 return $vhighlights($row)
1671 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1672 return $fhighlights($row)
1674 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1675 return $rhighlights($row)
1677 return 0
1680 proc bolden {row font} {
1681 global canv linehtag selectedline boldrows
1683 lappend boldrows $row
1684 $canv itemconf $linehtag($row) -font $font
1685 if {[info exists selectedline] && $row == $selectedline} {
1686 $canv delete secsel
1687 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1688 -outline {{}} -tags secsel \
1689 -fill [$canv cget -selectbackground]]
1690 $canv lower $t
1694 proc bolden_name {row font} {
1695 global canv2 linentag selectedline boldnamerows
1697 lappend boldnamerows $row
1698 $canv2 itemconf $linentag($row) -font $font
1699 if {[info exists selectedline] && $row == $selectedline} {
1700 $canv2 delete secsel
1701 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1702 -outline {{}} -tags secsel \
1703 -fill [$canv2 cget -selectbackground]]
1704 $canv2 lower $t
1708 proc unbolden {} {
1709 global mainfont boldrows
1711 set stillbold {}
1712 foreach row $boldrows {
1713 if {![ishighlighted $row]} {
1714 bolden $row $mainfont
1715 } else {
1716 lappend stillbold $row
1719 set boldrows $stillbold
1722 proc addvhighlight {n} {
1723 global hlview curview viewdata vhl_done vhighlights commitidx
1725 if {[info exists hlview]} {
1726 delvhighlight
1728 set hlview $n
1729 if {$n != $curview && ![info exists viewdata($n)]} {
1730 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1731 set vparentlist($n) {}
1732 set vchildlist($n) {}
1733 set vdisporder($n) {}
1734 set vcmitlisted($n) {}
1735 start_rev_list $n
1737 set vhl_done $commitidx($hlview)
1738 if {$vhl_done > 0} {
1739 drawvisible
1743 proc delvhighlight {} {
1744 global hlview vhighlights
1746 if {![info exists hlview]} return
1747 unset hlview
1748 catch {unset vhighlights}
1749 unbolden
1752 proc vhighlightmore {} {
1753 global hlview vhl_done commitidx vhighlights
1754 global displayorder vdisporder curview mainfont
1756 set font [concat $mainfont bold]
1757 set max $commitidx($hlview)
1758 if {$hlview == $curview} {
1759 set disp $displayorder
1760 } else {
1761 set disp $vdisporder($hlview)
1763 set vr [visiblerows]
1764 set r0 [lindex $vr 0]
1765 set r1 [lindex $vr 1]
1766 for {set i $vhl_done} {$i < $max} {incr i} {
1767 set id [lindex $disp $i]
1768 if {[info exists commitrow($curview,$id)]} {
1769 set row $commitrow($curview,$id)
1770 if {$r0 <= $row && $row <= $r1} {
1771 if {![highlighted $row]} {
1772 bolden $row $font
1774 set vhighlights($row) 1
1778 set vhl_done $max
1781 proc askvhighlight {row id} {
1782 global hlview vhighlights commitrow iddrawn mainfont
1784 if {[info exists commitrow($hlview,$id)]} {
1785 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1786 bolden $row [concat $mainfont bold]
1788 set vhighlights($row) 1
1789 } else {
1790 set vhighlights($row) 0
1794 proc hfiles_change {name ix op} {
1795 global highlight_files filehighlight fhighlights fh_serial
1796 global mainfont highlight_paths
1798 if {[info exists filehighlight]} {
1799 # delete previous highlights
1800 catch {close $filehighlight}
1801 unset filehighlight
1802 catch {unset fhighlights}
1803 unbolden
1804 unhighlight_filelist
1806 set highlight_paths {}
1807 after cancel do_file_hl $fh_serial
1808 incr fh_serial
1809 if {$highlight_files ne {}} {
1810 after 300 do_file_hl $fh_serial
1814 proc makepatterns {l} {
1815 set ret {}
1816 foreach e $l {
1817 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1818 if {[string index $ee end] eq "/"} {
1819 lappend ret "$ee*"
1820 } else {
1821 lappend ret $ee
1822 lappend ret "$ee/*"
1825 return $ret
1828 proc do_file_hl {serial} {
1829 global highlight_files filehighlight highlight_paths gdttype fhl_list
1831 if {$gdttype eq "touching paths:"} {
1832 if {[catch {set paths [shellsplit $highlight_files]}]} return
1833 set highlight_paths [makepatterns $paths]
1834 highlight_filelist
1835 set gdtargs [concat -- $paths]
1836 } else {
1837 set gdtargs [list "-S$highlight_files"]
1839 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1840 set filehighlight [open $cmd r+]
1841 fconfigure $filehighlight -blocking 0
1842 fileevent $filehighlight readable readfhighlight
1843 set fhl_list {}
1844 drawvisible
1845 flushhighlights
1848 proc flushhighlights {} {
1849 global filehighlight fhl_list
1851 if {[info exists filehighlight]} {
1852 lappend fhl_list {}
1853 puts $filehighlight ""
1854 flush $filehighlight
1858 proc askfilehighlight {row id} {
1859 global filehighlight fhighlights fhl_list
1861 lappend fhl_list $id
1862 set fhighlights($row) -1
1863 puts $filehighlight $id
1866 proc readfhighlight {} {
1867 global filehighlight fhighlights commitrow curview mainfont iddrawn
1868 global fhl_list
1870 while {[gets $filehighlight line] >= 0} {
1871 set line [string trim $line]
1872 set i [lsearch -exact $fhl_list $line]
1873 if {$i < 0} continue
1874 for {set j 0} {$j < $i} {incr j} {
1875 set id [lindex $fhl_list $j]
1876 if {[info exists commitrow($curview,$id)]} {
1877 set fhighlights($commitrow($curview,$id)) 0
1880 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1881 if {$line eq {}} continue
1882 if {![info exists commitrow($curview,$line)]} continue
1883 set row $commitrow($curview,$line)
1884 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1885 bolden $row [concat $mainfont bold]
1887 set fhighlights($row) 1
1889 if {[eof $filehighlight]} {
1890 # strange...
1891 puts "oops, git-diff-tree died"
1892 catch {close $filehighlight}
1893 unset filehighlight
1895 next_hlcont
1898 proc find_change {name ix op} {
1899 global nhighlights mainfont boldnamerows
1900 global findstring findpattern findtype
1902 # delete previous highlights, if any
1903 foreach row $boldnamerows {
1904 bolden_name $row $mainfont
1906 set boldnamerows {}
1907 catch {unset nhighlights}
1908 unbolden
1909 if {$findtype ne "Regexp"} {
1910 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1911 $findstring]
1912 set findpattern "*$e*"
1914 drawvisible
1917 proc askfindhighlight {row id} {
1918 global nhighlights commitinfo iddrawn mainfont
1919 global findstring findtype findloc findpattern
1921 if {![info exists commitinfo($id)]} {
1922 getcommit $id
1924 set info $commitinfo($id)
1925 set isbold 0
1926 set fldtypes {Headline Author Date Committer CDate Comments}
1927 foreach f $info ty $fldtypes {
1928 if {$findloc ne "All fields" && $findloc ne $ty} {
1929 continue
1931 if {$findtype eq "Regexp"} {
1932 set doesmatch [regexp $findstring $f]
1933 } elseif {$findtype eq "IgnCase"} {
1934 set doesmatch [string match -nocase $findpattern $f]
1935 } else {
1936 set doesmatch [string match $findpattern $f]
1938 if {$doesmatch} {
1939 if {$ty eq "Author"} {
1940 set isbold 2
1941 } else {
1942 set isbold 1
1946 if {[info exists iddrawn($id)]} {
1947 if {$isbold && ![ishighlighted $row]} {
1948 bolden $row [concat $mainfont bold]
1950 if {$isbold >= 2} {
1951 bolden_name $row [concat $mainfont bold]
1954 set nhighlights($row) $isbold
1957 proc vrel_change {name ix op} {
1958 global highlight_related
1960 rhighlight_none
1961 if {$highlight_related ne "None"} {
1962 after idle drawvisible
1966 # prepare for testing whether commits are descendents or ancestors of a
1967 proc rhighlight_sel {a} {
1968 global descendent desc_todo ancestor anc_todo
1969 global highlight_related rhighlights
1971 catch {unset descendent}
1972 set desc_todo [list $a]
1973 catch {unset ancestor}
1974 set anc_todo [list $a]
1975 if {$highlight_related ne "None"} {
1976 rhighlight_none
1977 after idle drawvisible
1981 proc rhighlight_none {} {
1982 global rhighlights
1984 catch {unset rhighlights}
1985 unbolden
1988 proc is_descendent {a} {
1989 global curview children commitrow descendent desc_todo
1991 set v $curview
1992 set la $commitrow($v,$a)
1993 set todo $desc_todo
1994 set leftover {}
1995 set done 0
1996 for {set i 0} {$i < [llength $todo]} {incr i} {
1997 set do [lindex $todo $i]
1998 if {$commitrow($v,$do) < $la} {
1999 lappend leftover $do
2000 continue
2002 foreach nk $children($v,$do) {
2003 if {![info exists descendent($nk)]} {
2004 set descendent($nk) 1
2005 lappend todo $nk
2006 if {$nk eq $a} {
2007 set done 1
2011 if {$done} {
2012 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2013 return
2016 set descendent($a) 0
2017 set desc_todo $leftover
2020 proc is_ancestor {a} {
2021 global curview parentlist commitrow ancestor anc_todo
2023 set v $curview
2024 set la $commitrow($v,$a)
2025 set todo $anc_todo
2026 set leftover {}
2027 set done 0
2028 for {set i 0} {$i < [llength $todo]} {incr i} {
2029 set do [lindex $todo $i]
2030 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2031 lappend leftover $do
2032 continue
2034 foreach np [lindex $parentlist $commitrow($v,$do)] {
2035 if {![info exists ancestor($np)]} {
2036 set ancestor($np) 1
2037 lappend todo $np
2038 if {$np eq $a} {
2039 set done 1
2043 if {$done} {
2044 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2045 return
2048 set ancestor($a) 0
2049 set anc_todo $leftover
2052 proc askrelhighlight {row id} {
2053 global descendent highlight_related iddrawn mainfont rhighlights
2054 global selectedline ancestor
2056 if {![info exists selectedline]} return
2057 set isbold 0
2058 if {$highlight_related eq "Descendent" ||
2059 $highlight_related eq "Not descendent"} {
2060 if {![info exists descendent($id)]} {
2061 is_descendent $id
2063 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2064 set isbold 1
2066 } elseif {$highlight_related eq "Ancestor" ||
2067 $highlight_related eq "Not ancestor"} {
2068 if {![info exists ancestor($id)]} {
2069 is_ancestor $id
2071 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2072 set isbold 1
2075 if {[info exists iddrawn($id)]} {
2076 if {$isbold && ![ishighlighted $row]} {
2077 bolden $row [concat $mainfont bold]
2080 set rhighlights($row) $isbold
2083 proc next_hlcont {} {
2084 global fhl_row fhl_dirn displayorder numcommits
2085 global vhighlights fhighlights nhighlights rhighlights
2086 global hlview filehighlight findstring highlight_related
2088 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2089 set row $fhl_row
2090 while {1} {
2091 if {$row < 0 || $row >= $numcommits} {
2092 bell
2093 set fhl_dirn 0
2094 return
2096 set id [lindex $displayorder $row]
2097 if {[info exists hlview]} {
2098 if {![info exists vhighlights($row)]} {
2099 askvhighlight $row $id
2101 if {$vhighlights($row) > 0} break
2103 if {$findstring ne {}} {
2104 if {![info exists nhighlights($row)]} {
2105 askfindhighlight $row $id
2107 if {$nhighlights($row) > 0} break
2109 if {$highlight_related ne "None"} {
2110 if {![info exists rhighlights($row)]} {
2111 askrelhighlight $row $id
2113 if {$rhighlights($row) > 0} break
2115 if {[info exists filehighlight]} {
2116 if {![info exists fhighlights($row)]} {
2117 # ask for a few more while we're at it...
2118 set r $row
2119 for {set n 0} {$n < 100} {incr n} {
2120 if {![info exists fhighlights($r)]} {
2121 askfilehighlight $r [lindex $displayorder $r]
2123 incr r $fhl_dirn
2124 if {$r < 0 || $r >= $numcommits} break
2126 flushhighlights
2128 if {$fhighlights($row) < 0} {
2129 set fhl_row $row
2130 return
2132 if {$fhighlights($row) > 0} break
2134 incr row $fhl_dirn
2136 set fhl_dirn 0
2137 selectline $row 1
2140 proc next_highlight {dirn} {
2141 global selectedline fhl_row fhl_dirn
2142 global hlview filehighlight findstring highlight_related
2144 if {![info exists selectedline]} return
2145 if {!([info exists hlview] || $findstring ne {} ||
2146 $highlight_related ne "None" || [info exists filehighlight])} return
2147 set fhl_row [expr {$selectedline + $dirn}]
2148 set fhl_dirn $dirn
2149 next_hlcont
2152 proc cancel_next_highlight {} {
2153 global fhl_dirn
2155 set fhl_dirn 0
2158 # Graph layout functions
2160 proc shortids {ids} {
2161 set res {}
2162 foreach id $ids {
2163 if {[llength $id] > 1} {
2164 lappend res [shortids $id]
2165 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2166 lappend res [string range $id 0 7]
2167 } else {
2168 lappend res $id
2171 return $res
2174 proc incrange {l x o} {
2175 set n [llength $l]
2176 while {$x < $n} {
2177 set e [lindex $l $x]
2178 if {$e ne {}} {
2179 lset l $x [expr {$e + $o}]
2181 incr x
2183 return $l
2186 proc ntimes {n o} {
2187 set ret {}
2188 for {} {$n > 0} {incr n -1} {
2189 lappend ret $o
2191 return $ret
2194 proc usedinrange {id l1 l2} {
2195 global children commitrow childlist curview
2197 if {[info exists commitrow($curview,$id)]} {
2198 set r $commitrow($curview,$id)
2199 if {$l1 <= $r && $r <= $l2} {
2200 return [expr {$r - $l1 + 1}]
2202 set kids [lindex $childlist $r]
2203 } else {
2204 set kids $children($curview,$id)
2206 foreach c $kids {
2207 set r $commitrow($curview,$c)
2208 if {$l1 <= $r && $r <= $l2} {
2209 return [expr {$r - $l1 + 1}]
2212 return 0
2215 proc sanity {row {full 0}} {
2216 global rowidlist rowoffsets
2218 set col -1
2219 set ids [lindex $rowidlist $row]
2220 foreach id $ids {
2221 incr col
2222 if {$id eq {}} continue
2223 if {$col < [llength $ids] - 1 &&
2224 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2225 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2227 set o [lindex $rowoffsets $row $col]
2228 set y $row
2229 set x $col
2230 while {$o ne {}} {
2231 incr y -1
2232 incr x $o
2233 if {[lindex $rowidlist $y $x] != $id} {
2234 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2235 puts " id=[shortids $id] check started at row $row"
2236 for {set i $row} {$i >= $y} {incr i -1} {
2237 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2239 break
2241 if {!$full} break
2242 set o [lindex $rowoffsets $y $x]
2247 proc makeuparrow {oid x y z} {
2248 global rowidlist rowoffsets uparrowlen idrowranges
2250 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2251 incr y -1
2252 incr x $z
2253 set off0 [lindex $rowoffsets $y]
2254 for {set x0 $x} {1} {incr x0} {
2255 if {$x0 >= [llength $off0]} {
2256 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2257 break
2259 set z [lindex $off0 $x0]
2260 if {$z ne {}} {
2261 incr x0 $z
2262 break
2265 set z [expr {$x0 - $x}]
2266 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2267 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2269 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2270 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2271 lappend idrowranges($oid) $y
2274 proc initlayout {} {
2275 global rowidlist rowoffsets displayorder commitlisted
2276 global rowlaidout rowoptim
2277 global idinlist rowchk rowrangelist idrowranges
2278 global numcommits canvxmax canv
2279 global nextcolor
2280 global parentlist childlist children
2281 global colormap rowtextx
2282 global linesegends
2284 set numcommits 0
2285 set displayorder {}
2286 set commitlisted {}
2287 set parentlist {}
2288 set childlist {}
2289 set rowrangelist {}
2290 set nextcolor 0
2291 set rowidlist {{}}
2292 set rowoffsets {{}}
2293 catch {unset idinlist}
2294 catch {unset rowchk}
2295 set rowlaidout 0
2296 set rowoptim 0
2297 set canvxmax [$canv cget -width]
2298 catch {unset colormap}
2299 catch {unset rowtextx}
2300 catch {unset idrowranges}
2301 set linesegends {}
2304 proc setcanvscroll {} {
2305 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2307 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2308 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2309 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2310 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2313 proc visiblerows {} {
2314 global canv numcommits linespc
2316 set ymax [lindex [$canv cget -scrollregion] 3]
2317 if {$ymax eq {} || $ymax == 0} return
2318 set f [$canv yview]
2319 set y0 [expr {int([lindex $f 0] * $ymax)}]
2320 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2321 if {$r0 < 0} {
2322 set r0 0
2324 set y1 [expr {int([lindex $f 1] * $ymax)}]
2325 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2326 if {$r1 >= $numcommits} {
2327 set r1 [expr {$numcommits - 1}]
2329 return [list $r0 $r1]
2332 proc layoutmore {} {
2333 global rowlaidout rowoptim commitidx numcommits optim_delay
2334 global uparrowlen curview
2336 set row $rowlaidout
2337 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2338 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2339 if {$orow > $rowoptim} {
2340 optimize_rows $rowoptim 0 $orow
2341 set rowoptim $orow
2343 set canshow [expr {$rowoptim - $optim_delay}]
2344 if {$canshow > $numcommits} {
2345 showstuff $canshow
2349 proc showstuff {canshow} {
2350 global numcommits commitrow pending_select selectedline
2351 global linesegends idrowranges idrangedrawn curview
2353 if {$numcommits == 0} {
2354 global phase
2355 set phase "incrdraw"
2356 allcanvs delete all
2358 set row $numcommits
2359 set numcommits $canshow
2360 setcanvscroll
2361 set rows [visiblerows]
2362 set r0 [lindex $rows 0]
2363 set r1 [lindex $rows 1]
2364 set selrow -1
2365 for {set r $row} {$r < $canshow} {incr r} {
2366 foreach id [lindex $linesegends [expr {$r+1}]] {
2367 set i -1
2368 foreach {s e} [rowranges $id] {
2369 incr i
2370 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2371 && ![info exists idrangedrawn($id,$i)]} {
2372 drawlineseg $id $i
2373 set idrangedrawn($id,$i) 1
2378 if {$canshow > $r1} {
2379 set canshow $r1
2381 while {$row < $canshow} {
2382 drawcmitrow $row
2383 incr row
2385 if {[info exists pending_select] &&
2386 [info exists commitrow($curview,$pending_select)] &&
2387 $commitrow($curview,$pending_select) < $numcommits} {
2388 selectline $commitrow($curview,$pending_select) 1
2390 if {![info exists selectedline] && ![info exists pending_select]} {
2391 selectline 0 1
2395 proc layoutrows {row endrow last} {
2396 global rowidlist rowoffsets displayorder
2397 global uparrowlen downarrowlen maxwidth mingaplen
2398 global childlist parentlist
2399 global idrowranges linesegends
2400 global commitidx curview
2401 global idinlist rowchk rowrangelist
2403 set idlist [lindex $rowidlist $row]
2404 set offs [lindex $rowoffsets $row]
2405 while {$row < $endrow} {
2406 set id [lindex $displayorder $row]
2407 set oldolds {}
2408 set newolds {}
2409 foreach p [lindex $parentlist $row] {
2410 if {![info exists idinlist($p)]} {
2411 lappend newolds $p
2412 } elseif {!$idinlist($p)} {
2413 lappend oldolds $p
2416 set lse {}
2417 set nev [expr {[llength $idlist] + [llength $newolds]
2418 + [llength $oldolds] - $maxwidth + 1}]
2419 if {$nev > 0} {
2420 if {!$last &&
2421 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2422 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2423 set i [lindex $idlist $x]
2424 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2425 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2426 [expr {$row + $uparrowlen + $mingaplen}]]
2427 if {$r == 0} {
2428 set idlist [lreplace $idlist $x $x]
2429 set offs [lreplace $offs $x $x]
2430 set offs [incrange $offs $x 1]
2431 set idinlist($i) 0
2432 set rm1 [expr {$row - 1}]
2433 lappend lse $i
2434 lappend idrowranges($i) $rm1
2435 if {[incr nev -1] <= 0} break
2436 continue
2438 set rowchk($id) [expr {$row + $r}]
2441 lset rowidlist $row $idlist
2442 lset rowoffsets $row $offs
2444 lappend linesegends $lse
2445 set col [lsearch -exact $idlist $id]
2446 if {$col < 0} {
2447 set col [llength $idlist]
2448 lappend idlist $id
2449 lset rowidlist $row $idlist
2450 set z {}
2451 if {[lindex $childlist $row] ne {}} {
2452 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2453 unset idinlist($id)
2455 lappend offs $z
2456 lset rowoffsets $row $offs
2457 if {$z ne {}} {
2458 makeuparrow $id $col $row $z
2460 } else {
2461 unset idinlist($id)
2463 set ranges {}
2464 if {[info exists idrowranges($id)]} {
2465 set ranges $idrowranges($id)
2466 lappend ranges $row
2467 unset idrowranges($id)
2469 lappend rowrangelist $ranges
2470 incr row
2471 set offs [ntimes [llength $idlist] 0]
2472 set l [llength $newolds]
2473 set idlist [eval lreplace \$idlist $col $col $newolds]
2474 set o 0
2475 if {$l != 1} {
2476 set offs [lrange $offs 0 [expr {$col - 1}]]
2477 foreach x $newolds {
2478 lappend offs {}
2479 incr o -1
2481 incr o
2482 set tmp [expr {[llength $idlist] - [llength $offs]}]
2483 if {$tmp > 0} {
2484 set offs [concat $offs [ntimes $tmp $o]]
2486 } else {
2487 lset offs $col {}
2489 foreach i $newolds {
2490 set idinlist($i) 1
2491 set idrowranges($i) $row
2493 incr col $l
2494 foreach oid $oldolds {
2495 set idinlist($oid) 1
2496 set idlist [linsert $idlist $col $oid]
2497 set offs [linsert $offs $col $o]
2498 makeuparrow $oid $col $row $o
2499 incr col
2501 lappend rowidlist $idlist
2502 lappend rowoffsets $offs
2504 return $row
2507 proc addextraid {id row} {
2508 global displayorder commitrow commitinfo
2509 global commitidx commitlisted
2510 global parentlist childlist children curview
2512 incr commitidx($curview)
2513 lappend displayorder $id
2514 lappend commitlisted 0
2515 lappend parentlist {}
2516 set commitrow($curview,$id) $row
2517 readcommit $id
2518 if {![info exists commitinfo($id)]} {
2519 set commitinfo($id) {"No commit information available"}
2521 if {![info exists children($curview,$id)]} {
2522 set children($curview,$id) {}
2524 lappend childlist $children($curview,$id)
2527 proc layouttail {} {
2528 global rowidlist rowoffsets idinlist commitidx curview
2529 global idrowranges rowrangelist
2531 set row $commitidx($curview)
2532 set idlist [lindex $rowidlist $row]
2533 while {$idlist ne {}} {
2534 set col [expr {[llength $idlist] - 1}]
2535 set id [lindex $idlist $col]
2536 addextraid $id $row
2537 unset idinlist($id)
2538 lappend idrowranges($id) $row
2539 lappend rowrangelist $idrowranges($id)
2540 unset idrowranges($id)
2541 incr row
2542 set offs [ntimes $col 0]
2543 set idlist [lreplace $idlist $col $col]
2544 lappend rowidlist $idlist
2545 lappend rowoffsets $offs
2548 foreach id [array names idinlist] {
2549 addextraid $id $row
2550 lset rowidlist $row [list $id]
2551 lset rowoffsets $row 0
2552 makeuparrow $id 0 $row 0
2553 lappend idrowranges($id) $row
2554 lappend rowrangelist $idrowranges($id)
2555 unset idrowranges($id)
2556 incr row
2557 lappend rowidlist {}
2558 lappend rowoffsets {}
2562 proc insert_pad {row col npad} {
2563 global rowidlist rowoffsets
2565 set pad [ntimes $npad {}]
2566 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2567 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2568 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2571 proc optimize_rows {row col endrow} {
2572 global rowidlist rowoffsets idrowranges displayorder
2574 for {} {$row < $endrow} {incr row} {
2575 set idlist [lindex $rowidlist $row]
2576 set offs [lindex $rowoffsets $row]
2577 set haspad 0
2578 for {} {$col < [llength $offs]} {incr col} {
2579 if {[lindex $idlist $col] eq {}} {
2580 set haspad 1
2581 continue
2583 set z [lindex $offs $col]
2584 if {$z eq {}} continue
2585 set isarrow 0
2586 set x0 [expr {$col + $z}]
2587 set y0 [expr {$row - 1}]
2588 set z0 [lindex $rowoffsets $y0 $x0]
2589 if {$z0 eq {}} {
2590 set id [lindex $idlist $col]
2591 set ranges [rowranges $id]
2592 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2593 set isarrow 1
2596 if {$z < -1 || ($z < 0 && $isarrow)} {
2597 set npad [expr {-1 - $z + $isarrow}]
2598 set offs [incrange $offs $col $npad]
2599 insert_pad $y0 $x0 $npad
2600 if {$y0 > 0} {
2601 optimize_rows $y0 $x0 $row
2603 set z [lindex $offs $col]
2604 set x0 [expr {$col + $z}]
2605 set z0 [lindex $rowoffsets $y0 $x0]
2606 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2607 set npad [expr {$z - 1 + $isarrow}]
2608 set y1 [expr {$row + 1}]
2609 set offs2 [lindex $rowoffsets $y1]
2610 set x1 -1
2611 foreach z $offs2 {
2612 incr x1
2613 if {$z eq {} || $x1 + $z < $col} continue
2614 if {$x1 + $z > $col} {
2615 incr npad
2617 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2618 break
2620 set pad [ntimes $npad {}]
2621 set idlist [eval linsert \$idlist $col $pad]
2622 set tmp [eval linsert \$offs $col $pad]
2623 incr col $npad
2624 set offs [incrange $tmp $col [expr {-$npad}]]
2625 set z [lindex $offs $col]
2626 set haspad 1
2628 if {$z0 eq {} && !$isarrow} {
2629 # this line links to its first child on row $row-2
2630 set rm2 [expr {$row - 2}]
2631 set id [lindex $displayorder $rm2]
2632 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2633 if {$xc >= 0} {
2634 set z0 [expr {$xc - $x0}]
2637 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2638 insert_pad $y0 $x0 1
2639 set offs [incrange $offs $col 1]
2640 optimize_rows $y0 [expr {$x0 + 1}] $row
2643 if {!$haspad} {
2644 set o {}
2645 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2646 set o [lindex $offs $col]
2647 if {$o eq {}} {
2648 # check if this is the link to the first child
2649 set id [lindex $idlist $col]
2650 set ranges [rowranges $id]
2651 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2652 # it is, work out offset to child
2653 set y0 [expr {$row - 1}]
2654 set id [lindex $displayorder $y0]
2655 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2656 if {$x0 >= 0} {
2657 set o [expr {$x0 - $col}]
2661 if {$o eq {} || $o <= 0} break
2663 if {$o ne {} && [incr col] < [llength $idlist]} {
2664 set y1 [expr {$row + 1}]
2665 set offs2 [lindex $rowoffsets $y1]
2666 set x1 -1
2667 foreach z $offs2 {
2668 incr x1
2669 if {$z eq {} || $x1 + $z < $col} continue
2670 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2671 break
2673 set idlist [linsert $idlist $col {}]
2674 set tmp [linsert $offs $col {}]
2675 incr col
2676 set offs [incrange $tmp $col -1]
2679 lset rowidlist $row $idlist
2680 lset rowoffsets $row $offs
2681 set col 0
2685 proc xc {row col} {
2686 global canvx0 linespc
2687 return [expr {$canvx0 + $col * $linespc}]
2690 proc yc {row} {
2691 global canvy0 linespc
2692 return [expr {$canvy0 + $row * $linespc}]
2695 proc linewidth {id} {
2696 global thickerline lthickness
2698 set wid $lthickness
2699 if {[info exists thickerline] && $id eq $thickerline} {
2700 set wid [expr {2 * $lthickness}]
2702 return $wid
2705 proc rowranges {id} {
2706 global phase idrowranges commitrow rowlaidout rowrangelist curview
2708 set ranges {}
2709 if {$phase eq {} ||
2710 ([info exists commitrow($curview,$id)]
2711 && $commitrow($curview,$id) < $rowlaidout)} {
2712 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2713 } elseif {[info exists idrowranges($id)]} {
2714 set ranges $idrowranges($id)
2716 return $ranges
2719 proc drawlineseg {id i} {
2720 global rowoffsets rowidlist
2721 global displayorder
2722 global canv colormap linespc
2723 global numcommits commitrow curview
2725 set ranges [rowranges $id]
2726 set downarrow 1
2727 if {[info exists commitrow($curview,$id)]
2728 && $commitrow($curview,$id) < $numcommits} {
2729 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2730 } else {
2731 set downarrow 1
2733 set startrow [lindex $ranges [expr {2 * $i}]]
2734 set row [lindex $ranges [expr {2 * $i + 1}]]
2735 if {$startrow == $row} return
2736 assigncolor $id
2737 set coords {}
2738 set col [lsearch -exact [lindex $rowidlist $row] $id]
2739 if {$col < 0} {
2740 puts "oops: drawline: id $id not on row $row"
2741 return
2743 set lasto {}
2744 set ns 0
2745 while {1} {
2746 set o [lindex $rowoffsets $row $col]
2747 if {$o eq {}} break
2748 if {$o ne $lasto} {
2749 # changing direction
2750 set x [xc $row $col]
2751 set y [yc $row]
2752 lappend coords $x $y
2753 set lasto $o
2755 incr col $o
2756 incr row -1
2758 set x [xc $row $col]
2759 set y [yc $row]
2760 lappend coords $x $y
2761 if {$i == 0} {
2762 # draw the link to the first child as part of this line
2763 incr row -1
2764 set child [lindex $displayorder $row]
2765 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2766 if {$ccol >= 0} {
2767 set x [xc $row $ccol]
2768 set y [yc $row]
2769 if {$ccol < $col - 1} {
2770 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2771 } elseif {$ccol > $col + 1} {
2772 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2774 lappend coords $x $y
2777 if {[llength $coords] < 4} return
2778 if {$downarrow} {
2779 # This line has an arrow at the lower end: check if the arrow is
2780 # on a diagonal segment, and if so, work around the Tk 8.4
2781 # refusal to draw arrows on diagonal lines.
2782 set x0 [lindex $coords 0]
2783 set x1 [lindex $coords 2]
2784 if {$x0 != $x1} {
2785 set y0 [lindex $coords 1]
2786 set y1 [lindex $coords 3]
2787 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2788 # we have a nearby vertical segment, just trim off the diag bit
2789 set coords [lrange $coords 2 end]
2790 } else {
2791 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2792 set xi [expr {$x0 - $slope * $linespc / 2}]
2793 set yi [expr {$y0 - $linespc / 2}]
2794 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2798 set arrow [expr {2 * ($i > 0) + $downarrow}]
2799 set arrow [lindex {none first last both} $arrow]
2800 set t [$canv create line $coords -width [linewidth $id] \
2801 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2802 $canv lower $t
2803 bindline $t $id
2806 proc drawparentlinks {id row col olds} {
2807 global rowidlist canv colormap
2809 set row2 [expr {$row + 1}]
2810 set x [xc $row $col]
2811 set y [yc $row]
2812 set y2 [yc $row2]
2813 set ids [lindex $rowidlist $row2]
2814 # rmx = right-most X coord used
2815 set rmx 0
2816 foreach p $olds {
2817 set i [lsearch -exact $ids $p]
2818 if {$i < 0} {
2819 puts "oops, parent $p of $id not in list"
2820 continue
2822 set x2 [xc $row2 $i]
2823 if {$x2 > $rmx} {
2824 set rmx $x2
2826 set ranges [rowranges $p]
2827 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2828 && $row2 < [lindex $ranges 1]} {
2829 # drawlineseg will do this one for us
2830 continue
2832 assigncolor $p
2833 # should handle duplicated parents here...
2834 set coords [list $x $y]
2835 if {$i < $col - 1} {
2836 lappend coords [xc $row [expr {$i + 1}]] $y
2837 } elseif {$i > $col + 1} {
2838 lappend coords [xc $row [expr {$i - 1}]] $y
2840 lappend coords $x2 $y2
2841 set t [$canv create line $coords -width [linewidth $p] \
2842 -fill $colormap($p) -tags lines.$p]
2843 $canv lower $t
2844 bindline $t $p
2846 return $rmx
2849 proc drawlines {id} {
2850 global colormap canv
2851 global idrangedrawn
2852 global children iddrawn commitrow rowidlist curview
2854 $canv delete lines.$id
2855 set nr [expr {[llength [rowranges $id]] / 2}]
2856 for {set i 0} {$i < $nr} {incr i} {
2857 if {[info exists idrangedrawn($id,$i)]} {
2858 drawlineseg $id $i
2861 foreach child $children($curview,$id) {
2862 if {[info exists iddrawn($child)]} {
2863 set row $commitrow($curview,$child)
2864 set col [lsearch -exact [lindex $rowidlist $row] $child]
2865 if {$col >= 0} {
2866 drawparentlinks $child $row $col [list $id]
2872 proc drawcmittext {id row col rmx} {
2873 global linespc canv canv2 canv3 canvy0
2874 global commitlisted commitinfo rowidlist
2875 global rowtextx idpos idtags idheads idotherrefs
2876 global linehtag linentag linedtag
2877 global mainfont canvxmax boldrows boldnamerows
2879 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2880 set x [xc $row $col]
2881 set y [yc $row]
2882 set orad [expr {$linespc / 3}]
2883 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2884 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2885 -fill $ofill -outline black -width 1]
2886 $canv raise $t
2887 $canv bind $t <1> {selcanvline {} %x %y}
2888 set xt [xc $row [llength [lindex $rowidlist $row]]]
2889 if {$xt < $rmx} {
2890 set xt $rmx
2892 set rowtextx($row) $xt
2893 set idpos($id) [list $x $xt $y]
2894 if {[info exists idtags($id)] || [info exists idheads($id)]
2895 || [info exists idotherrefs($id)]} {
2896 set xt [drawtags $id $x $xt $y]
2898 set headline [lindex $commitinfo($id) 0]
2899 set name [lindex $commitinfo($id) 1]
2900 set date [lindex $commitinfo($id) 2]
2901 set date [formatdate $date]
2902 set font $mainfont
2903 set nfont $mainfont
2904 set isbold [ishighlighted $row]
2905 if {$isbold > 0} {
2906 lappend boldrows $row
2907 lappend font bold
2908 if {$isbold > 1} {
2909 lappend boldnamerows $row
2910 lappend nfont bold
2913 set linehtag($row) [$canv create text $xt $y -anchor w \
2914 -text $headline -font $font]
2915 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2916 set linentag($row) [$canv2 create text 3 $y -anchor w \
2917 -text $name -font $nfont]
2918 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2919 -text $date -font $mainfont]
2920 set xr [expr {$xt + [font measure $mainfont $headline]}]
2921 if {$xr > $canvxmax} {
2922 set canvxmax $xr
2923 setcanvscroll
2927 proc drawcmitrow {row} {
2928 global displayorder rowidlist
2929 global idrangedrawn iddrawn
2930 global commitinfo parentlist numcommits
2931 global filehighlight fhighlights findstring nhighlights
2932 global hlview vhighlights
2933 global highlight_related rhighlights
2935 if {$row >= $numcommits} return
2936 foreach id [lindex $rowidlist $row] {
2937 if {$id eq {}} continue
2938 set i -1
2939 foreach {s e} [rowranges $id] {
2940 incr i
2941 if {$row < $s} continue
2942 if {$e eq {}} break
2943 if {$row <= $e} {
2944 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2945 drawlineseg $id $i
2946 set idrangedrawn($id,$i) 1
2948 break
2953 set id [lindex $displayorder $row]
2954 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2955 askvhighlight $row $id
2957 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2958 askfilehighlight $row $id
2960 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2961 askfindhighlight $row $id
2963 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2964 askrelhighlight $row $id
2966 if {[info exists iddrawn($id)]} return
2967 set col [lsearch -exact [lindex $rowidlist $row] $id]
2968 if {$col < 0} {
2969 puts "oops, row $row id $id not in list"
2970 return
2972 if {![info exists commitinfo($id)]} {
2973 getcommit $id
2975 assigncolor $id
2976 set olds [lindex $parentlist $row]
2977 if {$olds ne {}} {
2978 set rmx [drawparentlinks $id $row $col $olds]
2979 } else {
2980 set rmx 0
2982 drawcmittext $id $row $col $rmx
2983 set iddrawn($id) 1
2986 proc drawfrac {f0 f1} {
2987 global numcommits canv
2988 global linespc
2990 set ymax [lindex [$canv cget -scrollregion] 3]
2991 if {$ymax eq {} || $ymax == 0} return
2992 set y0 [expr {int($f0 * $ymax)}]
2993 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2994 if {$row < 0} {
2995 set row 0
2997 set y1 [expr {int($f1 * $ymax)}]
2998 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2999 if {$endrow >= $numcommits} {
3000 set endrow [expr {$numcommits - 1}]
3002 for {} {$row <= $endrow} {incr row} {
3003 drawcmitrow $row
3007 proc drawvisible {} {
3008 global canv
3009 eval drawfrac [$canv yview]
3012 proc clear_display {} {
3013 global iddrawn idrangedrawn
3014 global vhighlights fhighlights nhighlights rhighlights
3016 allcanvs delete all
3017 catch {unset iddrawn}
3018 catch {unset idrangedrawn}
3019 catch {unset vhighlights}
3020 catch {unset fhighlights}
3021 catch {unset nhighlights}
3022 catch {unset rhighlights}
3025 proc findcrossings {id} {
3026 global rowidlist parentlist numcommits rowoffsets displayorder
3028 set cross {}
3029 set ccross {}
3030 foreach {s e} [rowranges $id] {
3031 if {$e >= $numcommits} {
3032 set e [expr {$numcommits - 1}]
3034 if {$e <= $s} continue
3035 set x [lsearch -exact [lindex $rowidlist $e] $id]
3036 if {$x < 0} {
3037 puts "findcrossings: oops, no [shortids $id] in row $e"
3038 continue
3040 for {set row $e} {[incr row -1] >= $s} {} {
3041 set olds [lindex $parentlist $row]
3042 set kid [lindex $displayorder $row]
3043 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3044 if {$kidx < 0} continue
3045 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3046 foreach p $olds {
3047 set px [lsearch -exact $nextrow $p]
3048 if {$px < 0} continue
3049 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3050 if {[lsearch -exact $ccross $p] >= 0} continue
3051 if {$x == $px + ($kidx < $px? -1: 1)} {
3052 lappend ccross $p
3053 } elseif {[lsearch -exact $cross $p] < 0} {
3054 lappend cross $p
3058 set inc [lindex $rowoffsets $row $x]
3059 if {$inc eq {}} break
3060 incr x $inc
3063 return [concat $ccross {{}} $cross]
3066 proc assigncolor {id} {
3067 global colormap colors nextcolor
3068 global commitrow parentlist children children curview
3070 if {[info exists colormap($id)]} return
3071 set ncolors [llength $colors]
3072 if {[info exists children($curview,$id)]} {
3073 set kids $children($curview,$id)
3074 } else {
3075 set kids {}
3077 if {[llength $kids] == 1} {
3078 set child [lindex $kids 0]
3079 if {[info exists colormap($child)]
3080 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3081 set colormap($id) $colormap($child)
3082 return
3085 set badcolors {}
3086 set origbad {}
3087 foreach x [findcrossings $id] {
3088 if {$x eq {}} {
3089 # delimiter between corner crossings and other crossings
3090 if {[llength $badcolors] >= $ncolors - 1} break
3091 set origbad $badcolors
3093 if {[info exists colormap($x)]
3094 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3095 lappend badcolors $colormap($x)
3098 if {[llength $badcolors] >= $ncolors} {
3099 set badcolors $origbad
3101 set origbad $badcolors
3102 if {[llength $badcolors] < $ncolors - 1} {
3103 foreach child $kids {
3104 if {[info exists colormap($child)]
3105 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3106 lappend badcolors $colormap($child)
3108 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3109 if {[info exists colormap($p)]
3110 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3111 lappend badcolors $colormap($p)
3115 if {[llength $badcolors] >= $ncolors} {
3116 set badcolors $origbad
3119 for {set i 0} {$i <= $ncolors} {incr i} {
3120 set c [lindex $colors $nextcolor]
3121 if {[incr nextcolor] >= $ncolors} {
3122 set nextcolor 0
3124 if {[lsearch -exact $badcolors $c]} break
3126 set colormap($id) $c
3129 proc bindline {t id} {
3130 global canv
3132 $canv bind $t <Enter> "lineenter %x %y $id"
3133 $canv bind $t <Motion> "linemotion %x %y $id"
3134 $canv bind $t <Leave> "lineleave $id"
3135 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3138 proc drawtags {id x xt y1} {
3139 global idtags idheads idotherrefs
3140 global linespc lthickness
3141 global canv mainfont commitrow rowtextx curview
3143 set marks {}
3144 set ntags 0
3145 set nheads 0
3146 if {[info exists idtags($id)]} {
3147 set marks $idtags($id)
3148 set ntags [llength $marks]
3150 if {[info exists idheads($id)]} {
3151 set marks [concat $marks $idheads($id)]
3152 set nheads [llength $idheads($id)]
3154 if {[info exists idotherrefs($id)]} {
3155 set marks [concat $marks $idotherrefs($id)]
3157 if {$marks eq {}} {
3158 return $xt
3161 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3162 set yt [expr {$y1 - 0.5 * $linespc}]
3163 set yb [expr {$yt + $linespc - 1}]
3164 set xvals {}
3165 set wvals {}
3166 foreach tag $marks {
3167 set wid [font measure $mainfont $tag]
3168 lappend xvals $xt
3169 lappend wvals $wid
3170 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3172 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3173 -width $lthickness -fill black -tags tag.$id]
3174 $canv lower $t
3175 foreach tag $marks x $xvals wid $wvals {
3176 set xl [expr {$x + $delta}]
3177 set xr [expr {$x + $delta + $wid + $lthickness}]
3178 if {[incr ntags -1] >= 0} {
3179 # draw a tag
3180 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3181 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3182 -width 1 -outline black -fill yellow -tags tag.$id]
3183 $canv bind $t <1> [list showtag $tag 1]
3184 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3185 } else {
3186 # draw a head or other ref
3187 if {[incr nheads -1] >= 0} {
3188 set col green
3189 } else {
3190 set col "#ddddff"
3192 set xl [expr {$xl - $delta/2}]
3193 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3194 -width 1 -outline black -fill $col -tags tag.$id
3195 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3196 set rwid [font measure $mainfont $remoteprefix]
3197 set xi [expr {$x + 1}]
3198 set yti [expr {$yt + 1}]
3199 set xri [expr {$x + $rwid}]
3200 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3201 -width 0 -fill "#ffddaa" -tags tag.$id
3204 set t [$canv create text $xl $y1 -anchor w -text $tag \
3205 -font $mainfont -tags tag.$id]
3206 if {$ntags >= 0} {
3207 $canv bind $t <1> [list showtag $tag 1]
3210 return $xt
3213 proc xcoord {i level ln} {
3214 global canvx0 xspc1 xspc2
3216 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3217 if {$i > 0 && $i == $level} {
3218 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3219 } elseif {$i > $level} {
3220 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3222 return $x
3225 proc show_status {msg} {
3226 global canv mainfont
3228 clear_display
3229 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3232 proc finishcommits {} {
3233 global commitidx phase curview
3234 global canv mainfont ctext maincursor textcursor
3235 global findinprogress pending_select
3237 if {$commitidx($curview) > 0} {
3238 drawrest
3239 } else {
3240 show_status "No commits selected"
3242 set phase {}
3243 catch {unset pending_select}
3246 # Don't change the text pane cursor if it is currently the hand cursor,
3247 # showing that we are over a sha1 ID link.
3248 proc settextcursor {c} {
3249 global ctext curtextcursor
3251 if {[$ctext cget -cursor] == $curtextcursor} {
3252 $ctext config -cursor $c
3254 set curtextcursor $c
3257 proc nowbusy {what} {
3258 global isbusy
3260 if {[array names isbusy] eq {}} {
3261 . config -cursor watch
3262 settextcursor watch
3264 set isbusy($what) 1
3267 proc notbusy {what} {
3268 global isbusy maincursor textcursor
3270 catch {unset isbusy($what)}
3271 if {[array names isbusy] eq {}} {
3272 . config -cursor $maincursor
3273 settextcursor $textcursor
3277 proc drawrest {} {
3278 global numcommits
3279 global startmsecs
3280 global canvy0 numcommits linespc
3281 global rowlaidout commitidx curview
3282 global pending_select
3284 set row $rowlaidout
3285 layoutrows $rowlaidout $commitidx($curview) 1
3286 layouttail
3287 optimize_rows $row 0 $commitidx($curview)
3288 showstuff $commitidx($curview)
3289 if {[info exists pending_select]} {
3290 selectline 0 1
3293 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3294 #puts "overall $drawmsecs ms for $numcommits commits"
3297 proc findmatches {f} {
3298 global findtype foundstring foundstrlen
3299 if {$findtype == "Regexp"} {
3300 set matches [regexp -indices -all -inline $foundstring $f]
3301 } else {
3302 if {$findtype == "IgnCase"} {
3303 set str [string tolower $f]
3304 } else {
3305 set str $f
3307 set matches {}
3308 set i 0
3309 while {[set j [string first $foundstring $str $i]] >= 0} {
3310 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3311 set i [expr {$j + $foundstrlen}]
3314 return $matches
3317 proc dofind {} {
3318 global findtype findloc findstring markedmatches commitinfo
3319 global numcommits displayorder linehtag linentag linedtag
3320 global mainfont canv canv2 canv3 selectedline
3321 global matchinglines foundstring foundstrlen matchstring
3322 global commitdata
3324 stopfindproc
3325 unmarkmatches
3326 cancel_next_highlight
3327 focus .
3328 set matchinglines {}
3329 if {$findtype == "IgnCase"} {
3330 set foundstring [string tolower $findstring]
3331 } else {
3332 set foundstring $findstring
3334 set foundstrlen [string length $findstring]
3335 if {$foundstrlen == 0} return
3336 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3337 set matchstring "*$matchstring*"
3338 if {![info exists selectedline]} {
3339 set oldsel -1
3340 } else {
3341 set oldsel $selectedline
3343 set didsel 0
3344 set fldtypes {Headline Author Date Committer CDate Comments}
3345 set l -1
3346 foreach id $displayorder {
3347 set d $commitdata($id)
3348 incr l
3349 if {$findtype == "Regexp"} {
3350 set doesmatch [regexp $foundstring $d]
3351 } elseif {$findtype == "IgnCase"} {
3352 set doesmatch [string match -nocase $matchstring $d]
3353 } else {
3354 set doesmatch [string match $matchstring $d]
3356 if {!$doesmatch} continue
3357 if {![info exists commitinfo($id)]} {
3358 getcommit $id
3360 set info $commitinfo($id)
3361 set doesmatch 0
3362 foreach f $info ty $fldtypes {
3363 if {$findloc != "All fields" && $findloc != $ty} {
3364 continue
3366 set matches [findmatches $f]
3367 if {$matches == {}} continue
3368 set doesmatch 1
3369 if {$ty == "Headline"} {
3370 drawcmitrow $l
3371 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3372 } elseif {$ty == "Author"} {
3373 drawcmitrow $l
3374 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3375 } elseif {$ty == "Date"} {
3376 drawcmitrow $l
3377 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3380 if {$doesmatch} {
3381 lappend matchinglines $l
3382 if {!$didsel && $l > $oldsel} {
3383 findselectline $l
3384 set didsel 1
3388 if {$matchinglines == {}} {
3389 bell
3390 } elseif {!$didsel} {
3391 findselectline [lindex $matchinglines 0]
3395 proc findselectline {l} {
3396 global findloc commentend ctext
3397 selectline $l 1
3398 if {$findloc == "All fields" || $findloc == "Comments"} {
3399 # highlight the matches in the comments
3400 set f [$ctext get 1.0 $commentend]
3401 set matches [findmatches $f]
3402 foreach match $matches {
3403 set start [lindex $match 0]
3404 set end [expr {[lindex $match 1] + 1}]
3405 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3410 proc findnext {restart} {
3411 global matchinglines selectedline
3412 if {![info exists matchinglines]} {
3413 if {$restart} {
3414 dofind
3416 return
3418 if {![info exists selectedline]} return
3419 foreach l $matchinglines {
3420 if {$l > $selectedline} {
3421 findselectline $l
3422 return
3425 bell
3428 proc findprev {} {
3429 global matchinglines selectedline
3430 if {![info exists matchinglines]} {
3431 dofind
3432 return
3434 if {![info exists selectedline]} return
3435 set prev {}
3436 foreach l $matchinglines {
3437 if {$l >= $selectedline} break
3438 set prev $l
3440 if {$prev != {}} {
3441 findselectline $prev
3442 } else {
3443 bell
3447 proc stopfindproc {{done 0}} {
3448 global findprocpid findprocfile findids
3449 global ctext findoldcursor phase maincursor textcursor
3450 global findinprogress
3452 catch {unset findids}
3453 if {[info exists findprocpid]} {
3454 if {!$done} {
3455 catch {exec kill $findprocpid}
3457 catch {close $findprocfile}
3458 unset findprocpid
3460 catch {unset findinprogress}
3461 notbusy find
3464 # mark a commit as matching by putting a yellow background
3465 # behind the headline
3466 proc markheadline {l id} {
3467 global canv mainfont linehtag
3469 drawcmitrow $l
3470 set bbox [$canv bbox $linehtag($l)]
3471 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3472 $canv lower $t
3475 # mark the bits of a headline, author or date that match a find string
3476 proc markmatches {canv l str tag matches font} {
3477 set bbox [$canv bbox $tag]
3478 set x0 [lindex $bbox 0]
3479 set y0 [lindex $bbox 1]
3480 set y1 [lindex $bbox 3]
3481 foreach match $matches {
3482 set start [lindex $match 0]
3483 set end [lindex $match 1]
3484 if {$start > $end} continue
3485 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3486 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3487 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3488 [expr {$x0+$xlen+2}] $y1 \
3489 -outline {} -tags matches -fill yellow]
3490 $canv lower $t
3494 proc unmarkmatches {} {
3495 global matchinglines findids
3496 allcanvs delete matches
3497 catch {unset matchinglines}
3498 catch {unset findids}
3501 proc selcanvline {w x y} {
3502 global canv canvy0 ctext linespc
3503 global rowtextx
3504 set ymax [lindex [$canv cget -scrollregion] 3]
3505 if {$ymax == {}} return
3506 set yfrac [lindex [$canv yview] 0]
3507 set y [expr {$y + $yfrac * $ymax}]
3508 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3509 if {$l < 0} {
3510 set l 0
3512 if {$w eq $canv} {
3513 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3515 unmarkmatches
3516 selectline $l 1
3519 proc commit_descriptor {p} {
3520 global commitinfo
3521 if {![info exists commitinfo($p)]} {
3522 getcommit $p
3524 set l "..."
3525 if {[llength $commitinfo($p)] > 1} {
3526 set l [lindex $commitinfo($p) 0]
3528 return "$p ($l)\n"
3531 # append some text to the ctext widget, and make any SHA1 ID
3532 # that we know about be a clickable link.
3533 proc appendwithlinks {text tags} {
3534 global ctext commitrow linknum curview
3536 set start [$ctext index "end - 1c"]
3537 $ctext insert end $text $tags
3538 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3539 foreach l $links {
3540 set s [lindex $l 0]
3541 set e [lindex $l 1]
3542 set linkid [string range $text $s $e]
3543 if {![info exists commitrow($curview,$linkid)]} continue
3544 incr e
3545 $ctext tag add link "$start + $s c" "$start + $e c"
3546 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3547 $ctext tag bind link$linknum <1> \
3548 [list selectline $commitrow($curview,$linkid) 1]
3549 incr linknum
3551 $ctext tag conf link -foreground blue -underline 1
3552 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3553 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3556 proc viewnextline {dir} {
3557 global canv linespc
3559 $canv delete hover
3560 set ymax [lindex [$canv cget -scrollregion] 3]
3561 set wnow [$canv yview]
3562 set wtop [expr {[lindex $wnow 0] * $ymax}]
3563 set newtop [expr {$wtop + $dir * $linespc}]
3564 if {$newtop < 0} {
3565 set newtop 0
3566 } elseif {$newtop > $ymax} {
3567 set newtop $ymax
3569 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3572 # add a list of tag or branch names at position pos
3573 # returns the number of names inserted
3574 proc appendrefs {pos l var} {
3575 global ctext commitrow linknum curview idtags $var
3577 if {[catch {$ctext index $pos}]} {
3578 return 0
3580 set tags {}
3581 foreach id $l {
3582 foreach tag [set $var\($id\)] {
3583 lappend tags [concat $tag $id]
3586 set tags [lsort -index 1 $tags]
3587 set sep {}
3588 foreach tag $tags {
3589 set name [lindex $tag 0]
3590 set id [lindex $tag 1]
3591 set lk link$linknum
3592 incr linknum
3593 $ctext insert $pos $sep
3594 $ctext insert $pos $name $lk
3595 $ctext tag conf $lk -foreground blue
3596 if {[info exists commitrow($curview,$id)]} {
3597 $ctext tag bind $lk <1> \
3598 [list selectline $commitrow($curview,$id) 1]
3599 $ctext tag conf $lk -underline 1
3600 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3601 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3603 set sep ", "
3605 return [llength $tags]
3608 # called when we have finished computing the nearby tags
3609 proc dispneartags {} {
3610 global selectedline currentid ctext anc_tags desc_tags showneartags
3611 global desc_heads
3613 if {![info exists selectedline] || !$showneartags} return
3614 set id $currentid
3615 $ctext conf -state normal
3616 if {[info exists desc_heads($id)]} {
3617 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3618 $ctext insert "branch -2c" "es"
3621 if {[info exists anc_tags($id)]} {
3622 appendrefs follows $anc_tags($id) idtags
3624 if {[info exists desc_tags($id)]} {
3625 appendrefs precedes $desc_tags($id) idtags
3627 $ctext conf -state disabled
3630 proc selectline {l isnew} {
3631 global canv canv2 canv3 ctext commitinfo selectedline
3632 global displayorder linehtag linentag linedtag
3633 global canvy0 linespc parentlist childlist
3634 global currentid sha1entry
3635 global commentend idtags linknum
3636 global mergemax numcommits pending_select
3637 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3639 catch {unset pending_select}
3640 $canv delete hover
3641 normalline
3642 cancel_next_highlight
3643 if {$l < 0 || $l >= $numcommits} return
3644 set y [expr {$canvy0 + $l * $linespc}]
3645 set ymax [lindex [$canv cget -scrollregion] 3]
3646 set ytop [expr {$y - $linespc - 1}]
3647 set ybot [expr {$y + $linespc + 1}]
3648 set wnow [$canv yview]
3649 set wtop [expr {[lindex $wnow 0] * $ymax}]
3650 set wbot [expr {[lindex $wnow 1] * $ymax}]
3651 set wh [expr {$wbot - $wtop}]
3652 set newtop $wtop
3653 if {$ytop < $wtop} {
3654 if {$ybot < $wtop} {
3655 set newtop [expr {$y - $wh / 2.0}]
3656 } else {
3657 set newtop $ytop
3658 if {$newtop > $wtop - $linespc} {
3659 set newtop [expr {$wtop - $linespc}]
3662 } elseif {$ybot > $wbot} {
3663 if {$ytop > $wbot} {
3664 set newtop [expr {$y - $wh / 2.0}]
3665 } else {
3666 set newtop [expr {$ybot - $wh}]
3667 if {$newtop < $wtop + $linespc} {
3668 set newtop [expr {$wtop + $linespc}]
3672 if {$newtop != $wtop} {
3673 if {$newtop < 0} {
3674 set newtop 0
3676 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3677 drawvisible
3680 if {![info exists linehtag($l)]} return
3681 $canv delete secsel
3682 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3683 -tags secsel -fill [$canv cget -selectbackground]]
3684 $canv lower $t
3685 $canv2 delete secsel
3686 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3687 -tags secsel -fill [$canv2 cget -selectbackground]]
3688 $canv2 lower $t
3689 $canv3 delete secsel
3690 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3691 -tags secsel -fill [$canv3 cget -selectbackground]]
3692 $canv3 lower $t
3694 if {$isnew} {
3695 addtohistory [list selectline $l 0]
3698 set selectedline $l
3700 set id [lindex $displayorder $l]
3701 set currentid $id
3702 $sha1entry delete 0 end
3703 $sha1entry insert 0 $id
3704 $sha1entry selection from 0
3705 $sha1entry selection to end
3706 rhighlight_sel $id
3708 $ctext conf -state normal
3709 clear_ctext
3710 set linknum 0
3711 set info $commitinfo($id)
3712 set date [formatdate [lindex $info 2]]
3713 $ctext insert end "Author: [lindex $info 1] $date\n"
3714 set date [formatdate [lindex $info 4]]
3715 $ctext insert end "Committer: [lindex $info 3] $date\n"
3716 if {[info exists idtags($id)]} {
3717 $ctext insert end "Tags:"
3718 foreach tag $idtags($id) {
3719 $ctext insert end " $tag"
3721 $ctext insert end "\n"
3724 set headers {}
3725 set olds [lindex $parentlist $l]
3726 if {[llength $olds] > 1} {
3727 set np 0
3728 foreach p $olds {
3729 if {$np >= $mergemax} {
3730 set tag mmax
3731 } else {
3732 set tag m$np
3734 $ctext insert end "Parent: " $tag
3735 appendwithlinks [commit_descriptor $p] {}
3736 incr np
3738 } else {
3739 foreach p $olds {
3740 append headers "Parent: [commit_descriptor $p]"
3744 foreach c [lindex $childlist $l] {
3745 append headers "Child: [commit_descriptor $c]"
3748 # make anything that looks like a SHA1 ID be a clickable link
3749 appendwithlinks $headers {}
3750 if {$showneartags} {
3751 if {![info exists allcommits]} {
3752 getallcommits
3754 $ctext insert end "Branch: "
3755 $ctext mark set branch "end -1c"
3756 $ctext mark gravity branch left
3757 if {[info exists desc_heads($id)]} {
3758 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3759 # turn "Branch" into "Branches"
3760 $ctext insert "branch -2c" "es"
3763 $ctext insert end "\nFollows: "
3764 $ctext mark set follows "end -1c"
3765 $ctext mark gravity follows left
3766 if {[info exists anc_tags($id)]} {
3767 appendrefs follows $anc_tags($id) idtags
3769 $ctext insert end "\nPrecedes: "
3770 $ctext mark set precedes "end -1c"
3771 $ctext mark gravity precedes left
3772 if {[info exists desc_tags($id)]} {
3773 appendrefs precedes $desc_tags($id) idtags
3775 $ctext insert end "\n"
3777 $ctext insert end "\n"
3778 appendwithlinks [lindex $info 5] {comment}
3780 $ctext tag delete Comments
3781 $ctext tag remove found 1.0 end
3782 $ctext conf -state disabled
3783 set commentend [$ctext index "end - 1c"]
3785 init_flist "Comments"
3786 if {$cmitmode eq "tree"} {
3787 gettree $id
3788 } elseif {[llength $olds] <= 1} {
3789 startdiff $id
3790 } else {
3791 mergediff $id $l
3795 proc selfirstline {} {
3796 unmarkmatches
3797 selectline 0 1
3800 proc sellastline {} {
3801 global numcommits
3802 unmarkmatches
3803 set l [expr {$numcommits - 1}]
3804 selectline $l 1
3807 proc selnextline {dir} {
3808 global selectedline
3809 if {![info exists selectedline]} return
3810 set l [expr {$selectedline + $dir}]
3811 unmarkmatches
3812 selectline $l 1
3815 proc selnextpage {dir} {
3816 global canv linespc selectedline numcommits
3818 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3819 if {$lpp < 1} {
3820 set lpp 1
3822 allcanvs yview scroll [expr {$dir * $lpp}] units
3823 drawvisible
3824 if {![info exists selectedline]} return
3825 set l [expr {$selectedline + $dir * $lpp}]
3826 if {$l < 0} {
3827 set l 0
3828 } elseif {$l >= $numcommits} {
3829 set l [expr $numcommits - 1]
3831 unmarkmatches
3832 selectline $l 1
3835 proc unselectline {} {
3836 global selectedline currentid
3838 catch {unset selectedline}
3839 catch {unset currentid}
3840 allcanvs delete secsel
3841 rhighlight_none
3842 cancel_next_highlight
3845 proc reselectline {} {
3846 global selectedline
3848 if {[info exists selectedline]} {
3849 selectline $selectedline 0
3853 proc addtohistory {cmd} {
3854 global history historyindex curview
3856 set elt [list $curview $cmd]
3857 if {$historyindex > 0
3858 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3859 return
3862 if {$historyindex < [llength $history]} {
3863 set history [lreplace $history $historyindex end $elt]
3864 } else {
3865 lappend history $elt
3867 incr historyindex
3868 if {$historyindex > 1} {
3869 .ctop.top.bar.leftbut conf -state normal
3870 } else {
3871 .ctop.top.bar.leftbut conf -state disabled
3873 .ctop.top.bar.rightbut conf -state disabled
3876 proc godo {elt} {
3877 global curview
3879 set view [lindex $elt 0]
3880 set cmd [lindex $elt 1]
3881 if {$curview != $view} {
3882 showview $view
3884 eval $cmd
3887 proc goback {} {
3888 global history historyindex
3890 if {$historyindex > 1} {
3891 incr historyindex -1
3892 godo [lindex $history [expr {$historyindex - 1}]]
3893 .ctop.top.bar.rightbut conf -state normal
3895 if {$historyindex <= 1} {
3896 .ctop.top.bar.leftbut conf -state disabled
3900 proc goforw {} {
3901 global history historyindex
3903 if {$historyindex < [llength $history]} {
3904 set cmd [lindex $history $historyindex]
3905 incr historyindex
3906 godo $cmd
3907 .ctop.top.bar.leftbut conf -state normal
3909 if {$historyindex >= [llength $history]} {
3910 .ctop.top.bar.rightbut conf -state disabled
3914 proc gettree {id} {
3915 global treefilelist treeidlist diffids diffmergeid treepending
3917 set diffids $id
3918 catch {unset diffmergeid}
3919 if {![info exists treefilelist($id)]} {
3920 if {![info exists treepending]} {
3921 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3922 return
3924 set treepending $id
3925 set treefilelist($id) {}
3926 set treeidlist($id) {}
3927 fconfigure $gtf -blocking 0
3928 fileevent $gtf readable [list gettreeline $gtf $id]
3930 } else {
3931 setfilelist $id
3935 proc gettreeline {gtf id} {
3936 global treefilelist treeidlist treepending cmitmode diffids
3938 while {[gets $gtf line] >= 0} {
3939 if {[lindex $line 1] ne "blob"} continue
3940 set sha1 [lindex $line 2]
3941 set fname [lindex $line 3]
3942 lappend treefilelist($id) $fname
3943 lappend treeidlist($id) $sha1
3945 if {![eof $gtf]} return
3946 close $gtf
3947 unset treepending
3948 if {$cmitmode ne "tree"} {
3949 if {![info exists diffmergeid]} {
3950 gettreediffs $diffids
3952 } elseif {$id ne $diffids} {
3953 gettree $diffids
3954 } else {
3955 setfilelist $id
3959 proc showfile {f} {
3960 global treefilelist treeidlist diffids
3961 global ctext commentend
3963 set i [lsearch -exact $treefilelist($diffids) $f]
3964 if {$i < 0} {
3965 puts "oops, $f not in list for id $diffids"
3966 return
3968 set blob [lindex $treeidlist($diffids) $i]
3969 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3970 puts "oops, error reading blob $blob: $err"
3971 return
3973 fconfigure $bf -blocking 0
3974 fileevent $bf readable [list getblobline $bf $diffids]
3975 $ctext config -state normal
3976 clear_ctext $commentend
3977 $ctext insert end "\n"
3978 $ctext insert end "$f\n" filesep
3979 $ctext config -state disabled
3980 $ctext yview $commentend
3983 proc getblobline {bf id} {
3984 global diffids cmitmode ctext
3986 if {$id ne $diffids || $cmitmode ne "tree"} {
3987 catch {close $bf}
3988 return
3990 $ctext config -state normal
3991 while {[gets $bf line] >= 0} {
3992 $ctext insert end "$line\n"
3994 if {[eof $bf]} {
3995 # delete last newline
3996 $ctext delete "end - 2c" "end - 1c"
3997 close $bf
3999 $ctext config -state disabled
4002 proc mergediff {id l} {
4003 global diffmergeid diffopts mdifffd
4004 global diffids
4005 global parentlist
4007 set diffmergeid $id
4008 set diffids $id
4009 # this doesn't seem to actually affect anything...
4010 set env(GIT_DIFF_OPTS) $diffopts
4011 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4012 if {[catch {set mdf [open $cmd r]} err]} {
4013 error_popup "Error getting merge diffs: $err"
4014 return
4016 fconfigure $mdf -blocking 0
4017 set mdifffd($id) $mdf
4018 set np [llength [lindex $parentlist $l]]
4019 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4020 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4023 proc getmergediffline {mdf id np} {
4024 global diffmergeid ctext cflist nextupdate mergemax
4025 global difffilestart mdifffd
4027 set n [gets $mdf line]
4028 if {$n < 0} {
4029 if {[eof $mdf]} {
4030 close $mdf
4032 return
4034 if {![info exists diffmergeid] || $id != $diffmergeid
4035 || $mdf != $mdifffd($id)} {
4036 return
4038 $ctext conf -state normal
4039 if {[regexp {^diff --cc (.*)} $line match fname]} {
4040 # start of a new file
4041 $ctext insert end "\n"
4042 set here [$ctext index "end - 1c"]
4043 lappend difffilestart $here
4044 add_flist [list $fname]
4045 set l [expr {(78 - [string length $fname]) / 2}]
4046 set pad [string range "----------------------------------------" 1 $l]
4047 $ctext insert end "$pad $fname $pad\n" filesep
4048 } elseif {[regexp {^@@} $line]} {
4049 $ctext insert end "$line\n" hunksep
4050 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4051 # do nothing
4052 } else {
4053 # parse the prefix - one ' ', '-' or '+' for each parent
4054 set spaces {}
4055 set minuses {}
4056 set pluses {}
4057 set isbad 0
4058 for {set j 0} {$j < $np} {incr j} {
4059 set c [string range $line $j $j]
4060 if {$c == " "} {
4061 lappend spaces $j
4062 } elseif {$c == "-"} {
4063 lappend minuses $j
4064 } elseif {$c == "+"} {
4065 lappend pluses $j
4066 } else {
4067 set isbad 1
4068 break
4071 set tags {}
4072 set num {}
4073 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4074 # line doesn't appear in result, parents in $minuses have the line
4075 set num [lindex $minuses 0]
4076 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4077 # line appears in result, parents in $pluses don't have the line
4078 lappend tags mresult
4079 set num [lindex $spaces 0]
4081 if {$num ne {}} {
4082 if {$num >= $mergemax} {
4083 set num "max"
4085 lappend tags m$num
4087 $ctext insert end "$line\n" $tags
4089 $ctext conf -state disabled
4090 if {[clock clicks -milliseconds] >= $nextupdate} {
4091 incr nextupdate 100
4092 fileevent $mdf readable {}
4093 update
4094 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4098 proc startdiff {ids} {
4099 global treediffs diffids treepending diffmergeid
4101 set diffids $ids
4102 catch {unset diffmergeid}
4103 if {![info exists treediffs($ids)]} {
4104 if {![info exists treepending]} {
4105 gettreediffs $ids
4107 } else {
4108 addtocflist $ids
4112 proc addtocflist {ids} {
4113 global treediffs cflist
4114 add_flist $treediffs($ids)
4115 getblobdiffs $ids
4118 proc gettreediffs {ids} {
4119 global treediff treepending
4120 set treepending $ids
4121 set treediff {}
4122 if {[catch \
4123 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4124 ]} return
4125 fconfigure $gdtf -blocking 0
4126 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4129 proc gettreediffline {gdtf ids} {
4130 global treediff treediffs treepending diffids diffmergeid
4131 global cmitmode
4133 set n [gets $gdtf line]
4134 if {$n < 0} {
4135 if {![eof $gdtf]} return
4136 close $gdtf
4137 set treediffs($ids) $treediff
4138 unset treepending
4139 if {$cmitmode eq "tree"} {
4140 gettree $diffids
4141 } elseif {$ids != $diffids} {
4142 if {![info exists diffmergeid]} {
4143 gettreediffs $diffids
4145 } else {
4146 addtocflist $ids
4148 return
4150 set file [lindex $line 5]
4151 lappend treediff $file
4154 proc getblobdiffs {ids} {
4155 global diffopts blobdifffd diffids env curdifftag curtagstart
4156 global nextupdate diffinhdr treediffs
4158 set env(GIT_DIFF_OPTS) $diffopts
4159 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4160 if {[catch {set bdf [open $cmd r]} err]} {
4161 puts "error getting diffs: $err"
4162 return
4164 set diffinhdr 0
4165 fconfigure $bdf -blocking 0
4166 set blobdifffd($ids) $bdf
4167 set curdifftag Comments
4168 set curtagstart 0.0
4169 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4170 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4173 proc setinlist {var i val} {
4174 global $var
4176 while {[llength [set $var]] < $i} {
4177 lappend $var {}
4179 if {[llength [set $var]] == $i} {
4180 lappend $var $val
4181 } else {
4182 lset $var $i $val
4186 proc getblobdiffline {bdf ids} {
4187 global diffids blobdifffd ctext curdifftag curtagstart
4188 global diffnexthead diffnextnote difffilestart
4189 global nextupdate diffinhdr treediffs
4191 set n [gets $bdf line]
4192 if {$n < 0} {
4193 if {[eof $bdf]} {
4194 close $bdf
4195 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4196 $ctext tag add $curdifftag $curtagstart end
4199 return
4201 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4202 return
4204 $ctext conf -state normal
4205 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4206 # start of a new file
4207 $ctext insert end "\n"
4208 $ctext tag add $curdifftag $curtagstart end
4209 set here [$ctext index "end - 1c"]
4210 set curtagstart $here
4211 set header $newname
4212 set i [lsearch -exact $treediffs($ids) $fname]
4213 if {$i >= 0} {
4214 setinlist difffilestart $i $here
4216 if {$newname ne $fname} {
4217 set i [lsearch -exact $treediffs($ids) $newname]
4218 if {$i >= 0} {
4219 setinlist difffilestart $i $here
4222 set curdifftag "f:$fname"
4223 $ctext tag delete $curdifftag
4224 set l [expr {(78 - [string length $header]) / 2}]
4225 set pad [string range "----------------------------------------" 1 $l]
4226 $ctext insert end "$pad $header $pad\n" filesep
4227 set diffinhdr 1
4228 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4229 # do nothing
4230 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4231 set diffinhdr 0
4232 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4233 $line match f1l f1c f2l f2c rest]} {
4234 $ctext insert end "$line\n" hunksep
4235 set diffinhdr 0
4236 } else {
4237 set x [string range $line 0 0]
4238 if {$x == "-" || $x == "+"} {
4239 set tag [expr {$x == "+"}]
4240 $ctext insert end "$line\n" d$tag
4241 } elseif {$x == " "} {
4242 $ctext insert end "$line\n"
4243 } elseif {$diffinhdr || $x == "\\"} {
4244 # e.g. "\ No newline at end of file"
4245 $ctext insert end "$line\n" filesep
4246 } else {
4247 # Something else we don't recognize
4248 if {$curdifftag != "Comments"} {
4249 $ctext insert end "\n"
4250 $ctext tag add $curdifftag $curtagstart end
4251 set curtagstart [$ctext index "end - 1c"]
4252 set curdifftag Comments
4254 $ctext insert end "$line\n" filesep
4257 $ctext conf -state disabled
4258 if {[clock clicks -milliseconds] >= $nextupdate} {
4259 incr nextupdate 100
4260 fileevent $bdf readable {}
4261 update
4262 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4266 proc nextfile {} {
4267 global difffilestart ctext
4268 set here [$ctext index @0,0]
4269 foreach loc $difffilestart {
4270 if {[$ctext compare $loc > $here]} {
4271 $ctext yview $loc
4276 proc clear_ctext {{first 1.0}} {
4277 global ctext smarktop smarkbot
4279 set l [lindex [split $first .] 0]
4280 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4281 set smarktop $l
4283 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4284 set smarkbot $l
4286 $ctext delete $first end
4289 proc incrsearch {name ix op} {
4290 global ctext searchstring searchdirn
4292 $ctext tag remove found 1.0 end
4293 if {[catch {$ctext index anchor}]} {
4294 # no anchor set, use start of selection, or of visible area
4295 set sel [$ctext tag ranges sel]
4296 if {$sel ne {}} {
4297 $ctext mark set anchor [lindex $sel 0]
4298 } elseif {$searchdirn eq "-forwards"} {
4299 $ctext mark set anchor @0,0
4300 } else {
4301 $ctext mark set anchor @0,[winfo height $ctext]
4304 if {$searchstring ne {}} {
4305 set here [$ctext search $searchdirn -- $searchstring anchor]
4306 if {$here ne {}} {
4307 $ctext see $here
4309 searchmarkvisible 1
4313 proc dosearch {} {
4314 global sstring ctext searchstring searchdirn
4316 focus $sstring
4317 $sstring icursor end
4318 set searchdirn -forwards
4319 if {$searchstring ne {}} {
4320 set sel [$ctext tag ranges sel]
4321 if {$sel ne {}} {
4322 set start "[lindex $sel 0] + 1c"
4323 } elseif {[catch {set start [$ctext index anchor]}]} {
4324 set start "@0,0"
4326 set match [$ctext search -count mlen -- $searchstring $start]
4327 $ctext tag remove sel 1.0 end
4328 if {$match eq {}} {
4329 bell
4330 return
4332 $ctext see $match
4333 set mend "$match + $mlen c"
4334 $ctext tag add sel $match $mend
4335 $ctext mark unset anchor
4339 proc dosearchback {} {
4340 global sstring ctext searchstring searchdirn
4342 focus $sstring
4343 $sstring icursor end
4344 set searchdirn -backwards
4345 if {$searchstring ne {}} {
4346 set sel [$ctext tag ranges sel]
4347 if {$sel ne {}} {
4348 set start [lindex $sel 0]
4349 } elseif {[catch {set start [$ctext index anchor]}]} {
4350 set start @0,[winfo height $ctext]
4352 set match [$ctext search -backwards -count ml -- $searchstring $start]
4353 $ctext tag remove sel 1.0 end
4354 if {$match eq {}} {
4355 bell
4356 return
4358 $ctext see $match
4359 set mend "$match + $ml c"
4360 $ctext tag add sel $match $mend
4361 $ctext mark unset anchor
4365 proc searchmark {first last} {
4366 global ctext searchstring
4368 set mend $first.0
4369 while {1} {
4370 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4371 if {$match eq {}} break
4372 set mend "$match + $mlen c"
4373 $ctext tag add found $match $mend
4377 proc searchmarkvisible {doall} {
4378 global ctext smarktop smarkbot
4380 set topline [lindex [split [$ctext index @0,0] .] 0]
4381 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4382 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4383 # no overlap with previous
4384 searchmark $topline $botline
4385 set smarktop $topline
4386 set smarkbot $botline
4387 } else {
4388 if {$topline < $smarktop} {
4389 searchmark $topline [expr {$smarktop-1}]
4390 set smarktop $topline
4392 if {$botline > $smarkbot} {
4393 searchmark [expr {$smarkbot+1}] $botline
4394 set smarkbot $botline
4399 proc scrolltext {f0 f1} {
4400 global searchstring
4402 .ctop.cdet.left.sb set $f0 $f1
4403 if {$searchstring ne {}} {
4404 searchmarkvisible 0
4408 proc setcoords {} {
4409 global linespc charspc canvx0 canvy0 mainfont
4410 global xspc1 xspc2 lthickness
4412 set linespc [font metrics $mainfont -linespace]
4413 set charspc [font measure $mainfont "m"]
4414 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4415 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4416 set lthickness [expr {int($linespc / 9) + 1}]
4417 set xspc1(0) $linespc
4418 set xspc2 $linespc
4421 proc redisplay {} {
4422 global canv
4423 global selectedline
4425 set ymax [lindex [$canv cget -scrollregion] 3]
4426 if {$ymax eq {} || $ymax == 0} return
4427 set span [$canv yview]
4428 clear_display
4429 setcanvscroll
4430 allcanvs yview moveto [lindex $span 0]
4431 drawvisible
4432 if {[info exists selectedline]} {
4433 selectline $selectedline 0
4437 proc incrfont {inc} {
4438 global mainfont textfont ctext canv phase
4439 global stopped entries
4440 unmarkmatches
4441 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4442 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4443 setcoords
4444 $ctext conf -font $textfont
4445 $ctext tag conf filesep -font [concat $textfont bold]
4446 foreach e $entries {
4447 $e conf -font $mainfont
4449 if {$phase eq "getcommits"} {
4450 $canv itemconf textitems -font $mainfont
4452 redisplay
4455 proc clearsha1 {} {
4456 global sha1entry sha1string
4457 if {[string length $sha1string] == 40} {
4458 $sha1entry delete 0 end
4462 proc sha1change {n1 n2 op} {
4463 global sha1string currentid sha1but
4464 if {$sha1string == {}
4465 || ([info exists currentid] && $sha1string == $currentid)} {
4466 set state disabled
4467 } else {
4468 set state normal
4470 if {[$sha1but cget -state] == $state} return
4471 if {$state == "normal"} {
4472 $sha1but conf -state normal -relief raised -text "Goto: "
4473 } else {
4474 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4478 proc gotocommit {} {
4479 global sha1string currentid commitrow tagids headids
4480 global displayorder numcommits curview
4482 if {$sha1string == {}
4483 || ([info exists currentid] && $sha1string == $currentid)} return
4484 if {[info exists tagids($sha1string)]} {
4485 set id $tagids($sha1string)
4486 } elseif {[info exists headids($sha1string)]} {
4487 set id $headids($sha1string)
4488 } else {
4489 set id [string tolower $sha1string]
4490 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4491 set matches {}
4492 foreach i $displayorder {
4493 if {[string match $id* $i]} {
4494 lappend matches $i
4497 if {$matches ne {}} {
4498 if {[llength $matches] > 1} {
4499 error_popup "Short SHA1 id $id is ambiguous"
4500 return
4502 set id [lindex $matches 0]
4506 if {[info exists commitrow($curview,$id)]} {
4507 selectline $commitrow($curview,$id) 1
4508 return
4510 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4511 set type "SHA1 id"
4512 } else {
4513 set type "Tag/Head"
4515 error_popup "$type $sha1string is not known"
4518 proc lineenter {x y id} {
4519 global hoverx hovery hoverid hovertimer
4520 global commitinfo canv
4522 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4523 set hoverx $x
4524 set hovery $y
4525 set hoverid $id
4526 if {[info exists hovertimer]} {
4527 after cancel $hovertimer
4529 set hovertimer [after 500 linehover]
4530 $canv delete hover
4533 proc linemotion {x y id} {
4534 global hoverx hovery hoverid hovertimer
4536 if {[info exists hoverid] && $id == $hoverid} {
4537 set hoverx $x
4538 set hovery $y
4539 if {[info exists hovertimer]} {
4540 after cancel $hovertimer
4542 set hovertimer [after 500 linehover]
4546 proc lineleave {id} {
4547 global hoverid hovertimer canv
4549 if {[info exists hoverid] && $id == $hoverid} {
4550 $canv delete hover
4551 if {[info exists hovertimer]} {
4552 after cancel $hovertimer
4553 unset hovertimer
4555 unset hoverid
4559 proc linehover {} {
4560 global hoverx hovery hoverid hovertimer
4561 global canv linespc lthickness
4562 global commitinfo mainfont
4564 set text [lindex $commitinfo($hoverid) 0]
4565 set ymax [lindex [$canv cget -scrollregion] 3]
4566 if {$ymax == {}} return
4567 set yfrac [lindex [$canv yview] 0]
4568 set x [expr {$hoverx + 2 * $linespc}]
4569 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4570 set x0 [expr {$x - 2 * $lthickness}]
4571 set y0 [expr {$y - 2 * $lthickness}]
4572 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4573 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4574 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4575 -fill \#ffff80 -outline black -width 1 -tags hover]
4576 $canv raise $t
4577 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4578 $canv raise $t
4581 proc clickisonarrow {id y} {
4582 global lthickness
4584 set ranges [rowranges $id]
4585 set thresh [expr {2 * $lthickness + 6}]
4586 set n [expr {[llength $ranges] - 1}]
4587 for {set i 1} {$i < $n} {incr i} {
4588 set row [lindex $ranges $i]
4589 if {abs([yc $row] - $y) < $thresh} {
4590 return $i
4593 return {}
4596 proc arrowjump {id n y} {
4597 global canv
4599 # 1 <-> 2, 3 <-> 4, etc...
4600 set n [expr {(($n - 1) ^ 1) + 1}]
4601 set row [lindex [rowranges $id] $n]
4602 set yt [yc $row]
4603 set ymax [lindex [$canv cget -scrollregion] 3]
4604 if {$ymax eq {} || $ymax <= 0} return
4605 set view [$canv yview]
4606 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4607 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4608 if {$yfrac < 0} {
4609 set yfrac 0
4611 allcanvs yview moveto $yfrac
4614 proc lineclick {x y id isnew} {
4615 global ctext commitinfo children canv thickerline curview
4617 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4618 unmarkmatches
4619 unselectline
4620 normalline
4621 $canv delete hover
4622 # draw this line thicker than normal
4623 set thickerline $id
4624 drawlines $id
4625 if {$isnew} {
4626 set ymax [lindex [$canv cget -scrollregion] 3]
4627 if {$ymax eq {}} return
4628 set yfrac [lindex [$canv yview] 0]
4629 set y [expr {$y + $yfrac * $ymax}]
4631 set dirn [clickisonarrow $id $y]
4632 if {$dirn ne {}} {
4633 arrowjump $id $dirn $y
4634 return
4637 if {$isnew} {
4638 addtohistory [list lineclick $x $y $id 0]
4640 # fill the details pane with info about this line
4641 $ctext conf -state normal
4642 clear_ctext
4643 $ctext tag conf link -foreground blue -underline 1
4644 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4645 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4646 $ctext insert end "Parent:\t"
4647 $ctext insert end $id [list link link0]
4648 $ctext tag bind link0 <1> [list selbyid $id]
4649 set info $commitinfo($id)
4650 $ctext insert end "\n\t[lindex $info 0]\n"
4651 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4652 set date [formatdate [lindex $info 2]]
4653 $ctext insert end "\tDate:\t$date\n"
4654 set kids $children($curview,$id)
4655 if {$kids ne {}} {
4656 $ctext insert end "\nChildren:"
4657 set i 0
4658 foreach child $kids {
4659 incr i
4660 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4661 set info $commitinfo($child)
4662 $ctext insert end "\n\t"
4663 $ctext insert end $child [list link link$i]
4664 $ctext tag bind link$i <1> [list selbyid $child]
4665 $ctext insert end "\n\t[lindex $info 0]"
4666 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4667 set date [formatdate [lindex $info 2]]
4668 $ctext insert end "\n\tDate:\t$date\n"
4671 $ctext conf -state disabled
4672 init_flist {}
4675 proc normalline {} {
4676 global thickerline
4677 if {[info exists thickerline]} {
4678 set id $thickerline
4679 unset thickerline
4680 drawlines $id
4684 proc selbyid {id} {
4685 global commitrow curview
4686 if {[info exists commitrow($curview,$id)]} {
4687 selectline $commitrow($curview,$id) 1
4691 proc mstime {} {
4692 global startmstime
4693 if {![info exists startmstime]} {
4694 set startmstime [clock clicks -milliseconds]
4696 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4699 proc rowmenu {x y id} {
4700 global rowctxmenu commitrow selectedline rowmenuid curview
4702 if {![info exists selectedline]
4703 || $commitrow($curview,$id) eq $selectedline} {
4704 set state disabled
4705 } else {
4706 set state normal
4708 $rowctxmenu entryconfigure 0 -state $state
4709 $rowctxmenu entryconfigure 1 -state $state
4710 $rowctxmenu entryconfigure 2 -state $state
4711 set rowmenuid $id
4712 tk_popup $rowctxmenu $x $y
4715 proc diffvssel {dirn} {
4716 global rowmenuid selectedline displayorder
4718 if {![info exists selectedline]} return
4719 if {$dirn} {
4720 set oldid [lindex $displayorder $selectedline]
4721 set newid $rowmenuid
4722 } else {
4723 set oldid $rowmenuid
4724 set newid [lindex $displayorder $selectedline]
4726 addtohistory [list doseldiff $oldid $newid]
4727 doseldiff $oldid $newid
4730 proc doseldiff {oldid newid} {
4731 global ctext
4732 global commitinfo
4734 $ctext conf -state normal
4735 clear_ctext
4736 init_flist "Top"
4737 $ctext insert end "From "
4738 $ctext tag conf link -foreground blue -underline 1
4739 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4740 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4741 $ctext tag bind link0 <1> [list selbyid $oldid]
4742 $ctext insert end $oldid [list link link0]
4743 $ctext insert end "\n "
4744 $ctext insert end [lindex $commitinfo($oldid) 0]
4745 $ctext insert end "\n\nTo "
4746 $ctext tag bind link1 <1> [list selbyid $newid]
4747 $ctext insert end $newid [list link link1]
4748 $ctext insert end "\n "
4749 $ctext insert end [lindex $commitinfo($newid) 0]
4750 $ctext insert end "\n"
4751 $ctext conf -state disabled
4752 $ctext tag delete Comments
4753 $ctext tag remove found 1.0 end
4754 startdiff [list $oldid $newid]
4757 proc mkpatch {} {
4758 global rowmenuid currentid commitinfo patchtop patchnum
4760 if {![info exists currentid]} return
4761 set oldid $currentid
4762 set oldhead [lindex $commitinfo($oldid) 0]
4763 set newid $rowmenuid
4764 set newhead [lindex $commitinfo($newid) 0]
4765 set top .patch
4766 set patchtop $top
4767 catch {destroy $top}
4768 toplevel $top
4769 label $top.title -text "Generate patch"
4770 grid $top.title - -pady 10
4771 label $top.from -text "From:"
4772 entry $top.fromsha1 -width 40 -relief flat
4773 $top.fromsha1 insert 0 $oldid
4774 $top.fromsha1 conf -state readonly
4775 grid $top.from $top.fromsha1 -sticky w
4776 entry $top.fromhead -width 60 -relief flat
4777 $top.fromhead insert 0 $oldhead
4778 $top.fromhead conf -state readonly
4779 grid x $top.fromhead -sticky w
4780 label $top.to -text "To:"
4781 entry $top.tosha1 -width 40 -relief flat
4782 $top.tosha1 insert 0 $newid
4783 $top.tosha1 conf -state readonly
4784 grid $top.to $top.tosha1 -sticky w
4785 entry $top.tohead -width 60 -relief flat
4786 $top.tohead insert 0 $newhead
4787 $top.tohead conf -state readonly
4788 grid x $top.tohead -sticky w
4789 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4790 grid $top.rev x -pady 10
4791 label $top.flab -text "Output file:"
4792 entry $top.fname -width 60
4793 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4794 incr patchnum
4795 grid $top.flab $top.fname -sticky w
4796 frame $top.buts
4797 button $top.buts.gen -text "Generate" -command mkpatchgo
4798 button $top.buts.can -text "Cancel" -command mkpatchcan
4799 grid $top.buts.gen $top.buts.can
4800 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4801 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4802 grid $top.buts - -pady 10 -sticky ew
4803 focus $top.fname
4806 proc mkpatchrev {} {
4807 global patchtop
4809 set oldid [$patchtop.fromsha1 get]
4810 set oldhead [$patchtop.fromhead get]
4811 set newid [$patchtop.tosha1 get]
4812 set newhead [$patchtop.tohead get]
4813 foreach e [list fromsha1 fromhead tosha1 tohead] \
4814 v [list $newid $newhead $oldid $oldhead] {
4815 $patchtop.$e conf -state normal
4816 $patchtop.$e delete 0 end
4817 $patchtop.$e insert 0 $v
4818 $patchtop.$e conf -state readonly
4822 proc mkpatchgo {} {
4823 global patchtop
4825 set oldid [$patchtop.fromsha1 get]
4826 set newid [$patchtop.tosha1 get]
4827 set fname [$patchtop.fname get]
4828 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4829 error_popup "Error creating patch: $err"
4831 catch {destroy $patchtop}
4832 unset patchtop
4835 proc mkpatchcan {} {
4836 global patchtop
4838 catch {destroy $patchtop}
4839 unset patchtop
4842 proc mktag {} {
4843 global rowmenuid mktagtop commitinfo
4845 set top .maketag
4846 set mktagtop $top
4847 catch {destroy $top}
4848 toplevel $top
4849 label $top.title -text "Create tag"
4850 grid $top.title - -pady 10
4851 label $top.id -text "ID:"
4852 entry $top.sha1 -width 40 -relief flat
4853 $top.sha1 insert 0 $rowmenuid
4854 $top.sha1 conf -state readonly
4855 grid $top.id $top.sha1 -sticky w
4856 entry $top.head -width 60 -relief flat
4857 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4858 $top.head conf -state readonly
4859 grid x $top.head -sticky w
4860 label $top.tlab -text "Tag name:"
4861 entry $top.tag -width 60
4862 grid $top.tlab $top.tag -sticky w
4863 frame $top.buts
4864 button $top.buts.gen -text "Create" -command mktaggo
4865 button $top.buts.can -text "Cancel" -command mktagcan
4866 grid $top.buts.gen $top.buts.can
4867 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4868 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4869 grid $top.buts - -pady 10 -sticky ew
4870 focus $top.tag
4873 proc domktag {} {
4874 global mktagtop env tagids idtags
4876 set id [$mktagtop.sha1 get]
4877 set tag [$mktagtop.tag get]
4878 if {$tag == {}} {
4879 error_popup "No tag name specified"
4880 return
4882 if {[info exists tagids($tag)]} {
4883 error_popup "Tag \"$tag\" already exists"
4884 return
4886 if {[catch {
4887 set dir [gitdir]
4888 set fname [file join $dir "refs/tags" $tag]
4889 set f [open $fname w]
4890 puts $f $id
4891 close $f
4892 } err]} {
4893 error_popup "Error creating tag: $err"
4894 return
4897 set tagids($tag) $id
4898 lappend idtags($id) $tag
4899 redrawtags $id
4902 proc redrawtags {id} {
4903 global canv linehtag commitrow idpos selectedline curview
4904 global mainfont
4906 if {![info exists commitrow($curview,$id)]} return
4907 drawcmitrow $commitrow($curview,$id)
4908 $canv delete tag.$id
4909 set xt [eval drawtags $id $idpos($id)]
4910 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4911 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4912 set xr [expr {$xt + [font measure $mainfont $text]}]
4913 if {$xr > $canvxmax} {
4914 set canvxmax $xr
4915 setcanvscroll
4917 if {[info exists selectedline]
4918 && $selectedline == $commitrow($curview,$id)} {
4919 selectline $selectedline 0
4923 proc mktagcan {} {
4924 global mktagtop
4926 catch {destroy $mktagtop}
4927 unset mktagtop
4930 proc mktaggo {} {
4931 domktag
4932 mktagcan
4935 proc writecommit {} {
4936 global rowmenuid wrcomtop commitinfo wrcomcmd
4938 set top .writecommit
4939 set wrcomtop $top
4940 catch {destroy $top}
4941 toplevel $top
4942 label $top.title -text "Write commit to file"
4943 grid $top.title - -pady 10
4944 label $top.id -text "ID:"
4945 entry $top.sha1 -width 40 -relief flat
4946 $top.sha1 insert 0 $rowmenuid
4947 $top.sha1 conf -state readonly
4948 grid $top.id $top.sha1 -sticky w
4949 entry $top.head -width 60 -relief flat
4950 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4951 $top.head conf -state readonly
4952 grid x $top.head -sticky w
4953 label $top.clab -text "Command:"
4954 entry $top.cmd -width 60 -textvariable wrcomcmd
4955 grid $top.clab $top.cmd -sticky w -pady 10
4956 label $top.flab -text "Output file:"
4957 entry $top.fname -width 60
4958 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4959 grid $top.flab $top.fname -sticky w
4960 frame $top.buts
4961 button $top.buts.gen -text "Write" -command wrcomgo
4962 button $top.buts.can -text "Cancel" -command wrcomcan
4963 grid $top.buts.gen $top.buts.can
4964 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4965 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4966 grid $top.buts - -pady 10 -sticky ew
4967 focus $top.fname
4970 proc wrcomgo {} {
4971 global wrcomtop
4973 set id [$wrcomtop.sha1 get]
4974 set cmd "echo $id | [$wrcomtop.cmd get]"
4975 set fname [$wrcomtop.fname get]
4976 if {[catch {exec sh -c $cmd >$fname &} err]} {
4977 error_popup "Error writing commit: $err"
4979 catch {destroy $wrcomtop}
4980 unset wrcomtop
4983 proc wrcomcan {} {
4984 global wrcomtop
4986 catch {destroy $wrcomtop}
4987 unset wrcomtop
4990 # Stuff for finding nearby tags
4991 proc getallcommits {} {
4992 global allcstart allcommits allcfd
4994 set fd [open [concat | git rev-list --all --topo-order --parents] r]
4995 set allcfd $fd
4996 fconfigure $fd -blocking 0
4997 set allcommits "reading"
4998 nowbusy allcommits
4999 restartgetall $fd
5002 proc discardallcommits {} {
5003 global allparents allchildren allcommits allcfd
5004 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5006 if {![info exists allcommits]} return
5007 if {$allcommits eq "reading"} {
5008 catch {close $allcfd}
5010 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5011 alldtags tagisdesc desc_heads} {
5012 catch {unset $v}
5016 proc restartgetall {fd} {
5017 global allcstart
5019 fileevent $fd readable [list getallclines $fd]
5020 set allcstart [clock clicks -milliseconds]
5023 proc combine_dtags {l1 l2} {
5024 global tagisdesc notfirstd
5026 set res [lsort -unique [concat $l1 $l2]]
5027 for {set i 0} {$i < [llength $res]} {incr i} {
5028 set x [lindex $res $i]
5029 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5030 set y [lindex $res $j]
5031 if {[info exists tagisdesc($x,$y)]} {
5032 if {$tagisdesc($x,$y) > 0} {
5033 # x is a descendent of y, exclude x
5034 set res [lreplace $res $i $i]
5035 incr i -1
5036 break
5037 } else {
5038 # y is a descendent of x, exclude y
5039 set res [lreplace $res $j $j]
5041 } else {
5042 # no relation, keep going
5043 incr j
5047 return $res
5050 proc combine_atags {l1 l2} {
5051 global tagisdesc
5053 set res [lsort -unique [concat $l1 $l2]]
5054 for {set i 0} {$i < [llength $res]} {incr i} {
5055 set x [lindex $res $i]
5056 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5057 set y [lindex $res $j]
5058 if {[info exists tagisdesc($x,$y)]} {
5059 if {$tagisdesc($x,$y) < 0} {
5060 # x is an ancestor of y, exclude x
5061 set res [lreplace $res $i $i]
5062 incr i -1
5063 break
5064 } else {
5065 # y is an ancestor of x, exclude y
5066 set res [lreplace $res $j $j]
5068 } else {
5069 # no relation, keep going
5070 incr j
5074 return $res
5077 proc getallclines {fd} {
5078 global allparents allchildren allcommits allcstart
5079 global desc_tags anc_tags idtags alldtags tagisdesc allids
5080 global desc_heads idheads
5082 while {[gets $fd line] >= 0} {
5083 set id [lindex $line 0]
5084 lappend allids $id
5085 set olds [lrange $line 1 end]
5086 set allparents($id) $olds
5087 if {![info exists allchildren($id)]} {
5088 set allchildren($id) {}
5090 foreach p $olds {
5091 lappend allchildren($p) $id
5093 # compute nearest tagged descendents as we go
5094 # also compute descendent heads
5095 set dtags {}
5096 set dheads {}
5097 foreach child $allchildren($id) {
5098 if {[info exists idtags($child)]} {
5099 set ctags [list $child]
5100 } else {
5101 set ctags $desc_tags($child)
5103 if {$dtags eq {}} {
5104 set dtags $ctags
5105 } elseif {$ctags ne $dtags} {
5106 set dtags [combine_dtags $dtags $ctags]
5108 set cheads $desc_heads($child)
5109 if {$dheads eq {}} {
5110 set dheads $cheads
5111 } elseif {$cheads ne $dheads} {
5112 set dheads [lsort -unique [concat $dheads $cheads]]
5115 set desc_tags($id) $dtags
5116 if {[info exists idtags($id)]} {
5117 set adt $dtags
5118 foreach tag $dtags {
5119 set adt [concat $adt $alldtags($tag)]
5121 set adt [lsort -unique $adt]
5122 set alldtags($id) $adt
5123 foreach tag $adt {
5124 set tagisdesc($id,$tag) -1
5125 set tagisdesc($tag,$id) 1
5128 if {[info exists idheads($id)]} {
5129 lappend dheads $id
5131 set desc_heads($id) $dheads
5132 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5133 fileevent $fd readable {}
5134 after idle restartgetall $fd
5135 return
5138 if {[eof $fd]} {
5139 after idle restartatags [llength $allids]
5140 if {[catch {close $fd} err]} {
5141 error_popup "Error reading full commit graph: $err.\n\
5142 Results may be incomplete."
5147 # walk backward through the tree and compute nearest tagged ancestors
5148 proc restartatags {i} {
5149 global allids allparents idtags anc_tags t0
5151 set t0 [clock clicks -milliseconds]
5152 while {[incr i -1] >= 0} {
5153 set id [lindex $allids $i]
5154 set atags {}
5155 foreach p $allparents($id) {
5156 if {[info exists idtags($p)]} {
5157 set ptags [list $p]
5158 } else {
5159 set ptags $anc_tags($p)
5161 if {$atags eq {}} {
5162 set atags $ptags
5163 } elseif {$ptags ne $atags} {
5164 set atags [combine_atags $atags $ptags]
5167 set anc_tags($id) $atags
5168 if {[clock clicks -milliseconds] - $t0 >= 50} {
5169 after idle restartatags $i
5170 return
5173 set allcommits "done"
5174 notbusy allcommits
5175 dispneartags
5178 proc rereadrefs {} {
5179 global idtags idheads idotherrefs
5181 set refids [concat [array names idtags] \
5182 [array names idheads] [array names idotherrefs]]
5183 foreach id $refids {
5184 if {![info exists ref($id)]} {
5185 set ref($id) [listrefs $id]
5188 readrefs
5189 set refids [lsort -unique [concat $refids [array names idtags] \
5190 [array names idheads] [array names idotherrefs]]]
5191 foreach id $refids {
5192 set v [listrefs $id]
5193 if {![info exists ref($id)] || $ref($id) != $v} {
5194 redrawtags $id
5199 proc listrefs {id} {
5200 global idtags idheads idotherrefs
5202 set x {}
5203 if {[info exists idtags($id)]} {
5204 set x $idtags($id)
5206 set y {}
5207 if {[info exists idheads($id)]} {
5208 set y $idheads($id)
5210 set z {}
5211 if {[info exists idotherrefs($id)]} {
5212 set z $idotherrefs($id)
5214 return [list $x $y $z]
5217 proc showtag {tag isnew} {
5218 global ctext tagcontents tagids linknum
5220 if {$isnew} {
5221 addtohistory [list showtag $tag 0]
5223 $ctext conf -state normal
5224 clear_ctext
5225 set linknum 0
5226 if {[info exists tagcontents($tag)]} {
5227 set text $tagcontents($tag)
5228 } else {
5229 set text "Tag: $tag\nId: $tagids($tag)"
5231 appendwithlinks $text {}
5232 $ctext conf -state disabled
5233 init_flist {}
5236 proc doquit {} {
5237 global stopped
5238 set stopped 100
5239 destroy .
5242 proc doprefs {} {
5243 global maxwidth maxgraphpct diffopts
5244 global oldprefs prefstop showneartags
5246 set top .gitkprefs
5247 set prefstop $top
5248 if {[winfo exists $top]} {
5249 raise $top
5250 return
5252 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5253 set oldprefs($v) [set $v]
5255 toplevel $top
5256 wm title $top "Gitk preferences"
5257 label $top.ldisp -text "Commit list display options"
5258 grid $top.ldisp - -sticky w -pady 10
5259 label $top.spacer -text " "
5260 label $top.maxwidthl -text "Maximum graph width (lines)" \
5261 -font optionfont
5262 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5263 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5264 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5265 -font optionfont
5266 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5267 grid x $top.maxpctl $top.maxpct -sticky w
5268 label $top.ddisp -text "Diff display options"
5269 grid $top.ddisp - -sticky w -pady 10
5270 label $top.diffoptl -text "Options for diff program" \
5271 -font optionfont
5272 entry $top.diffopt -width 20 -textvariable diffopts
5273 grid x $top.diffoptl $top.diffopt -sticky w
5274 frame $top.ntag
5275 label $top.ntag.l -text "Display nearby tags" -font optionfont
5276 checkbutton $top.ntag.b -variable showneartags
5277 pack $top.ntag.b $top.ntag.l -side left
5278 grid x $top.ntag -sticky w
5279 frame $top.buts
5280 button $top.buts.ok -text "OK" -command prefsok
5281 button $top.buts.can -text "Cancel" -command prefscan
5282 grid $top.buts.ok $top.buts.can
5283 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5284 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5285 grid $top.buts - - -pady 10 -sticky ew
5288 proc prefscan {} {
5289 global maxwidth maxgraphpct diffopts
5290 global oldprefs prefstop showneartags
5292 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5293 set $v $oldprefs($v)
5295 catch {destroy $prefstop}
5296 unset prefstop
5299 proc prefsok {} {
5300 global maxwidth maxgraphpct
5301 global oldprefs prefstop showneartags
5303 catch {destroy $prefstop}
5304 unset prefstop
5305 if {$maxwidth != $oldprefs(maxwidth)
5306 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5307 redisplay
5308 } elseif {$showneartags != $oldprefs(showneartags)} {
5309 reselectline
5313 proc formatdate {d} {
5314 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5317 # This list of encoding names and aliases is distilled from
5318 # http://www.iana.org/assignments/character-sets.
5319 # Not all of them are supported by Tcl.
5320 set encoding_aliases {
5321 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5322 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5323 { ISO-10646-UTF-1 csISO10646UTF1 }
5324 { ISO_646.basic:1983 ref csISO646basic1983 }
5325 { INVARIANT csINVARIANT }
5326 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5327 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5328 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5329 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5330 { NATS-DANO iso-ir-9-1 csNATSDANO }
5331 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5332 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5333 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5334 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5335 { ISO-2022-KR csISO2022KR }
5336 { EUC-KR csEUCKR }
5337 { ISO-2022-JP csISO2022JP }
5338 { ISO-2022-JP-2 csISO2022JP2 }
5339 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5340 csISO13JISC6220jp }
5341 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5342 { IT iso-ir-15 ISO646-IT csISO15Italian }
5343 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5344 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5345 { greek7-old iso-ir-18 csISO18Greek7Old }
5346 { latin-greek iso-ir-19 csISO19LatinGreek }
5347 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5348 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5349 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5350 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5351 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5352 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5353 { INIS iso-ir-49 csISO49INIS }
5354 { INIS-8 iso-ir-50 csISO50INIS8 }
5355 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5356 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5357 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5358 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5359 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5360 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5361 csISO60Norwegian1 }
5362 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5363 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5364 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5365 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5366 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5367 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5368 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5369 { greek7 iso-ir-88 csISO88Greek7 }
5370 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5371 { iso-ir-90 csISO90 }
5372 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5373 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5374 csISO92JISC62991984b }
5375 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5376 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5377 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5378 csISO95JIS62291984handadd }
5379 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5380 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5381 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5382 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5383 CP819 csISOLatin1 }
5384 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5385 { T.61-7bit iso-ir-102 csISO102T617bit }
5386 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5387 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5388 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5389 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5390 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5391 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5392 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5393 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5394 arabic csISOLatinArabic }
5395 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5396 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5397 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5398 greek greek8 csISOLatinGreek }
5399 { T.101-G2 iso-ir-128 csISO128T101G2 }
5400 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5401 csISOLatinHebrew }
5402 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5403 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5404 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5405 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5406 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5407 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5408 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5409 csISOLatinCyrillic }
5410 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5411 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5412 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5413 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5414 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5415 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5416 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5417 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5418 { ISO_10367-box iso-ir-155 csISO10367Box }
5419 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5420 { latin-lap lap iso-ir-158 csISO158Lap }
5421 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5422 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5423 { us-dk csUSDK }
5424 { dk-us csDKUS }
5425 { JIS_X0201 X0201 csHalfWidthKatakana }
5426 { KSC5636 ISO646-KR csKSC5636 }
5427 { ISO-10646-UCS-2 csUnicode }
5428 { ISO-10646-UCS-4 csUCS4 }
5429 { DEC-MCS dec csDECMCS }
5430 { hp-roman8 roman8 r8 csHPRoman8 }
5431 { macintosh mac csMacintosh }
5432 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5433 csIBM037 }
5434 { IBM038 EBCDIC-INT cp038 csIBM038 }
5435 { IBM273 CP273 csIBM273 }
5436 { IBM274 EBCDIC-BE CP274 csIBM274 }
5437 { IBM275 EBCDIC-BR cp275 csIBM275 }
5438 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5439 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5440 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5441 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5442 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5443 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5444 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5445 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5446 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5447 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5448 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5449 { IBM437 cp437 437 csPC8CodePage437 }
5450 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5451 { IBM775 cp775 csPC775Baltic }
5452 { IBM850 cp850 850 csPC850Multilingual }
5453 { IBM851 cp851 851 csIBM851 }
5454 { IBM852 cp852 852 csPCp852 }
5455 { IBM855 cp855 855 csIBM855 }
5456 { IBM857 cp857 857 csIBM857 }
5457 { IBM860 cp860 860 csIBM860 }
5458 { IBM861 cp861 861 cp-is csIBM861 }
5459 { IBM862 cp862 862 csPC862LatinHebrew }
5460 { IBM863 cp863 863 csIBM863 }
5461 { IBM864 cp864 csIBM864 }
5462 { IBM865 cp865 865 csIBM865 }
5463 { IBM866 cp866 866 csIBM866 }
5464 { IBM868 CP868 cp-ar csIBM868 }
5465 { IBM869 cp869 869 cp-gr csIBM869 }
5466 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5467 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5468 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5469 { IBM891 cp891 csIBM891 }
5470 { IBM903 cp903 csIBM903 }
5471 { IBM904 cp904 904 csIBBM904 }
5472 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5473 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5474 { IBM1026 CP1026 csIBM1026 }
5475 { EBCDIC-AT-DE csIBMEBCDICATDE }
5476 { EBCDIC-AT-DE-A csEBCDICATDEA }
5477 { EBCDIC-CA-FR csEBCDICCAFR }
5478 { EBCDIC-DK-NO csEBCDICDKNO }
5479 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5480 { EBCDIC-FI-SE csEBCDICFISE }
5481 { EBCDIC-FI-SE-A csEBCDICFISEA }
5482 { EBCDIC-FR csEBCDICFR }
5483 { EBCDIC-IT csEBCDICIT }
5484 { EBCDIC-PT csEBCDICPT }
5485 { EBCDIC-ES csEBCDICES }
5486 { EBCDIC-ES-A csEBCDICESA }
5487 { EBCDIC-ES-S csEBCDICESS }
5488 { EBCDIC-UK csEBCDICUK }
5489 { EBCDIC-US csEBCDICUS }
5490 { UNKNOWN-8BIT csUnknown8BiT }
5491 { MNEMONIC csMnemonic }
5492 { MNEM csMnem }
5493 { VISCII csVISCII }
5494 { VIQR csVIQR }
5495 { KOI8-R csKOI8R }
5496 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5497 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5498 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5499 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5500 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5501 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5502 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5503 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5504 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5505 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5506 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5507 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5508 { IBM1047 IBM-1047 }
5509 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5510 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5511 { UNICODE-1-1 csUnicode11 }
5512 { CESU-8 csCESU-8 }
5513 { BOCU-1 csBOCU-1 }
5514 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5515 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5516 l8 }
5517 { ISO-8859-15 ISO_8859-15 Latin-9 }
5518 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5519 { GBK CP936 MS936 windows-936 }
5520 { JIS_Encoding csJISEncoding }
5521 { Shift_JIS MS_Kanji csShiftJIS }
5522 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5523 EUC-JP }
5524 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5525 { ISO-10646-UCS-Basic csUnicodeASCII }
5526 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5527 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5528 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5529 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5530 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5531 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5532 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5533 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5534 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5535 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5536 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5537 { Ventura-US csVenturaUS }
5538 { Ventura-International csVenturaInternational }
5539 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5540 { PC8-Turkish csPC8Turkish }
5541 { IBM-Symbols csIBMSymbols }
5542 { IBM-Thai csIBMThai }
5543 { HP-Legal csHPLegal }
5544 { HP-Pi-font csHPPiFont }
5545 { HP-Math8 csHPMath8 }
5546 { Adobe-Symbol-Encoding csHPPSMath }
5547 { HP-DeskTop csHPDesktop }
5548 { Ventura-Math csVenturaMath }
5549 { Microsoft-Publishing csMicrosoftPublishing }
5550 { Windows-31J csWindows31J }
5551 { GB2312 csGB2312 }
5552 { Big5 csBig5 }
5555 proc tcl_encoding {enc} {
5556 global encoding_aliases
5557 set names [encoding names]
5558 set lcnames [string tolower $names]
5559 set enc [string tolower $enc]
5560 set i [lsearch -exact $lcnames $enc]
5561 if {$i < 0} {
5562 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5563 if {[regsub {^iso[-_]} $enc iso encx]} {
5564 set i [lsearch -exact $lcnames $encx]
5567 if {$i < 0} {
5568 foreach l $encoding_aliases {
5569 set ll [string tolower $l]
5570 if {[lsearch -exact $ll $enc] < 0} continue
5571 # look through the aliases for one that tcl knows about
5572 foreach e $ll {
5573 set i [lsearch -exact $lcnames $e]
5574 if {$i < 0} {
5575 if {[regsub {^iso[-_]} $e iso ex]} {
5576 set i [lsearch -exact $lcnames $ex]
5579 if {$i >= 0} break
5581 break
5584 if {$i >= 0} {
5585 return [lindex $names $i]
5587 return {}
5590 # defaults...
5591 set datemode 0
5592 set diffopts "-U 5 -p"
5593 set wrcomcmd "git diff-tree --stdin -p --pretty"
5595 set gitencoding {}
5596 catch {
5597 set gitencoding [exec git repo-config --get i18n.commitencoding]
5599 if {$gitencoding == ""} {
5600 set gitencoding "utf-8"
5602 set tclencoding [tcl_encoding $gitencoding]
5603 if {$tclencoding == {}} {
5604 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5607 set mainfont {Helvetica 9}
5608 set textfont {Courier 9}
5609 set uifont {Helvetica 9 bold}
5610 set findmergefiles 0
5611 set maxgraphpct 50
5612 set maxwidth 16
5613 set revlistorder 0
5614 set fastdate 0
5615 set uparrowlen 7
5616 set downarrowlen 7
5617 set mingaplen 30
5618 set cmitmode "patch"
5619 set wrapcomment "none"
5620 set showneartags 1
5622 set colors {green red blue magenta darkgrey brown orange}
5624 catch {source ~/.gitk}
5626 font create optionfont -family sans-serif -size -12
5628 set revtreeargs {}
5629 foreach arg $argv {
5630 switch -regexp -- $arg {
5631 "^$" { }
5632 "^-d" { set datemode 1 }
5633 default {
5634 lappend revtreeargs $arg
5639 # check that we can find a .git directory somewhere...
5640 set gitdir [gitdir]
5641 if {![file isdirectory $gitdir]} {
5642 show_error {} . "Cannot find the git directory \"$gitdir\"."
5643 exit 1
5646 set cmdline_files {}
5647 set i [lsearch -exact $revtreeargs "--"]
5648 if {$i >= 0} {
5649 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5650 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5651 } elseif {$revtreeargs ne {}} {
5652 if {[catch {
5653 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5654 set cmdline_files [split $f "\n"]
5655 set n [llength $cmdline_files]
5656 set revtreeargs [lrange $revtreeargs 0 end-$n]
5657 } err]} {
5658 # unfortunately we get both stdout and stderr in $err,
5659 # so look for "fatal:".
5660 set i [string first "fatal:" $err]
5661 if {$i > 0} {
5662 set err [string range $err [expr {$i + 6}] end]
5664 show_error {} . "Bad arguments to gitk:\n$err"
5665 exit 1
5669 set history {}
5670 set historyindex 0
5671 set fh_serial 0
5672 set nhl_names {}
5673 set highlight_paths {}
5674 set searchdirn -forwards
5675 set boldrows {}
5676 set boldnamerows {}
5678 set optim_delay 16
5680 set nextviewnum 1
5681 set curview 0
5682 set selectedview 0
5683 set selectedhlview None
5684 set viewfiles(0) {}
5685 set viewperm(0) 0
5686 set viewargs(0) {}
5688 set cmdlineok 0
5689 set stopped 0
5690 set stuffsaved 0
5691 set patchnum 0
5692 setcoords
5693 makewindow
5694 readrefs
5696 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5697 # create a view for the files/dirs specified on the command line
5698 set curview 1
5699 set selectedview 1
5700 set nextviewnum 2
5701 set viewname(1) "Command line"
5702 set viewfiles(1) $cmdline_files
5703 set viewargs(1) $revtreeargs
5704 set viewperm(1) 0
5705 addviewmenu 1
5706 .bar.view entryconf 2 -state normal
5707 .bar.view entryconf 3 -state normal
5710 if {[info exists permviews]} {
5711 foreach v $permviews {
5712 set n $nextviewnum
5713 incr nextviewnum
5714 set viewname($n) [lindex $v 0]
5715 set viewfiles($n) [lindex $v 1]
5716 set viewargs($n) [lindex $v 2]
5717 set viewperm($n) 1
5718 addviewmenu $n
5721 getcommits