Call make always with CFLAGS in git.spec
[git/mingw/j6t.git] / gitk
blob31d0aad4502f09e26343525f985b4afffe057955
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return [exec git rev-parse --git-dir]
19 proc start_rev_list {view} {
20 global startmsecs nextupdate
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 commitidx($view) 0
27 set args $viewargs($view)
28 if {$viewfiles($view) ne {}} {
29 set args [concat $args "--" $viewfiles($view)]
31 set order "--topo-order"
32 if {$datemode} {
33 set order "--date-order"
35 if {[catch {
36 set fd [open [concat | git rev-list --header $order \
37 --parents --boundary --default HEAD $args] r]
38 } err]} {
39 puts stderr "Error executing git rev-list: $err"
40 exit 1
42 set commfd($view) $fd
43 set leftover($view) {}
44 fconfigure $fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $fd -encoding $tclencoding
48 fileevent $fd readable [list getcommitlines $fd $view]
49 nowbusy $view
52 proc stop_rev_list {} {
53 global commfd curview
55 if {![info exists commfd($curview)]} return
56 set fd $commfd($curview)
57 catch {
58 set pid [pid $fd]
59 exec kill $pid
61 catch {close $fd}
62 unset commfd($curview)
65 proc getcommits {} {
66 global phase canv mainfont curview
68 set phase getcommits
69 initlayout
70 start_rev_list $curview
71 show_status "Reading commits..."
74 proc getcommitlines {fd view} {
75 global commitlisted nextupdate
76 global leftover commfd
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children curview hlview
79 global vparentlist vchildlist vdisporder vcmitlisted
81 set stuff [read $fd 500000]
82 if {$stuff == {}} {
83 if {![eof $fd]} return
84 global viewname
85 unset commfd($view)
86 notbusy $view
87 # set it blocking so we wait for the process to terminate
88 fconfigure $fd -blocking 1
89 if {[catch {close $fd} err]} {
90 set fv {}
91 if {$view != $curview} {
92 set fv " for the \"$viewname($view)\" view"
94 if {[string range $err 0 4] == "usage"} {
95 set err "Gitk: error reading commits$fv:\
96 bad arguments to git rev-list."
97 if {$viewname($view) eq "Command line"} {
98 append err \
99 " (Note: arguments to gitk are passed to git rev-list\
100 to allow selection of commits to be displayed.)"
102 } else {
103 set err "Error reading commits$fv: $err"
105 error_popup $err
107 if {$view == $curview} {
108 after idle finishcommits
110 return
112 set start 0
113 set gotsome 0
114 while 1 {
115 set i [string first "\0" $stuff $start]
116 if {$i < 0} {
117 append leftover($view) [string range $stuff $start end]
118 break
120 if {$start == 0} {
121 set cmit $leftover($view)
122 append cmit [string range $stuff 0 [expr {$i - 1}]]
123 set leftover($view) {}
124 } else {
125 set cmit [string range $stuff $start [expr {$i - 1}]]
127 set start [expr {$i + 1}]
128 set j [string first "\n" $cmit]
129 set ok 0
130 set listed 1
131 if {$j >= 0} {
132 set ids [string range $cmit 0 [expr {$j - 1}]]
133 if {[string range $ids 0 0] == "-"} {
134 set listed 0
135 set ids [string range $ids 1 end]
137 set ok 1
138 foreach id $ids {
139 if {[string length $id] != 40} {
140 set ok 0
141 break
145 if {!$ok} {
146 set shortcmit $cmit
147 if {[string length $shortcmit] > 80} {
148 set shortcmit "[string range $shortcmit 0 80]..."
150 error_popup "Can't parse git rev-list output: {$shortcmit}"
151 exit 1
153 set id [lindex $ids 0]
154 if {$listed} {
155 set olds [lrange $ids 1 end]
156 set i 0
157 foreach p $olds {
158 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
159 lappend children($view,$p) $id
161 incr i
163 } else {
164 set olds {}
166 if {![info exists children($view,$id)]} {
167 set children($view,$id) {}
169 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
170 set commitrow($view,$id) $commitidx($view)
171 incr commitidx($view)
172 if {$view == $curview} {
173 lappend parentlist $olds
174 lappend childlist $children($view,$id)
175 lappend displayorder $id
176 lappend commitlisted $listed
177 } else {
178 lappend vparentlist($view) $olds
179 lappend vchildlist($view) $children($view,$id)
180 lappend vdisporder($view) $id
181 lappend vcmitlisted($view) $listed
183 set gotsome 1
185 if {$gotsome} {
186 if {$view == $curview} {
187 while {[layoutmore $nextupdate]} doupdate
188 } elseif {[info exists hlview] && $view == $hlview} {
189 vhighlightmore
192 if {[clock clicks -milliseconds] >= $nextupdate} {
193 doupdate
197 proc doupdate {} {
198 global commfd nextupdate numcommits
200 foreach v [array names commfd] {
201 fileevent $commfd($v) readable {}
203 update
204 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
205 foreach v [array names commfd] {
206 set fd $commfd($v)
207 fileevent $fd readable [list getcommitlines $fd $v]
211 proc readcommit {id} {
212 if {[catch {set contents [exec git cat-file commit $id]}]} return
213 parsecommit $id $contents 0
216 proc updatecommits {} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
220 if {$phase ne {}} {
221 stop_rev_list
222 set phase {}
224 set n $curview
225 foreach id $displayorder {
226 catch {unset children($n,$id)}
227 catch {unset commitrow($n,$id)}
229 set curview -1
230 catch {unset selectedline}
231 catch {unset thickerline}
232 catch {unset viewdata($n)}
233 discardallcommits
234 readrefs
235 showview $n
238 proc parsecommit {id contents listed} {
239 global commitinfo cdate
241 set inhdr 1
242 set comment {}
243 set headline {}
244 set auname {}
245 set audate {}
246 set comname {}
247 set comdate {}
248 set hdrend [string first "\n\n" $contents]
249 if {$hdrend < 0} {
250 # should never happen...
251 set hdrend [string length $contents]
253 set header [string range $contents 0 [expr {$hdrend - 1}]]
254 set comment [string range $contents [expr {$hdrend + 2}] end]
255 foreach line [split $header "\n"] {
256 set tag [lindex $line 0]
257 if {$tag == "author"} {
258 set audate [lindex $line end-1]
259 set auname [lrange $line 1 end-2]
260 } elseif {$tag == "committer"} {
261 set comdate [lindex $line end-1]
262 set comname [lrange $line 1 end-2]
265 set headline {}
266 # take the first line of the comment as the headline
267 set i [string first "\n" $comment]
268 if {$i >= 0} {
269 set headline [string trim [string range $comment 0 $i]]
270 } else {
271 set headline $comment
273 if {!$listed} {
274 # git rev-list indents the comment by 4 spaces;
275 # if we got this via git cat-file, add the indentation
276 set newcomment {}
277 foreach line [split $comment "\n"] {
278 append newcomment " "
279 append newcomment $line
280 append newcomment "\n"
282 set comment $newcomment
284 if {$comdate != {}} {
285 set cdate($id) $comdate
287 set commitinfo($id) [list $headline $auname $audate \
288 $comname $comdate $comment]
291 proc getcommit {id} {
292 global commitdata commitinfo
294 if {[info exists commitdata($id)]} {
295 parsecommit $id $commitdata($id) 1
296 } else {
297 readcommit $id
298 if {![info exists commitinfo($id)]} {
299 set commitinfo($id) {"No commit information available"}
302 return 1
305 proc readrefs {} {
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs mainhead
309 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
310 catch {unset $v}
312 set refd [open [list | git ls-remote [gitdir]] r]
313 while {0 <= [set n [gets $refd line]]} {
314 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
315 match id path]} {
316 continue
318 if {[regexp {^remotes/.*/HEAD$} $path match]} {
319 continue
321 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
322 set type others
323 set name $path
325 if {[regexp {^remotes/} $path match]} {
326 set type heads
328 if {$type == "tags"} {
329 set tagids($name) $id
330 lappend idtags($id) $name
331 set obj {}
332 set type {}
333 set tag {}
334 catch {
335 set commit [exec git rev-parse "$id^0"]
336 if {$commit != $id} {
337 set tagids($name) $commit
338 lappend idtags($commit) $name
341 catch {
342 set tagcontents($name) [exec git cat-file tag $id]
344 } elseif { $type == "heads" } {
345 set headids($name) $id
346 lappend idheads($id) $name
347 } else {
348 set otherrefids($name) $id
349 lappend idotherrefs($id) $name
352 close $refd
353 set mainhead {}
354 catch {
355 set thehead [exec git symbolic-ref HEAD]
356 if {[string match "refs/heads/*" $thehead]} {
357 set mainhead [string range $thehead 11 end]
362 proc show_error {w top msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $top"
366 pack $w.ok -side bottom -fill x
367 bind $top <Visibility> "grab $top; focus $top"
368 bind $top <Key-Return> "destroy $top"
369 tkwait window $top
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $w $msg
379 proc confirm_popup msg {
380 global confirm_ok
381 set confirm_ok 0
382 set w .confirm
383 toplevel $w
384 wm transient $w .
385 message $w.m -text $msg -justify center -aspect 400
386 pack $w.m -side top -fill x -padx 20 -pady 20
387 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
388 pack $w.ok -side left -fill x
389 button $w.cancel -text Cancel -command "destroy $w"
390 pack $w.cancel -side right -fill x
391 bind $w <Visibility> "grab $w; focus $w"
392 tkwait window $w
393 return $confirm_ok
396 proc makewindow {} {
397 global canv canv2 canv3 linespc charspc ctext cflist
398 global textfont mainfont uifont
399 global findtype findtypemenu findloc findstring fstring geometry
400 global entries sha1entry sha1string sha1but
401 global maincursor textcursor curtextcursor
402 global rowctxmenu mergemax wrapcomment
403 global highlight_files gdttype
404 global searchstring sstring
405 global bgcolor fgcolor bglist fglist diffcolors
406 global headctxmenu
408 menu .bar
409 .bar add cascade -label "File" -menu .bar.file
410 .bar configure -font $uifont
411 menu .bar.file
412 .bar.file add command -label "Update" -command updatecommits
413 .bar.file add command -label "Reread references" -command rereadrefs
414 .bar.file add command -label "Quit" -command doquit
415 .bar.file configure -font $uifont
416 menu .bar.edit
417 .bar add cascade -label "Edit" -menu .bar.edit
418 .bar.edit add command -label "Preferences" -command doprefs
419 .bar.edit configure -font $uifont
421 menu .bar.view -font $uifont
422 .bar add cascade -label "View" -menu .bar.view
423 .bar.view add command -label "New view..." -command {newview 0}
424 .bar.view add command -label "Edit view..." -command editview \
425 -state disabled
426 .bar.view add command -label "Delete view" -command delview -state disabled
427 .bar.view add separator
428 .bar.view add radiobutton -label "All files" -command {showview 0} \
429 -variable selectedview -value 0
431 menu .bar.help
432 .bar add cascade -label "Help" -menu .bar.help
433 .bar.help add command -label "About gitk" -command about
434 .bar.help add command -label "Key bindings" -command keys
435 .bar.help configure -font $uifont
436 . configure -menu .bar
438 if {![info exists geometry(canv1)]} {
439 set geometry(canv1) [expr {45 * $charspc}]
440 set geometry(canv2) [expr {30 * $charspc}]
441 set geometry(canv3) [expr {15 * $charspc}]
442 set geometry(canvh) [expr {25 * $linespc + 4}]
443 set geometry(ctextw) 80
444 set geometry(ctexth) 30
445 set geometry(cflistw) 30
447 panedwindow .ctop -orient vertical
448 if {[info exists geometry(width)]} {
449 .ctop conf -width $geometry(width) -height $geometry(height)
450 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
451 set geometry(ctexth) [expr {($texth - 8) /
452 [font metrics $textfont -linespace]}]
454 frame .ctop.top
455 frame .ctop.top.bar
456 frame .ctop.top.lbar
457 pack .ctop.top.lbar -side bottom -fill x
458 pack .ctop.top.bar -side bottom -fill x
459 set cscroll .ctop.top.csb
460 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
461 pack $cscroll -side right -fill y
462 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
463 pack .ctop.top.clist -side top -fill both -expand 1
464 .ctop add .ctop.top
465 set canv .ctop.top.clist.canv
466 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
467 -background $bgcolor -bd 0 \
468 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
469 .ctop.top.clist add $canv
470 set canv2 .ctop.top.clist.canv2
471 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
472 -background $bgcolor -bd 0 -yscrollincr $linespc
473 .ctop.top.clist add $canv2
474 set canv3 .ctop.top.clist.canv3
475 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
476 -background $bgcolor -bd 0 -yscrollincr $linespc
477 .ctop.top.clist add $canv3
478 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
479 lappend bglist $canv $canv2 $canv3
481 set sha1entry .ctop.top.bar.sha1
482 set entries $sha1entry
483 set sha1but .ctop.top.bar.sha1label
484 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
485 -command gotocommit -width 8 -font $uifont
486 $sha1but conf -disabledforeground [$sha1but cget -foreground]
487 pack .ctop.top.bar.sha1label -side left
488 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
489 trace add variable sha1string write sha1change
490 pack $sha1entry -side left -pady 2
492 image create bitmap bm-left -data {
493 #define left_width 16
494 #define left_height 16
495 static unsigned char left_bits[] = {
496 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
497 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
498 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
500 image create bitmap bm-right -data {
501 #define right_width 16
502 #define right_height 16
503 static unsigned char right_bits[] = {
504 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
505 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
506 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
508 button .ctop.top.bar.leftbut -image bm-left -command goback \
509 -state disabled -width 26
510 pack .ctop.top.bar.leftbut -side left -fill y
511 button .ctop.top.bar.rightbut -image bm-right -command goforw \
512 -state disabled -width 26
513 pack .ctop.top.bar.rightbut -side left -fill y
515 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
516 pack .ctop.top.bar.findbut -side left
517 set findstring {}
518 set fstring .ctop.top.bar.findstring
519 lappend entries $fstring
520 entry $fstring -width 30 -font $textfont -textvariable findstring
521 trace add variable findstring write find_change
522 pack $fstring -side left -expand 1 -fill x
523 set findtype Exact
524 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
525 findtype Exact IgnCase Regexp]
526 trace add variable findtype write find_change
527 .ctop.top.bar.findtype configure -font $uifont
528 .ctop.top.bar.findtype.menu configure -font $uifont
529 set findloc "All fields"
530 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
531 Comments Author Committer
532 trace add variable findloc write find_change
533 .ctop.top.bar.findloc configure -font $uifont
534 .ctop.top.bar.findloc.menu configure -font $uifont
535 pack .ctop.top.bar.findloc -side right
536 pack .ctop.top.bar.findtype -side right
538 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
539 -font $uifont
540 pack .ctop.top.lbar.flabel -side left -fill y
541 set gdttype "touching paths:"
542 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
543 "adding/removing string:"]
544 trace add variable gdttype write hfiles_change
545 $gm conf -font $uifont
546 .ctop.top.lbar.gdttype conf -font $uifont
547 pack .ctop.top.lbar.gdttype -side left -fill y
548 entry .ctop.top.lbar.fent -width 25 -font $textfont \
549 -textvariable highlight_files
550 trace add variable highlight_files write hfiles_change
551 lappend entries .ctop.top.lbar.fent
552 pack .ctop.top.lbar.fent -side left -fill x -expand 1
553 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
554 pack .ctop.top.lbar.vlabel -side left -fill y
555 global viewhlmenu selectedhlview
556 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
557 $viewhlmenu entryconf None -command delvhighlight
558 $viewhlmenu conf -font $uifont
559 .ctop.top.lbar.vhl conf -font $uifont
560 pack .ctop.top.lbar.vhl -side left -fill y
561 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
562 pack .ctop.top.lbar.rlabel -side left -fill y
563 global highlight_related
564 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
565 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
566 $m conf -font $uifont
567 .ctop.top.lbar.relm conf -font $uifont
568 trace add variable highlight_related write vrel_change
569 pack .ctop.top.lbar.relm -side left -fill y
571 panedwindow .ctop.cdet -orient horizontal
572 .ctop add .ctop.cdet
573 frame .ctop.cdet.left
574 frame .ctop.cdet.left.bot
575 pack .ctop.cdet.left.bot -side bottom -fill x
576 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
577 -font $uifont
578 pack .ctop.cdet.left.bot.search -side left -padx 5
579 set sstring .ctop.cdet.left.bot.sstring
580 entry $sstring -width 20 -font $textfont -textvariable searchstring
581 lappend entries $sstring
582 trace add variable searchstring write incrsearch
583 pack $sstring -side left -expand 1 -fill x
584 set ctext .ctop.cdet.left.ctext
585 text $ctext -background $bgcolor -foreground $fgcolor \
586 -state disabled -font $textfont \
587 -width $geometry(ctextw) -height $geometry(ctexth) \
588 -yscrollcommand scrolltext -wrap none
589 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
590 pack .ctop.cdet.left.sb -side right -fill y
591 pack $ctext -side left -fill both -expand 1
592 .ctop.cdet add .ctop.cdet.left
593 lappend bglist $ctext
594 lappend fglist $ctext
596 $ctext tag conf comment -wrap $wrapcomment
597 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
598 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
599 $ctext tag conf d0 -fore [lindex $diffcolors 0]
600 $ctext tag conf d1 -fore [lindex $diffcolors 1]
601 $ctext tag conf m0 -fore red
602 $ctext tag conf m1 -fore blue
603 $ctext tag conf m2 -fore green
604 $ctext tag conf m3 -fore purple
605 $ctext tag conf m4 -fore brown
606 $ctext tag conf m5 -fore "#009090"
607 $ctext tag conf m6 -fore magenta
608 $ctext tag conf m7 -fore "#808000"
609 $ctext tag conf m8 -fore "#009000"
610 $ctext tag conf m9 -fore "#ff0080"
611 $ctext tag conf m10 -fore cyan
612 $ctext tag conf m11 -fore "#b07070"
613 $ctext tag conf m12 -fore "#70b0f0"
614 $ctext tag conf m13 -fore "#70f0b0"
615 $ctext tag conf m14 -fore "#f0b070"
616 $ctext tag conf m15 -fore "#ff70b0"
617 $ctext tag conf mmax -fore darkgrey
618 set mergemax 16
619 $ctext tag conf mresult -font [concat $textfont bold]
620 $ctext tag conf msep -font [concat $textfont bold]
621 $ctext tag conf found -back yellow
623 frame .ctop.cdet.right
624 frame .ctop.cdet.right.mode
625 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
626 -command reselectline -variable cmitmode -value "patch"
627 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
628 -command reselectline -variable cmitmode -value "tree"
629 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
630 pack .ctop.cdet.right.mode -side top -fill x
631 set cflist .ctop.cdet.right.cfiles
632 set indent [font measure $mainfont "nn"]
633 text $cflist -width $geometry(cflistw) \
634 -background $bgcolor -foreground $fgcolor \
635 -font $mainfont \
636 -tabs [list $indent [expr {2 * $indent}]] \
637 -yscrollcommand ".ctop.cdet.right.sb set" \
638 -cursor [. cget -cursor] \
639 -spacing1 1 -spacing3 1
640 lappend bglist $cflist
641 lappend fglist $cflist
642 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
643 pack .ctop.cdet.right.sb -side right -fill y
644 pack $cflist -side left -fill both -expand 1
645 $cflist tag configure highlight \
646 -background [$cflist cget -selectbackground]
647 $cflist tag configure bold -font [concat $mainfont bold]
648 .ctop.cdet add .ctop.cdet.right
649 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
651 pack .ctop -side top -fill both -expand 1
653 bindall <1> {selcanvline %W %x %y}
654 #bindall <B1-Motion> {selcanvline %W %x %y}
655 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
656 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
657 bindall <2> "canvscan mark %W %x %y"
658 bindall <B2-Motion> "canvscan dragto %W %x %y"
659 bindkey <Home> selfirstline
660 bindkey <End> sellastline
661 bind . <Key-Up> "selnextline -1"
662 bind . <Key-Down> "selnextline 1"
663 bind . <Shift-Key-Up> "next_highlight -1"
664 bind . <Shift-Key-Down> "next_highlight 1"
665 bindkey <Key-Right> "goforw"
666 bindkey <Key-Left> "goback"
667 bind . <Key-Prior> "selnextpage -1"
668 bind . <Key-Next> "selnextpage 1"
669 bind . <Control-Home> "allcanvs yview moveto 0.0"
670 bind . <Control-End> "allcanvs yview moveto 1.0"
671 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
672 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
673 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
674 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
675 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
676 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
677 bindkey <Key-space> "$ctext yview scroll 1 pages"
678 bindkey p "selnextline -1"
679 bindkey n "selnextline 1"
680 bindkey z "goback"
681 bindkey x "goforw"
682 bindkey i "selnextline -1"
683 bindkey k "selnextline 1"
684 bindkey j "goback"
685 bindkey l "goforw"
686 bindkey b "$ctext yview scroll -1 pages"
687 bindkey d "$ctext yview scroll 18 units"
688 bindkey u "$ctext yview scroll -18 units"
689 bindkey / {findnext 1}
690 bindkey <Key-Return> {findnext 0}
691 bindkey ? findprev
692 bindkey f nextfile
693 bind . <Control-q> doquit
694 bind . <Control-f> dofind
695 bind . <Control-g> {findnext 0}
696 bind . <Control-r> dosearchback
697 bind . <Control-s> dosearch
698 bind . <Control-equal> {incrfont 1}
699 bind . <Control-KP_Add> {incrfont 1}
700 bind . <Control-minus> {incrfont -1}
701 bind . <Control-KP_Subtract> {incrfont -1}
702 bind . <Destroy> {savestuff %W}
703 bind . <Button-1> "click %W"
704 bind $fstring <Key-Return> dofind
705 bind $sha1entry <Key-Return> gotocommit
706 bind $sha1entry <<PasteSelection>> clearsha1
707 bind $cflist <1> {sel_flist %W %x %y; break}
708 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
709 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
711 set maincursor [. cget -cursor]
712 set textcursor [$ctext cget -cursor]
713 set curtextcursor $textcursor
715 set rowctxmenu .rowctxmenu
716 menu $rowctxmenu -tearoff 0
717 $rowctxmenu add command -label "Diff this -> selected" \
718 -command {diffvssel 0}
719 $rowctxmenu add command -label "Diff selected -> this" \
720 -command {diffvssel 1}
721 $rowctxmenu add command -label "Make patch" -command mkpatch
722 $rowctxmenu add command -label "Create tag" -command mktag
723 $rowctxmenu add command -label "Write commit to file" -command writecommit
724 $rowctxmenu add command -label "Create new branch" -command mkbranch
725 $rowctxmenu add command -label "Cherry-pick this commit" \
726 -command cherrypick
728 set headctxmenu .headctxmenu
729 menu $headctxmenu -tearoff 0
730 $headctxmenu add command -label "Check out this branch" \
731 -command cobranch
732 $headctxmenu add command -label "Remove this branch" \
733 -command rmbranch
736 # mouse-2 makes all windows scan vertically, but only the one
737 # the cursor is in scans horizontally
738 proc canvscan {op w x y} {
739 global canv canv2 canv3
740 foreach c [list $canv $canv2 $canv3] {
741 if {$c == $w} {
742 $c scan $op $x $y
743 } else {
744 $c scan $op 0 $y
749 proc scrollcanv {cscroll f0 f1} {
750 $cscroll set $f0 $f1
751 drawfrac $f0 $f1
752 flushhighlights
755 # when we make a key binding for the toplevel, make sure
756 # it doesn't get triggered when that key is pressed in the
757 # find string entry widget.
758 proc bindkey {ev script} {
759 global entries
760 bind . $ev $script
761 set escript [bind Entry $ev]
762 if {$escript == {}} {
763 set escript [bind Entry <Key>]
765 foreach e $entries {
766 bind $e $ev "$escript; break"
770 # set the focus back to the toplevel for any click outside
771 # the entry widgets
772 proc click {w} {
773 global entries
774 foreach e $entries {
775 if {$w == $e} return
777 focus .
780 proc savestuff {w} {
781 global canv canv2 canv3 ctext cflist mainfont textfont uifont
782 global stuffsaved findmergefiles maxgraphpct
783 global maxwidth showneartags
784 global viewname viewfiles viewargs viewperm nextviewnum
785 global cmitmode wrapcomment
786 global colors bgcolor fgcolor diffcolors
788 if {$stuffsaved} return
789 if {![winfo viewable .]} return
790 catch {
791 set f [open "~/.gitk-new" w]
792 puts $f [list set mainfont $mainfont]
793 puts $f [list set textfont $textfont]
794 puts $f [list set uifont $uifont]
795 puts $f [list set findmergefiles $findmergefiles]
796 puts $f [list set maxgraphpct $maxgraphpct]
797 puts $f [list set maxwidth $maxwidth]
798 puts $f [list set cmitmode $cmitmode]
799 puts $f [list set wrapcomment $wrapcomment]
800 puts $f [list set showneartags $showneartags]
801 puts $f [list set bgcolor $bgcolor]
802 puts $f [list set fgcolor $fgcolor]
803 puts $f [list set colors $colors]
804 puts $f [list set diffcolors $diffcolors]
805 puts $f "set geometry(width) [winfo width .ctop]"
806 puts $f "set geometry(height) [winfo height .ctop]"
807 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
808 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
809 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
810 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
811 set wid [expr {([winfo width $ctext] - 8) \
812 / [font measure $textfont "0"]}]
813 puts $f "set geometry(ctextw) $wid"
814 set wid [expr {([winfo width $cflist] - 11) \
815 / [font measure [$cflist cget -font] "0"]}]
816 puts $f "set geometry(cflistw) $wid"
817 puts -nonewline $f "set permviews {"
818 for {set v 0} {$v < $nextviewnum} {incr v} {
819 if {$viewperm($v)} {
820 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
823 puts $f "}"
824 close $f
825 file rename -force "~/.gitk-new" "~/.gitk"
827 set stuffsaved 1
830 proc resizeclistpanes {win w} {
831 global oldwidth
832 if {[info exists oldwidth($win)]} {
833 set s0 [$win sash coord 0]
834 set s1 [$win sash coord 1]
835 if {$w < 60} {
836 set sash0 [expr {int($w/2 - 2)}]
837 set sash1 [expr {int($w*5/6 - 2)}]
838 } else {
839 set factor [expr {1.0 * $w / $oldwidth($win)}]
840 set sash0 [expr {int($factor * [lindex $s0 0])}]
841 set sash1 [expr {int($factor * [lindex $s1 0])}]
842 if {$sash0 < 30} {
843 set sash0 30
845 if {$sash1 < $sash0 + 20} {
846 set sash1 [expr {$sash0 + 20}]
848 if {$sash1 > $w - 10} {
849 set sash1 [expr {$w - 10}]
850 if {$sash0 > $sash1 - 20} {
851 set sash0 [expr {$sash1 - 20}]
855 $win sash place 0 $sash0 [lindex $s0 1]
856 $win sash place 1 $sash1 [lindex $s1 1]
858 set oldwidth($win) $w
861 proc resizecdetpanes {win w} {
862 global oldwidth
863 if {[info exists oldwidth($win)]} {
864 set s0 [$win sash coord 0]
865 if {$w < 60} {
866 set sash0 [expr {int($w*3/4 - 2)}]
867 } else {
868 set factor [expr {1.0 * $w / $oldwidth($win)}]
869 set sash0 [expr {int($factor * [lindex $s0 0])}]
870 if {$sash0 < 45} {
871 set sash0 45
873 if {$sash0 > $w - 15} {
874 set sash0 [expr {$w - 15}]
877 $win sash place 0 $sash0 [lindex $s0 1]
879 set oldwidth($win) $w
882 proc allcanvs args {
883 global canv canv2 canv3
884 eval $canv $args
885 eval $canv2 $args
886 eval $canv3 $args
889 proc bindall {event action} {
890 global canv canv2 canv3
891 bind $canv $event $action
892 bind $canv2 $event $action
893 bind $canv3 $event $action
896 proc about {} {
897 set w .about
898 if {[winfo exists $w]} {
899 raise $w
900 return
902 toplevel $w
903 wm title $w "About gitk"
904 message $w.m -text {
905 Gitk - a commit viewer for git
907 Copyright © 2005-2006 Paul Mackerras
909 Use and redistribute under the terms of the GNU General Public License} \
910 -justify center -aspect 400
911 pack $w.m -side top -fill x -padx 20 -pady 20
912 button $w.ok -text Close -command "destroy $w"
913 pack $w.ok -side bottom
916 proc keys {} {
917 set w .keys
918 if {[winfo exists $w]} {
919 raise $w
920 return
922 toplevel $w
923 wm title $w "Gitk key bindings"
924 message $w.m -text {
925 Gitk key bindings:
927 <Ctrl-Q> Quit
928 <Home> Move to first commit
929 <End> Move to last commit
930 <Up>, p, i Move up one commit
931 <Down>, n, k Move down one commit
932 <Left>, z, j Go back in history list
933 <Right>, x, l Go forward in history list
934 <PageUp> Move up one page in commit list
935 <PageDown> Move down one page in commit list
936 <Ctrl-Home> Scroll to top of commit list
937 <Ctrl-End> Scroll to bottom of commit list
938 <Ctrl-Up> Scroll commit list up one line
939 <Ctrl-Down> Scroll commit list down one line
940 <Ctrl-PageUp> Scroll commit list up one page
941 <Ctrl-PageDown> Scroll commit list down one page
942 <Shift-Up> Move to previous highlighted line
943 <Shift-Down> Move to next highlighted line
944 <Delete>, b Scroll diff view up one page
945 <Backspace> Scroll diff view up one page
946 <Space> Scroll diff view down one page
947 u Scroll diff view up 18 lines
948 d Scroll diff view down 18 lines
949 <Ctrl-F> Find
950 <Ctrl-G> Move to next find hit
951 <Return> Move to next find hit
952 / Move to next find hit, or redo find
953 ? Move to previous find hit
954 f Scroll diff view to next file
955 <Ctrl-S> Search for next hit in diff view
956 <Ctrl-R> Search for previous hit in diff view
957 <Ctrl-KP+> Increase font size
958 <Ctrl-plus> Increase font size
959 <Ctrl-KP-> Decrease font size
960 <Ctrl-minus> Decrease font size
962 -justify left -bg white -border 2 -relief sunken
963 pack $w.m -side top -fill both
964 button $w.ok -text Close -command "destroy $w"
965 pack $w.ok -side bottom
968 # Procedures for manipulating the file list window at the
969 # bottom right of the overall window.
971 proc treeview {w l openlevs} {
972 global treecontents treediropen treeheight treeparent treeindex
974 set ix 0
975 set treeindex() 0
976 set lev 0
977 set prefix {}
978 set prefixend -1
979 set prefendstack {}
980 set htstack {}
981 set ht 0
982 set treecontents() {}
983 $w conf -state normal
984 foreach f $l {
985 while {[string range $f 0 $prefixend] ne $prefix} {
986 if {$lev <= $openlevs} {
987 $w mark set e:$treeindex($prefix) "end -1c"
988 $w mark gravity e:$treeindex($prefix) left
990 set treeheight($prefix) $ht
991 incr ht [lindex $htstack end]
992 set htstack [lreplace $htstack end end]
993 set prefixend [lindex $prefendstack end]
994 set prefendstack [lreplace $prefendstack end end]
995 set prefix [string range $prefix 0 $prefixend]
996 incr lev -1
998 set tail [string range $f [expr {$prefixend+1}] end]
999 while {[set slash [string first "/" $tail]] >= 0} {
1000 lappend htstack $ht
1001 set ht 0
1002 lappend prefendstack $prefixend
1003 incr prefixend [expr {$slash + 1}]
1004 set d [string range $tail 0 $slash]
1005 lappend treecontents($prefix) $d
1006 set oldprefix $prefix
1007 append prefix $d
1008 set treecontents($prefix) {}
1009 set treeindex($prefix) [incr ix]
1010 set treeparent($prefix) $oldprefix
1011 set tail [string range $tail [expr {$slash+1}] end]
1012 if {$lev <= $openlevs} {
1013 set ht 1
1014 set treediropen($prefix) [expr {$lev < $openlevs}]
1015 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1016 $w mark set d:$ix "end -1c"
1017 $w mark gravity d:$ix left
1018 set str "\n"
1019 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1020 $w insert end $str
1021 $w image create end -align center -image $bm -padx 1 \
1022 -name a:$ix
1023 $w insert end $d [highlight_tag $prefix]
1024 $w mark set s:$ix "end -1c"
1025 $w mark gravity s:$ix left
1027 incr lev
1029 if {$tail ne {}} {
1030 if {$lev <= $openlevs} {
1031 incr ht
1032 set str "\n"
1033 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1034 $w insert end $str
1035 $w insert end $tail [highlight_tag $f]
1037 lappend treecontents($prefix) $tail
1040 while {$htstack ne {}} {
1041 set treeheight($prefix) $ht
1042 incr ht [lindex $htstack end]
1043 set htstack [lreplace $htstack end end]
1045 $w conf -state disabled
1048 proc linetoelt {l} {
1049 global treeheight treecontents
1051 set y 2
1052 set prefix {}
1053 while {1} {
1054 foreach e $treecontents($prefix) {
1055 if {$y == $l} {
1056 return "$prefix$e"
1058 set n 1
1059 if {[string index $e end] eq "/"} {
1060 set n $treeheight($prefix$e)
1061 if {$y + $n > $l} {
1062 append prefix $e
1063 incr y
1064 break
1067 incr y $n
1072 proc highlight_tree {y prefix} {
1073 global treeheight treecontents cflist
1075 foreach e $treecontents($prefix) {
1076 set path $prefix$e
1077 if {[highlight_tag $path] ne {}} {
1078 $cflist tag add bold $y.0 "$y.0 lineend"
1080 incr y
1081 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1082 set y [highlight_tree $y $path]
1085 return $y
1088 proc treeclosedir {w dir} {
1089 global treediropen treeheight treeparent treeindex
1091 set ix $treeindex($dir)
1092 $w conf -state normal
1093 $w delete s:$ix e:$ix
1094 set treediropen($dir) 0
1095 $w image configure a:$ix -image tri-rt
1096 $w conf -state disabled
1097 set n [expr {1 - $treeheight($dir)}]
1098 while {$dir ne {}} {
1099 incr treeheight($dir) $n
1100 set dir $treeparent($dir)
1104 proc treeopendir {w dir} {
1105 global treediropen treeheight treeparent treecontents treeindex
1107 set ix $treeindex($dir)
1108 $w conf -state normal
1109 $w image configure a:$ix -image tri-dn
1110 $w mark set e:$ix s:$ix
1111 $w mark gravity e:$ix right
1112 set lev 0
1113 set str "\n"
1114 set n [llength $treecontents($dir)]
1115 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1116 incr lev
1117 append str "\t"
1118 incr treeheight($x) $n
1120 foreach e $treecontents($dir) {
1121 set de $dir$e
1122 if {[string index $e end] eq "/"} {
1123 set iy $treeindex($de)
1124 $w mark set d:$iy e:$ix
1125 $w mark gravity d:$iy left
1126 $w insert e:$ix $str
1127 set treediropen($de) 0
1128 $w image create e:$ix -align center -image tri-rt -padx 1 \
1129 -name a:$iy
1130 $w insert e:$ix $e [highlight_tag $de]
1131 $w mark set s:$iy e:$ix
1132 $w mark gravity s:$iy left
1133 set treeheight($de) 1
1134 } else {
1135 $w insert e:$ix $str
1136 $w insert e:$ix $e [highlight_tag $de]
1139 $w mark gravity e:$ix left
1140 $w conf -state disabled
1141 set treediropen($dir) 1
1142 set top [lindex [split [$w index @0,0] .] 0]
1143 set ht [$w cget -height]
1144 set l [lindex [split [$w index s:$ix] .] 0]
1145 if {$l < $top} {
1146 $w yview $l.0
1147 } elseif {$l + $n + 1 > $top + $ht} {
1148 set top [expr {$l + $n + 2 - $ht}]
1149 if {$l < $top} {
1150 set top $l
1152 $w yview $top.0
1156 proc treeclick {w x y} {
1157 global treediropen cmitmode ctext cflist cflist_top
1159 if {$cmitmode ne "tree"} return
1160 if {![info exists cflist_top]} return
1161 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1162 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1163 $cflist tag add highlight $l.0 "$l.0 lineend"
1164 set cflist_top $l
1165 if {$l == 1} {
1166 $ctext yview 1.0
1167 return
1169 set e [linetoelt $l]
1170 if {[string index $e end] ne "/"} {
1171 showfile $e
1172 } elseif {$treediropen($e)} {
1173 treeclosedir $w $e
1174 } else {
1175 treeopendir $w $e
1179 proc setfilelist {id} {
1180 global treefilelist cflist
1182 treeview $cflist $treefilelist($id) 0
1185 image create bitmap tri-rt -background black -foreground blue -data {
1186 #define tri-rt_width 13
1187 #define tri-rt_height 13
1188 static unsigned char tri-rt_bits[] = {
1189 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1190 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1191 0x00, 0x00};
1192 } -maskdata {
1193 #define tri-rt-mask_width 13
1194 #define tri-rt-mask_height 13
1195 static unsigned char tri-rt-mask_bits[] = {
1196 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1197 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1198 0x08, 0x00};
1200 image create bitmap tri-dn -background black -foreground blue -data {
1201 #define tri-dn_width 13
1202 #define tri-dn_height 13
1203 static unsigned char tri-dn_bits[] = {
1204 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1205 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1206 0x00, 0x00};
1207 } -maskdata {
1208 #define tri-dn-mask_width 13
1209 #define tri-dn-mask_height 13
1210 static unsigned char tri-dn-mask_bits[] = {
1211 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1212 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1213 0x00, 0x00};
1216 proc init_flist {first} {
1217 global cflist cflist_top selectedline difffilestart
1219 $cflist conf -state normal
1220 $cflist delete 0.0 end
1221 if {$first ne {}} {
1222 $cflist insert end $first
1223 set cflist_top 1
1224 $cflist tag add highlight 1.0 "1.0 lineend"
1225 } else {
1226 catch {unset cflist_top}
1228 $cflist conf -state disabled
1229 set difffilestart {}
1232 proc highlight_tag {f} {
1233 global highlight_paths
1235 foreach p $highlight_paths {
1236 if {[string match $p $f]} {
1237 return "bold"
1240 return {}
1243 proc highlight_filelist {} {
1244 global cmitmode cflist
1246 $cflist conf -state normal
1247 if {$cmitmode ne "tree"} {
1248 set end [lindex [split [$cflist index end] .] 0]
1249 for {set l 2} {$l < $end} {incr l} {
1250 set line [$cflist get $l.0 "$l.0 lineend"]
1251 if {[highlight_tag $line] ne {}} {
1252 $cflist tag add bold $l.0 "$l.0 lineend"
1255 } else {
1256 highlight_tree 2 {}
1258 $cflist conf -state disabled
1261 proc unhighlight_filelist {} {
1262 global cflist
1264 $cflist conf -state normal
1265 $cflist tag remove bold 1.0 end
1266 $cflist conf -state disabled
1269 proc add_flist {fl} {
1270 global cflist
1272 $cflist conf -state normal
1273 foreach f $fl {
1274 $cflist insert end "\n"
1275 $cflist insert end $f [highlight_tag $f]
1277 $cflist conf -state disabled
1280 proc sel_flist {w x y} {
1281 global ctext difffilestart cflist cflist_top cmitmode
1283 if {$cmitmode eq "tree"} return
1284 if {![info exists cflist_top]} return
1285 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1286 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1287 $cflist tag add highlight $l.0 "$l.0 lineend"
1288 set cflist_top $l
1289 if {$l == 1} {
1290 $ctext yview 1.0
1291 } else {
1292 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1296 # Functions for adding and removing shell-type quoting
1298 proc shellquote {str} {
1299 if {![string match "*\['\"\\ \t]*" $str]} {
1300 return $str
1302 if {![string match "*\['\"\\]*" $str]} {
1303 return "\"$str\""
1305 if {![string match "*'*" $str]} {
1306 return "'$str'"
1308 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1311 proc shellarglist {l} {
1312 set str {}
1313 foreach a $l {
1314 if {$str ne {}} {
1315 append str " "
1317 append str [shellquote $a]
1319 return $str
1322 proc shelldequote {str} {
1323 set ret {}
1324 set used -1
1325 while {1} {
1326 incr used
1327 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1328 append ret [string range $str $used end]
1329 set used [string length $str]
1330 break
1332 set first [lindex $first 0]
1333 set ch [string index $str $first]
1334 if {$first > $used} {
1335 append ret [string range $str $used [expr {$first - 1}]]
1336 set used $first
1338 if {$ch eq " " || $ch eq "\t"} break
1339 incr used
1340 if {$ch eq "'"} {
1341 set first [string first "'" $str $used]
1342 if {$first < 0} {
1343 error "unmatched single-quote"
1345 append ret [string range $str $used [expr {$first - 1}]]
1346 set used $first
1347 continue
1349 if {$ch eq "\\"} {
1350 if {$used >= [string length $str]} {
1351 error "trailing backslash"
1353 append ret [string index $str $used]
1354 continue
1356 # here ch == "\""
1357 while {1} {
1358 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1359 error "unmatched double-quote"
1361 set first [lindex $first 0]
1362 set ch [string index $str $first]
1363 if {$first > $used} {
1364 append ret [string range $str $used [expr {$first - 1}]]
1365 set used $first
1367 if {$ch eq "\""} break
1368 incr used
1369 append ret [string index $str $used]
1370 incr used
1373 return [list $used $ret]
1376 proc shellsplit {str} {
1377 set l {}
1378 while {1} {
1379 set str [string trimleft $str]
1380 if {$str eq {}} break
1381 set dq [shelldequote $str]
1382 set n [lindex $dq 0]
1383 set word [lindex $dq 1]
1384 set str [string range $str $n end]
1385 lappend l $word
1387 return $l
1390 # Code to implement multiple views
1392 proc newview {ishighlight} {
1393 global nextviewnum newviewname newviewperm uifont newishighlight
1394 global newviewargs revtreeargs
1396 set newishighlight $ishighlight
1397 set top .gitkview
1398 if {[winfo exists $top]} {
1399 raise $top
1400 return
1402 set newviewname($nextviewnum) "View $nextviewnum"
1403 set newviewperm($nextviewnum) 0
1404 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1405 vieweditor $top $nextviewnum "Gitk view definition"
1408 proc editview {} {
1409 global curview
1410 global viewname viewperm newviewname newviewperm
1411 global viewargs newviewargs
1413 set top .gitkvedit-$curview
1414 if {[winfo exists $top]} {
1415 raise $top
1416 return
1418 set newviewname($curview) $viewname($curview)
1419 set newviewperm($curview) $viewperm($curview)
1420 set newviewargs($curview) [shellarglist $viewargs($curview)]
1421 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1424 proc vieweditor {top n title} {
1425 global newviewname newviewperm viewfiles
1426 global uifont
1428 toplevel $top
1429 wm title $top $title
1430 label $top.nl -text "Name" -font $uifont
1431 entry $top.name -width 20 -textvariable newviewname($n)
1432 grid $top.nl $top.name -sticky w -pady 5
1433 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1434 grid $top.perm - -pady 5 -sticky w
1435 message $top.al -aspect 1000 -font $uifont \
1436 -text "Commits to include (arguments to git rev-list):"
1437 grid $top.al - -sticky w -pady 5
1438 entry $top.args -width 50 -textvariable newviewargs($n) \
1439 -background white
1440 grid $top.args - -sticky ew -padx 5
1441 message $top.l -aspect 1000 -font $uifont \
1442 -text "Enter files and directories to include, one per line:"
1443 grid $top.l - -sticky w
1444 text $top.t -width 40 -height 10 -background white
1445 if {[info exists viewfiles($n)]} {
1446 foreach f $viewfiles($n) {
1447 $top.t insert end $f
1448 $top.t insert end "\n"
1450 $top.t delete {end - 1c} end
1451 $top.t mark set insert 0.0
1453 grid $top.t - -sticky ew -padx 5
1454 frame $top.buts
1455 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1456 button $top.buts.can -text "Cancel" -command [list destroy $top]
1457 grid $top.buts.ok $top.buts.can
1458 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1459 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1460 grid $top.buts - -pady 10 -sticky ew
1461 focus $top.t
1464 proc doviewmenu {m first cmd op argv} {
1465 set nmenu [$m index end]
1466 for {set i $first} {$i <= $nmenu} {incr i} {
1467 if {[$m entrycget $i -command] eq $cmd} {
1468 eval $m $op $i $argv
1469 break
1474 proc allviewmenus {n op args} {
1475 global viewhlmenu
1477 doviewmenu .bar.view 5 [list showview $n] $op $args
1478 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1481 proc newviewok {top n} {
1482 global nextviewnum newviewperm newviewname newishighlight
1483 global viewname viewfiles viewperm selectedview curview
1484 global viewargs newviewargs viewhlmenu
1486 if {[catch {
1487 set newargs [shellsplit $newviewargs($n)]
1488 } err]} {
1489 error_popup "Error in commit selection arguments: $err"
1490 wm raise $top
1491 focus $top
1492 return
1494 set files {}
1495 foreach f [split [$top.t get 0.0 end] "\n"] {
1496 set ft [string trim $f]
1497 if {$ft ne {}} {
1498 lappend files $ft
1501 if {![info exists viewfiles($n)]} {
1502 # creating a new view
1503 incr nextviewnum
1504 set viewname($n) $newviewname($n)
1505 set viewperm($n) $newviewperm($n)
1506 set viewfiles($n) $files
1507 set viewargs($n) $newargs
1508 addviewmenu $n
1509 if {!$newishighlight} {
1510 after idle showview $n
1511 } else {
1512 after idle addvhighlight $n
1514 } else {
1515 # editing an existing view
1516 set viewperm($n) $newviewperm($n)
1517 if {$newviewname($n) ne $viewname($n)} {
1518 set viewname($n) $newviewname($n)
1519 doviewmenu .bar.view 5 [list showview $n] \
1520 entryconf [list -label $viewname($n)]
1521 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1522 entryconf [list -label $viewname($n) -value $viewname($n)]
1524 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1525 set viewfiles($n) $files
1526 set viewargs($n) $newargs
1527 if {$curview == $n} {
1528 after idle updatecommits
1532 catch {destroy $top}
1535 proc delview {} {
1536 global curview viewdata viewperm hlview selectedhlview
1538 if {$curview == 0} return
1539 if {[info exists hlview] && $hlview == $curview} {
1540 set selectedhlview None
1541 unset hlview
1543 allviewmenus $curview delete
1544 set viewdata($curview) {}
1545 set viewperm($curview) 0
1546 showview 0
1549 proc addviewmenu {n} {
1550 global viewname viewhlmenu
1552 .bar.view add radiobutton -label $viewname($n) \
1553 -command [list showview $n] -variable selectedview -value $n
1554 $viewhlmenu add radiobutton -label $viewname($n) \
1555 -command [list addvhighlight $n] -variable selectedhlview
1558 proc flatten {var} {
1559 global $var
1561 set ret {}
1562 foreach i [array names $var] {
1563 lappend ret $i [set $var\($i\)]
1565 return $ret
1568 proc unflatten {var l} {
1569 global $var
1571 catch {unset $var}
1572 foreach {i v} $l {
1573 set $var\($i\) $v
1577 proc showview {n} {
1578 global curview viewdata viewfiles
1579 global displayorder parentlist childlist rowidlist rowoffsets
1580 global colormap rowtextx commitrow nextcolor canvxmax
1581 global numcommits rowrangelist commitlisted idrowranges
1582 global selectedline currentid canv canvy0
1583 global matchinglines treediffs
1584 global pending_select phase
1585 global commitidx rowlaidout rowoptim linesegends
1586 global commfd nextupdate
1587 global selectedview
1588 global vparentlist vchildlist vdisporder vcmitlisted
1589 global hlview selectedhlview
1591 if {$n == $curview} return
1592 set selid {}
1593 if {[info exists selectedline]} {
1594 set selid $currentid
1595 set y [yc $selectedline]
1596 set ymax [lindex [$canv cget -scrollregion] 3]
1597 set span [$canv yview]
1598 set ytop [expr {[lindex $span 0] * $ymax}]
1599 set ybot [expr {[lindex $span 1] * $ymax}]
1600 if {$ytop < $y && $y < $ybot} {
1601 set yscreen [expr {$y - $ytop}]
1602 } else {
1603 set yscreen [expr {($ybot - $ytop) / 2}]
1606 unselectline
1607 normalline
1608 stopfindproc
1609 if {$curview >= 0} {
1610 set vparentlist($curview) $parentlist
1611 set vchildlist($curview) $childlist
1612 set vdisporder($curview) $displayorder
1613 set vcmitlisted($curview) $commitlisted
1614 if {$phase ne {}} {
1615 set viewdata($curview) \
1616 [list $phase $rowidlist $rowoffsets $rowrangelist \
1617 [flatten idrowranges] [flatten idinlist] \
1618 $rowlaidout $rowoptim $numcommits $linesegends]
1619 } elseif {![info exists viewdata($curview)]
1620 || [lindex $viewdata($curview) 0] ne {}} {
1621 set viewdata($curview) \
1622 [list {} $rowidlist $rowoffsets $rowrangelist]
1625 catch {unset matchinglines}
1626 catch {unset treediffs}
1627 clear_display
1628 if {[info exists hlview] && $hlview == $n} {
1629 unset hlview
1630 set selectedhlview None
1633 set curview $n
1634 set selectedview $n
1635 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1636 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1638 if {![info exists viewdata($n)]} {
1639 set pending_select $selid
1640 getcommits
1641 return
1644 set v $viewdata($n)
1645 set phase [lindex $v 0]
1646 set displayorder $vdisporder($n)
1647 set parentlist $vparentlist($n)
1648 set childlist $vchildlist($n)
1649 set commitlisted $vcmitlisted($n)
1650 set rowidlist [lindex $v 1]
1651 set rowoffsets [lindex $v 2]
1652 set rowrangelist [lindex $v 3]
1653 if {$phase eq {}} {
1654 set numcommits [llength $displayorder]
1655 catch {unset idrowranges}
1656 } else {
1657 unflatten idrowranges [lindex $v 4]
1658 unflatten idinlist [lindex $v 5]
1659 set rowlaidout [lindex $v 6]
1660 set rowoptim [lindex $v 7]
1661 set numcommits [lindex $v 8]
1662 set linesegends [lindex $v 9]
1665 catch {unset colormap}
1666 catch {unset rowtextx}
1667 set nextcolor 0
1668 set canvxmax [$canv cget -width]
1669 set curview $n
1670 set row 0
1671 setcanvscroll
1672 set yf 0
1673 set row 0
1674 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1675 set row $commitrow($n,$selid)
1676 # try to get the selected row in the same position on the screen
1677 set ymax [lindex [$canv cget -scrollregion] 3]
1678 set ytop [expr {[yc $row] - $yscreen}]
1679 if {$ytop < 0} {
1680 set ytop 0
1682 set yf [expr {$ytop * 1.0 / $ymax}]
1684 allcanvs yview moveto $yf
1685 drawvisible
1686 selectline $row 0
1687 if {$phase ne {}} {
1688 if {$phase eq "getcommits"} {
1689 show_status "Reading commits..."
1691 if {[info exists commfd($n)]} {
1692 layoutmore {}
1693 } else {
1694 finishcommits
1696 } elseif {$numcommits == 0} {
1697 show_status "No commits selected"
1701 # Stuff relating to the highlighting facility
1703 proc ishighlighted {row} {
1704 global vhighlights fhighlights nhighlights rhighlights
1706 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1707 return $nhighlights($row)
1709 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1710 return $vhighlights($row)
1712 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1713 return $fhighlights($row)
1715 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1716 return $rhighlights($row)
1718 return 0
1721 proc bolden {row font} {
1722 global canv linehtag selectedline boldrows
1724 lappend boldrows $row
1725 $canv itemconf $linehtag($row) -font $font
1726 if {[info exists selectedline] && $row == $selectedline} {
1727 $canv delete secsel
1728 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1729 -outline {{}} -tags secsel \
1730 -fill [$canv cget -selectbackground]]
1731 $canv lower $t
1735 proc bolden_name {row font} {
1736 global canv2 linentag selectedline boldnamerows
1738 lappend boldnamerows $row
1739 $canv2 itemconf $linentag($row) -font $font
1740 if {[info exists selectedline] && $row == $selectedline} {
1741 $canv2 delete secsel
1742 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1743 -outline {{}} -tags secsel \
1744 -fill [$canv2 cget -selectbackground]]
1745 $canv2 lower $t
1749 proc unbolden {} {
1750 global mainfont boldrows
1752 set stillbold {}
1753 foreach row $boldrows {
1754 if {![ishighlighted $row]} {
1755 bolden $row $mainfont
1756 } else {
1757 lappend stillbold $row
1760 set boldrows $stillbold
1763 proc addvhighlight {n} {
1764 global hlview curview viewdata vhl_done vhighlights commitidx
1766 if {[info exists hlview]} {
1767 delvhighlight
1769 set hlview $n
1770 if {$n != $curview && ![info exists viewdata($n)]} {
1771 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1772 set vparentlist($n) {}
1773 set vchildlist($n) {}
1774 set vdisporder($n) {}
1775 set vcmitlisted($n) {}
1776 start_rev_list $n
1778 set vhl_done $commitidx($hlview)
1779 if {$vhl_done > 0} {
1780 drawvisible
1784 proc delvhighlight {} {
1785 global hlview vhighlights
1787 if {![info exists hlview]} return
1788 unset hlview
1789 catch {unset vhighlights}
1790 unbolden
1793 proc vhighlightmore {} {
1794 global hlview vhl_done commitidx vhighlights
1795 global displayorder vdisporder curview mainfont
1797 set font [concat $mainfont bold]
1798 set max $commitidx($hlview)
1799 if {$hlview == $curview} {
1800 set disp $displayorder
1801 } else {
1802 set disp $vdisporder($hlview)
1804 set vr [visiblerows]
1805 set r0 [lindex $vr 0]
1806 set r1 [lindex $vr 1]
1807 for {set i $vhl_done} {$i < $max} {incr i} {
1808 set id [lindex $disp $i]
1809 if {[info exists commitrow($curview,$id)]} {
1810 set row $commitrow($curview,$id)
1811 if {$r0 <= $row && $row <= $r1} {
1812 if {![highlighted $row]} {
1813 bolden $row $font
1815 set vhighlights($row) 1
1819 set vhl_done $max
1822 proc askvhighlight {row id} {
1823 global hlview vhighlights commitrow iddrawn mainfont
1825 if {[info exists commitrow($hlview,$id)]} {
1826 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1827 bolden $row [concat $mainfont bold]
1829 set vhighlights($row) 1
1830 } else {
1831 set vhighlights($row) 0
1835 proc hfiles_change {name ix op} {
1836 global highlight_files filehighlight fhighlights fh_serial
1837 global mainfont highlight_paths
1839 if {[info exists filehighlight]} {
1840 # delete previous highlights
1841 catch {close $filehighlight}
1842 unset filehighlight
1843 catch {unset fhighlights}
1844 unbolden
1845 unhighlight_filelist
1847 set highlight_paths {}
1848 after cancel do_file_hl $fh_serial
1849 incr fh_serial
1850 if {$highlight_files ne {}} {
1851 after 300 do_file_hl $fh_serial
1855 proc makepatterns {l} {
1856 set ret {}
1857 foreach e $l {
1858 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1859 if {[string index $ee end] eq "/"} {
1860 lappend ret "$ee*"
1861 } else {
1862 lappend ret $ee
1863 lappend ret "$ee/*"
1866 return $ret
1869 proc do_file_hl {serial} {
1870 global highlight_files filehighlight highlight_paths gdttype fhl_list
1872 if {$gdttype eq "touching paths:"} {
1873 if {[catch {set paths [shellsplit $highlight_files]}]} return
1874 set highlight_paths [makepatterns $paths]
1875 highlight_filelist
1876 set gdtargs [concat -- $paths]
1877 } else {
1878 set gdtargs [list "-S$highlight_files"]
1880 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1881 set filehighlight [open $cmd r+]
1882 fconfigure $filehighlight -blocking 0
1883 fileevent $filehighlight readable readfhighlight
1884 set fhl_list {}
1885 drawvisible
1886 flushhighlights
1889 proc flushhighlights {} {
1890 global filehighlight fhl_list
1892 if {[info exists filehighlight]} {
1893 lappend fhl_list {}
1894 puts $filehighlight ""
1895 flush $filehighlight
1899 proc askfilehighlight {row id} {
1900 global filehighlight fhighlights fhl_list
1902 lappend fhl_list $id
1903 set fhighlights($row) -1
1904 puts $filehighlight $id
1907 proc readfhighlight {} {
1908 global filehighlight fhighlights commitrow curview mainfont iddrawn
1909 global fhl_list
1911 while {[gets $filehighlight line] >= 0} {
1912 set line [string trim $line]
1913 set i [lsearch -exact $fhl_list $line]
1914 if {$i < 0} continue
1915 for {set j 0} {$j < $i} {incr j} {
1916 set id [lindex $fhl_list $j]
1917 if {[info exists commitrow($curview,$id)]} {
1918 set fhighlights($commitrow($curview,$id)) 0
1921 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1922 if {$line eq {}} continue
1923 if {![info exists commitrow($curview,$line)]} continue
1924 set row $commitrow($curview,$line)
1925 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1926 bolden $row [concat $mainfont bold]
1928 set fhighlights($row) 1
1930 if {[eof $filehighlight]} {
1931 # strange...
1932 puts "oops, git-diff-tree died"
1933 catch {close $filehighlight}
1934 unset filehighlight
1936 next_hlcont
1939 proc find_change {name ix op} {
1940 global nhighlights mainfont boldnamerows
1941 global findstring findpattern findtype
1943 # delete previous highlights, if any
1944 foreach row $boldnamerows {
1945 bolden_name $row $mainfont
1947 set boldnamerows {}
1948 catch {unset nhighlights}
1949 unbolden
1950 if {$findtype ne "Regexp"} {
1951 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1952 $findstring]
1953 set findpattern "*$e*"
1955 drawvisible
1958 proc askfindhighlight {row id} {
1959 global nhighlights commitinfo iddrawn mainfont
1960 global findstring findtype findloc findpattern
1962 if {![info exists commitinfo($id)]} {
1963 getcommit $id
1965 set info $commitinfo($id)
1966 set isbold 0
1967 set fldtypes {Headline Author Date Committer CDate Comments}
1968 foreach f $info ty $fldtypes {
1969 if {$findloc ne "All fields" && $findloc ne $ty} {
1970 continue
1972 if {$findtype eq "Regexp"} {
1973 set doesmatch [regexp $findstring $f]
1974 } elseif {$findtype eq "IgnCase"} {
1975 set doesmatch [string match -nocase $findpattern $f]
1976 } else {
1977 set doesmatch [string match $findpattern $f]
1979 if {$doesmatch} {
1980 if {$ty eq "Author"} {
1981 set isbold 2
1982 } else {
1983 set isbold 1
1987 if {[info exists iddrawn($id)]} {
1988 if {$isbold && ![ishighlighted $row]} {
1989 bolden $row [concat $mainfont bold]
1991 if {$isbold >= 2} {
1992 bolden_name $row [concat $mainfont bold]
1995 set nhighlights($row) $isbold
1998 proc vrel_change {name ix op} {
1999 global highlight_related
2001 rhighlight_none
2002 if {$highlight_related ne "None"} {
2003 after idle drawvisible
2007 # prepare for testing whether commits are descendents or ancestors of a
2008 proc rhighlight_sel {a} {
2009 global descendent desc_todo ancestor anc_todo
2010 global highlight_related rhighlights
2012 catch {unset descendent}
2013 set desc_todo [list $a]
2014 catch {unset ancestor}
2015 set anc_todo [list $a]
2016 if {$highlight_related ne "None"} {
2017 rhighlight_none
2018 after idle drawvisible
2022 proc rhighlight_none {} {
2023 global rhighlights
2025 catch {unset rhighlights}
2026 unbolden
2029 proc is_descendent {a} {
2030 global curview children commitrow descendent desc_todo
2032 set v $curview
2033 set la $commitrow($v,$a)
2034 set todo $desc_todo
2035 set leftover {}
2036 set done 0
2037 for {set i 0} {$i < [llength $todo]} {incr i} {
2038 set do [lindex $todo $i]
2039 if {$commitrow($v,$do) < $la} {
2040 lappend leftover $do
2041 continue
2043 foreach nk $children($v,$do) {
2044 if {![info exists descendent($nk)]} {
2045 set descendent($nk) 1
2046 lappend todo $nk
2047 if {$nk eq $a} {
2048 set done 1
2052 if {$done} {
2053 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2054 return
2057 set descendent($a) 0
2058 set desc_todo $leftover
2061 proc is_ancestor {a} {
2062 global curview parentlist commitrow ancestor anc_todo
2064 set v $curview
2065 set la $commitrow($v,$a)
2066 set todo $anc_todo
2067 set leftover {}
2068 set done 0
2069 for {set i 0} {$i < [llength $todo]} {incr i} {
2070 set do [lindex $todo $i]
2071 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2072 lappend leftover $do
2073 continue
2075 foreach np [lindex $parentlist $commitrow($v,$do)] {
2076 if {![info exists ancestor($np)]} {
2077 set ancestor($np) 1
2078 lappend todo $np
2079 if {$np eq $a} {
2080 set done 1
2084 if {$done} {
2085 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2086 return
2089 set ancestor($a) 0
2090 set anc_todo $leftover
2093 proc askrelhighlight {row id} {
2094 global descendent highlight_related iddrawn mainfont rhighlights
2095 global selectedline ancestor
2097 if {![info exists selectedline]} return
2098 set isbold 0
2099 if {$highlight_related eq "Descendent" ||
2100 $highlight_related eq "Not descendent"} {
2101 if {![info exists descendent($id)]} {
2102 is_descendent $id
2104 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2105 set isbold 1
2107 } elseif {$highlight_related eq "Ancestor" ||
2108 $highlight_related eq "Not ancestor"} {
2109 if {![info exists ancestor($id)]} {
2110 is_ancestor $id
2112 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2113 set isbold 1
2116 if {[info exists iddrawn($id)]} {
2117 if {$isbold && ![ishighlighted $row]} {
2118 bolden $row [concat $mainfont bold]
2121 set rhighlights($row) $isbold
2124 proc next_hlcont {} {
2125 global fhl_row fhl_dirn displayorder numcommits
2126 global vhighlights fhighlights nhighlights rhighlights
2127 global hlview filehighlight findstring highlight_related
2129 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2130 set row $fhl_row
2131 while {1} {
2132 if {$row < 0 || $row >= $numcommits} {
2133 bell
2134 set fhl_dirn 0
2135 return
2137 set id [lindex $displayorder $row]
2138 if {[info exists hlview]} {
2139 if {![info exists vhighlights($row)]} {
2140 askvhighlight $row $id
2142 if {$vhighlights($row) > 0} break
2144 if {$findstring ne {}} {
2145 if {![info exists nhighlights($row)]} {
2146 askfindhighlight $row $id
2148 if {$nhighlights($row) > 0} break
2150 if {$highlight_related ne "None"} {
2151 if {![info exists rhighlights($row)]} {
2152 askrelhighlight $row $id
2154 if {$rhighlights($row) > 0} break
2156 if {[info exists filehighlight]} {
2157 if {![info exists fhighlights($row)]} {
2158 # ask for a few more while we're at it...
2159 set r $row
2160 for {set n 0} {$n < 100} {incr n} {
2161 if {![info exists fhighlights($r)]} {
2162 askfilehighlight $r [lindex $displayorder $r]
2164 incr r $fhl_dirn
2165 if {$r < 0 || $r >= $numcommits} break
2167 flushhighlights
2169 if {$fhighlights($row) < 0} {
2170 set fhl_row $row
2171 return
2173 if {$fhighlights($row) > 0} break
2175 incr row $fhl_dirn
2177 set fhl_dirn 0
2178 selectline $row 1
2181 proc next_highlight {dirn} {
2182 global selectedline fhl_row fhl_dirn
2183 global hlview filehighlight findstring highlight_related
2185 if {![info exists selectedline]} return
2186 if {!([info exists hlview] || $findstring ne {} ||
2187 $highlight_related ne "None" || [info exists filehighlight])} return
2188 set fhl_row [expr {$selectedline + $dirn}]
2189 set fhl_dirn $dirn
2190 next_hlcont
2193 proc cancel_next_highlight {} {
2194 global fhl_dirn
2196 set fhl_dirn 0
2199 # Graph layout functions
2201 proc shortids {ids} {
2202 set res {}
2203 foreach id $ids {
2204 if {[llength $id] > 1} {
2205 lappend res [shortids $id]
2206 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2207 lappend res [string range $id 0 7]
2208 } else {
2209 lappend res $id
2212 return $res
2215 proc incrange {l x o} {
2216 set n [llength $l]
2217 while {$x < $n} {
2218 set e [lindex $l $x]
2219 if {$e ne {}} {
2220 lset l $x [expr {$e + $o}]
2222 incr x
2224 return $l
2227 proc ntimes {n o} {
2228 set ret {}
2229 for {} {$n > 0} {incr n -1} {
2230 lappend ret $o
2232 return $ret
2235 proc usedinrange {id l1 l2} {
2236 global children commitrow childlist curview
2238 if {[info exists commitrow($curview,$id)]} {
2239 set r $commitrow($curview,$id)
2240 if {$l1 <= $r && $r <= $l2} {
2241 return [expr {$r - $l1 + 1}]
2243 set kids [lindex $childlist $r]
2244 } else {
2245 set kids $children($curview,$id)
2247 foreach c $kids {
2248 set r $commitrow($curview,$c)
2249 if {$l1 <= $r && $r <= $l2} {
2250 return [expr {$r - $l1 + 1}]
2253 return 0
2256 proc sanity {row {full 0}} {
2257 global rowidlist rowoffsets
2259 set col -1
2260 set ids [lindex $rowidlist $row]
2261 foreach id $ids {
2262 incr col
2263 if {$id eq {}} continue
2264 if {$col < [llength $ids] - 1 &&
2265 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2266 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2268 set o [lindex $rowoffsets $row $col]
2269 set y $row
2270 set x $col
2271 while {$o ne {}} {
2272 incr y -1
2273 incr x $o
2274 if {[lindex $rowidlist $y $x] != $id} {
2275 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2276 puts " id=[shortids $id] check started at row $row"
2277 for {set i $row} {$i >= $y} {incr i -1} {
2278 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2280 break
2282 if {!$full} break
2283 set o [lindex $rowoffsets $y $x]
2288 proc makeuparrow {oid x y z} {
2289 global rowidlist rowoffsets uparrowlen idrowranges
2291 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2292 incr y -1
2293 incr x $z
2294 set off0 [lindex $rowoffsets $y]
2295 for {set x0 $x} {1} {incr x0} {
2296 if {$x0 >= [llength $off0]} {
2297 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2298 break
2300 set z [lindex $off0 $x0]
2301 if {$z ne {}} {
2302 incr x0 $z
2303 break
2306 set z [expr {$x0 - $x}]
2307 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2308 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2310 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2311 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2312 lappend idrowranges($oid) $y
2315 proc initlayout {} {
2316 global rowidlist rowoffsets displayorder commitlisted
2317 global rowlaidout rowoptim
2318 global idinlist rowchk rowrangelist idrowranges
2319 global numcommits canvxmax canv
2320 global nextcolor
2321 global parentlist childlist children
2322 global colormap rowtextx
2323 global linesegends
2325 set numcommits 0
2326 set displayorder {}
2327 set commitlisted {}
2328 set parentlist {}
2329 set childlist {}
2330 set rowrangelist {}
2331 set nextcolor 0
2332 set rowidlist {{}}
2333 set rowoffsets {{}}
2334 catch {unset idinlist}
2335 catch {unset rowchk}
2336 set rowlaidout 0
2337 set rowoptim 0
2338 set canvxmax [$canv cget -width]
2339 catch {unset colormap}
2340 catch {unset rowtextx}
2341 catch {unset idrowranges}
2342 set linesegends {}
2345 proc setcanvscroll {} {
2346 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2348 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2349 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2350 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2351 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2354 proc visiblerows {} {
2355 global canv numcommits linespc
2357 set ymax [lindex [$canv cget -scrollregion] 3]
2358 if {$ymax eq {} || $ymax == 0} return
2359 set f [$canv yview]
2360 set y0 [expr {int([lindex $f 0] * $ymax)}]
2361 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2362 if {$r0 < 0} {
2363 set r0 0
2365 set y1 [expr {int([lindex $f 1] * $ymax)}]
2366 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2367 if {$r1 >= $numcommits} {
2368 set r1 [expr {$numcommits - 1}]
2370 return [list $r0 $r1]
2373 proc layoutmore {tmax} {
2374 global rowlaidout rowoptim commitidx numcommits optim_delay
2375 global uparrowlen curview
2377 while {1} {
2378 if {$rowoptim - $optim_delay > $numcommits} {
2379 showstuff [expr {$rowoptim - $optim_delay}]
2380 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2381 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2382 if {$nr > 100} {
2383 set nr 100
2385 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2386 incr rowoptim $nr
2387 } elseif {$commitidx($curview) > $rowlaidout} {
2388 set nr [expr {$commitidx($curview) - $rowlaidout}]
2389 # may need to increase this threshold if uparrowlen or
2390 # mingaplen are increased...
2391 if {$nr > 150} {
2392 set nr 150
2394 set row $rowlaidout
2395 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2396 if {$rowlaidout == $row} {
2397 return 0
2399 } else {
2400 return 0
2402 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2403 return 1
2408 proc showstuff {canshow} {
2409 global numcommits commitrow pending_select selectedline
2410 global linesegends idrowranges idrangedrawn curview
2412 if {$numcommits == 0} {
2413 global phase
2414 set phase "incrdraw"
2415 allcanvs delete all
2417 set row $numcommits
2418 set numcommits $canshow
2419 setcanvscroll
2420 set rows [visiblerows]
2421 set r0 [lindex $rows 0]
2422 set r1 [lindex $rows 1]
2423 set selrow -1
2424 for {set r $row} {$r < $canshow} {incr r} {
2425 foreach id [lindex $linesegends [expr {$r+1}]] {
2426 set i -1
2427 foreach {s e} [rowranges $id] {
2428 incr i
2429 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2430 && ![info exists idrangedrawn($id,$i)]} {
2431 drawlineseg $id $i
2432 set idrangedrawn($id,$i) 1
2437 if {$canshow > $r1} {
2438 set canshow $r1
2440 while {$row < $canshow} {
2441 drawcmitrow $row
2442 incr row
2444 if {[info exists pending_select] &&
2445 [info exists commitrow($curview,$pending_select)] &&
2446 $commitrow($curview,$pending_select) < $numcommits} {
2447 selectline $commitrow($curview,$pending_select) 1
2449 if {![info exists selectedline] && ![info exists pending_select]} {
2450 selectline 0 1
2454 proc layoutrows {row endrow last} {
2455 global rowidlist rowoffsets displayorder
2456 global uparrowlen downarrowlen maxwidth mingaplen
2457 global childlist parentlist
2458 global idrowranges linesegends
2459 global commitidx curview
2460 global idinlist rowchk rowrangelist
2462 set idlist [lindex $rowidlist $row]
2463 set offs [lindex $rowoffsets $row]
2464 while {$row < $endrow} {
2465 set id [lindex $displayorder $row]
2466 set oldolds {}
2467 set newolds {}
2468 foreach p [lindex $parentlist $row] {
2469 if {![info exists idinlist($p)]} {
2470 lappend newolds $p
2471 } elseif {!$idinlist($p)} {
2472 lappend oldolds $p
2475 set lse {}
2476 set nev [expr {[llength $idlist] + [llength $newolds]
2477 + [llength $oldolds] - $maxwidth + 1}]
2478 if {$nev > 0} {
2479 if {!$last &&
2480 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2481 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2482 set i [lindex $idlist $x]
2483 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2484 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2485 [expr {$row + $uparrowlen + $mingaplen}]]
2486 if {$r == 0} {
2487 set idlist [lreplace $idlist $x $x]
2488 set offs [lreplace $offs $x $x]
2489 set offs [incrange $offs $x 1]
2490 set idinlist($i) 0
2491 set rm1 [expr {$row - 1}]
2492 lappend lse $i
2493 lappend idrowranges($i) $rm1
2494 if {[incr nev -1] <= 0} break
2495 continue
2497 set rowchk($id) [expr {$row + $r}]
2500 lset rowidlist $row $idlist
2501 lset rowoffsets $row $offs
2503 lappend linesegends $lse
2504 set col [lsearch -exact $idlist $id]
2505 if {$col < 0} {
2506 set col [llength $idlist]
2507 lappend idlist $id
2508 lset rowidlist $row $idlist
2509 set z {}
2510 if {[lindex $childlist $row] ne {}} {
2511 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2512 unset idinlist($id)
2514 lappend offs $z
2515 lset rowoffsets $row $offs
2516 if {$z ne {}} {
2517 makeuparrow $id $col $row $z
2519 } else {
2520 unset idinlist($id)
2522 set ranges {}
2523 if {[info exists idrowranges($id)]} {
2524 set ranges $idrowranges($id)
2525 lappend ranges $row
2526 unset idrowranges($id)
2528 lappend rowrangelist $ranges
2529 incr row
2530 set offs [ntimes [llength $idlist] 0]
2531 set l [llength $newolds]
2532 set idlist [eval lreplace \$idlist $col $col $newolds]
2533 set o 0
2534 if {$l != 1} {
2535 set offs [lrange $offs 0 [expr {$col - 1}]]
2536 foreach x $newolds {
2537 lappend offs {}
2538 incr o -1
2540 incr o
2541 set tmp [expr {[llength $idlist] - [llength $offs]}]
2542 if {$tmp > 0} {
2543 set offs [concat $offs [ntimes $tmp $o]]
2545 } else {
2546 lset offs $col {}
2548 foreach i $newolds {
2549 set idinlist($i) 1
2550 set idrowranges($i) $row
2552 incr col $l
2553 foreach oid $oldolds {
2554 set idinlist($oid) 1
2555 set idlist [linsert $idlist $col $oid]
2556 set offs [linsert $offs $col $o]
2557 makeuparrow $oid $col $row $o
2558 incr col
2560 lappend rowidlist $idlist
2561 lappend rowoffsets $offs
2563 return $row
2566 proc addextraid {id row} {
2567 global displayorder commitrow commitinfo
2568 global commitidx commitlisted
2569 global parentlist childlist children curview
2571 incr commitidx($curview)
2572 lappend displayorder $id
2573 lappend commitlisted 0
2574 lappend parentlist {}
2575 set commitrow($curview,$id) $row
2576 readcommit $id
2577 if {![info exists commitinfo($id)]} {
2578 set commitinfo($id) {"No commit information available"}
2580 if {![info exists children($curview,$id)]} {
2581 set children($curview,$id) {}
2583 lappend childlist $children($curview,$id)
2586 proc layouttail {} {
2587 global rowidlist rowoffsets idinlist commitidx curview
2588 global idrowranges rowrangelist
2590 set row $commitidx($curview)
2591 set idlist [lindex $rowidlist $row]
2592 while {$idlist ne {}} {
2593 set col [expr {[llength $idlist] - 1}]
2594 set id [lindex $idlist $col]
2595 addextraid $id $row
2596 unset idinlist($id)
2597 lappend idrowranges($id) $row
2598 lappend rowrangelist $idrowranges($id)
2599 unset idrowranges($id)
2600 incr row
2601 set offs [ntimes $col 0]
2602 set idlist [lreplace $idlist $col $col]
2603 lappend rowidlist $idlist
2604 lappend rowoffsets $offs
2607 foreach id [array names idinlist] {
2608 addextraid $id $row
2609 lset rowidlist $row [list $id]
2610 lset rowoffsets $row 0
2611 makeuparrow $id 0 $row 0
2612 lappend idrowranges($id) $row
2613 lappend rowrangelist $idrowranges($id)
2614 unset idrowranges($id)
2615 incr row
2616 lappend rowidlist {}
2617 lappend rowoffsets {}
2621 proc insert_pad {row col npad} {
2622 global rowidlist rowoffsets
2624 set pad [ntimes $npad {}]
2625 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2626 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2627 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2630 proc optimize_rows {row col endrow} {
2631 global rowidlist rowoffsets idrowranges displayorder
2633 for {} {$row < $endrow} {incr row} {
2634 set idlist [lindex $rowidlist $row]
2635 set offs [lindex $rowoffsets $row]
2636 set haspad 0
2637 for {} {$col < [llength $offs]} {incr col} {
2638 if {[lindex $idlist $col] eq {}} {
2639 set haspad 1
2640 continue
2642 set z [lindex $offs $col]
2643 if {$z eq {}} continue
2644 set isarrow 0
2645 set x0 [expr {$col + $z}]
2646 set y0 [expr {$row - 1}]
2647 set z0 [lindex $rowoffsets $y0 $x0]
2648 if {$z0 eq {}} {
2649 set id [lindex $idlist $col]
2650 set ranges [rowranges $id]
2651 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2652 set isarrow 1
2655 if {$z < -1 || ($z < 0 && $isarrow)} {
2656 set npad [expr {-1 - $z + $isarrow}]
2657 set offs [incrange $offs $col $npad]
2658 insert_pad $y0 $x0 $npad
2659 if {$y0 > 0} {
2660 optimize_rows $y0 $x0 $row
2662 set z [lindex $offs $col]
2663 set x0 [expr {$col + $z}]
2664 set z0 [lindex $rowoffsets $y0 $x0]
2665 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2666 set npad [expr {$z - 1 + $isarrow}]
2667 set y1 [expr {$row + 1}]
2668 set offs2 [lindex $rowoffsets $y1]
2669 set x1 -1
2670 foreach z $offs2 {
2671 incr x1
2672 if {$z eq {} || $x1 + $z < $col} continue
2673 if {$x1 + $z > $col} {
2674 incr npad
2676 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2677 break
2679 set pad [ntimes $npad {}]
2680 set idlist [eval linsert \$idlist $col $pad]
2681 set tmp [eval linsert \$offs $col $pad]
2682 incr col $npad
2683 set offs [incrange $tmp $col [expr {-$npad}]]
2684 set z [lindex $offs $col]
2685 set haspad 1
2687 if {$z0 eq {} && !$isarrow} {
2688 # this line links to its first child on row $row-2
2689 set rm2 [expr {$row - 2}]
2690 set id [lindex $displayorder $rm2]
2691 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2692 if {$xc >= 0} {
2693 set z0 [expr {$xc - $x0}]
2696 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2697 insert_pad $y0 $x0 1
2698 set offs [incrange $offs $col 1]
2699 optimize_rows $y0 [expr {$x0 + 1}] $row
2702 if {!$haspad} {
2703 set o {}
2704 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2705 set o [lindex $offs $col]
2706 if {$o eq {}} {
2707 # check if this is the link to the first child
2708 set id [lindex $idlist $col]
2709 set ranges [rowranges $id]
2710 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2711 # it is, work out offset to child
2712 set y0 [expr {$row - 1}]
2713 set id [lindex $displayorder $y0]
2714 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2715 if {$x0 >= 0} {
2716 set o [expr {$x0 - $col}]
2720 if {$o eq {} || $o <= 0} break
2722 if {$o ne {} && [incr col] < [llength $idlist]} {
2723 set y1 [expr {$row + 1}]
2724 set offs2 [lindex $rowoffsets $y1]
2725 set x1 -1
2726 foreach z $offs2 {
2727 incr x1
2728 if {$z eq {} || $x1 + $z < $col} continue
2729 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2730 break
2732 set idlist [linsert $idlist $col {}]
2733 set tmp [linsert $offs $col {}]
2734 incr col
2735 set offs [incrange $tmp $col -1]
2738 lset rowidlist $row $idlist
2739 lset rowoffsets $row $offs
2740 set col 0
2744 proc xc {row col} {
2745 global canvx0 linespc
2746 return [expr {$canvx0 + $col * $linespc}]
2749 proc yc {row} {
2750 global canvy0 linespc
2751 return [expr {$canvy0 + $row * $linespc}]
2754 proc linewidth {id} {
2755 global thickerline lthickness
2757 set wid $lthickness
2758 if {[info exists thickerline] && $id eq $thickerline} {
2759 set wid [expr {2 * $lthickness}]
2761 return $wid
2764 proc rowranges {id} {
2765 global phase idrowranges commitrow rowlaidout rowrangelist curview
2767 set ranges {}
2768 if {$phase eq {} ||
2769 ([info exists commitrow($curview,$id)]
2770 && $commitrow($curview,$id) < $rowlaidout)} {
2771 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2772 } elseif {[info exists idrowranges($id)]} {
2773 set ranges $idrowranges($id)
2775 return $ranges
2778 proc drawlineseg {id i} {
2779 global rowoffsets rowidlist
2780 global displayorder
2781 global canv colormap linespc
2782 global numcommits commitrow curview
2784 set ranges [rowranges $id]
2785 set downarrow 1
2786 if {[info exists commitrow($curview,$id)]
2787 && $commitrow($curview,$id) < $numcommits} {
2788 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2789 } else {
2790 set downarrow 1
2792 set startrow [lindex $ranges [expr {2 * $i}]]
2793 set row [lindex $ranges [expr {2 * $i + 1}]]
2794 if {$startrow == $row} return
2795 assigncolor $id
2796 set coords {}
2797 set col [lsearch -exact [lindex $rowidlist $row] $id]
2798 if {$col < 0} {
2799 puts "oops: drawline: id $id not on row $row"
2800 return
2802 set lasto {}
2803 set ns 0
2804 while {1} {
2805 set o [lindex $rowoffsets $row $col]
2806 if {$o eq {}} break
2807 if {$o ne $lasto} {
2808 # changing direction
2809 set x [xc $row $col]
2810 set y [yc $row]
2811 lappend coords $x $y
2812 set lasto $o
2814 incr col $o
2815 incr row -1
2817 set x [xc $row $col]
2818 set y [yc $row]
2819 lappend coords $x $y
2820 if {$i == 0} {
2821 # draw the link to the first child as part of this line
2822 incr row -1
2823 set child [lindex $displayorder $row]
2824 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2825 if {$ccol >= 0} {
2826 set x [xc $row $ccol]
2827 set y [yc $row]
2828 if {$ccol < $col - 1} {
2829 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2830 } elseif {$ccol > $col + 1} {
2831 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2833 lappend coords $x $y
2836 if {[llength $coords] < 4} return
2837 if {$downarrow} {
2838 # This line has an arrow at the lower end: check if the arrow is
2839 # on a diagonal segment, and if so, work around the Tk 8.4
2840 # refusal to draw arrows on diagonal lines.
2841 set x0 [lindex $coords 0]
2842 set x1 [lindex $coords 2]
2843 if {$x0 != $x1} {
2844 set y0 [lindex $coords 1]
2845 set y1 [lindex $coords 3]
2846 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2847 # we have a nearby vertical segment, just trim off the diag bit
2848 set coords [lrange $coords 2 end]
2849 } else {
2850 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2851 set xi [expr {$x0 - $slope * $linespc / 2}]
2852 set yi [expr {$y0 - $linespc / 2}]
2853 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2857 set arrow [expr {2 * ($i > 0) + $downarrow}]
2858 set arrow [lindex {none first last both} $arrow]
2859 set t [$canv create line $coords -width [linewidth $id] \
2860 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2861 $canv lower $t
2862 bindline $t $id
2865 proc drawparentlinks {id row col olds} {
2866 global rowidlist canv colormap
2868 set row2 [expr {$row + 1}]
2869 set x [xc $row $col]
2870 set y [yc $row]
2871 set y2 [yc $row2]
2872 set ids [lindex $rowidlist $row2]
2873 # rmx = right-most X coord used
2874 set rmx 0
2875 foreach p $olds {
2876 set i [lsearch -exact $ids $p]
2877 if {$i < 0} {
2878 puts "oops, parent $p of $id not in list"
2879 continue
2881 set x2 [xc $row2 $i]
2882 if {$x2 > $rmx} {
2883 set rmx $x2
2885 set ranges [rowranges $p]
2886 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2887 && $row2 < [lindex $ranges 1]} {
2888 # drawlineseg will do this one for us
2889 continue
2891 assigncolor $p
2892 # should handle duplicated parents here...
2893 set coords [list $x $y]
2894 if {$i < $col - 1} {
2895 lappend coords [xc $row [expr {$i + 1}]] $y
2896 } elseif {$i > $col + 1} {
2897 lappend coords [xc $row [expr {$i - 1}]] $y
2899 lappend coords $x2 $y2
2900 set t [$canv create line $coords -width [linewidth $p] \
2901 -fill $colormap($p) -tags lines.$p]
2902 $canv lower $t
2903 bindline $t $p
2905 return $rmx
2908 proc drawlines {id} {
2909 global colormap canv
2910 global idrangedrawn
2911 global children iddrawn commitrow rowidlist curview
2913 $canv delete lines.$id
2914 set nr [expr {[llength [rowranges $id]] / 2}]
2915 for {set i 0} {$i < $nr} {incr i} {
2916 if {[info exists idrangedrawn($id,$i)]} {
2917 drawlineseg $id $i
2920 foreach child $children($curview,$id) {
2921 if {[info exists iddrawn($child)]} {
2922 set row $commitrow($curview,$child)
2923 set col [lsearch -exact [lindex $rowidlist $row] $child]
2924 if {$col >= 0} {
2925 drawparentlinks $child $row $col [list $id]
2931 proc drawcmittext {id row col rmx} {
2932 global linespc canv canv2 canv3 canvy0 fgcolor
2933 global commitlisted commitinfo rowidlist
2934 global rowtextx idpos idtags idheads idotherrefs
2935 global linehtag linentag linedtag
2936 global mainfont canvxmax boldrows boldnamerows fgcolor
2938 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2939 set x [xc $row $col]
2940 set y [yc $row]
2941 set orad [expr {$linespc / 3}]
2942 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2943 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2944 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2945 $canv raise $t
2946 $canv bind $t <1> {selcanvline {} %x %y}
2947 set xt [xc $row [llength [lindex $rowidlist $row]]]
2948 if {$xt < $rmx} {
2949 set xt $rmx
2951 set rowtextx($row) $xt
2952 set idpos($id) [list $x $xt $y]
2953 if {[info exists idtags($id)] || [info exists idheads($id)]
2954 || [info exists idotherrefs($id)]} {
2955 set xt [drawtags $id $x $xt $y]
2957 set headline [lindex $commitinfo($id) 0]
2958 set name [lindex $commitinfo($id) 1]
2959 set date [lindex $commitinfo($id) 2]
2960 set date [formatdate $date]
2961 set font $mainfont
2962 set nfont $mainfont
2963 set isbold [ishighlighted $row]
2964 if {$isbold > 0} {
2965 lappend boldrows $row
2966 lappend font bold
2967 if {$isbold > 1} {
2968 lappend boldnamerows $row
2969 lappend nfont bold
2972 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2973 -text $headline -font $font -tags text]
2974 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2975 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2976 -text $name -font $nfont -tags text]
2977 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2978 -text $date -font $mainfont -tags text]
2979 set xr [expr {$xt + [font measure $mainfont $headline]}]
2980 if {$xr > $canvxmax} {
2981 set canvxmax $xr
2982 setcanvscroll
2986 proc drawcmitrow {row} {
2987 global displayorder rowidlist
2988 global idrangedrawn iddrawn
2989 global commitinfo parentlist numcommits
2990 global filehighlight fhighlights findstring nhighlights
2991 global hlview vhighlights
2992 global highlight_related rhighlights
2994 if {$row >= $numcommits} return
2995 foreach id [lindex $rowidlist $row] {
2996 if {$id eq {}} continue
2997 set i -1
2998 foreach {s e} [rowranges $id] {
2999 incr i
3000 if {$row < $s} continue
3001 if {$e eq {}} break
3002 if {$row <= $e} {
3003 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3004 drawlineseg $id $i
3005 set idrangedrawn($id,$i) 1
3007 break
3012 set id [lindex $displayorder $row]
3013 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3014 askvhighlight $row $id
3016 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3017 askfilehighlight $row $id
3019 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3020 askfindhighlight $row $id
3022 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3023 askrelhighlight $row $id
3025 if {[info exists iddrawn($id)]} return
3026 set col [lsearch -exact [lindex $rowidlist $row] $id]
3027 if {$col < 0} {
3028 puts "oops, row $row id $id not in list"
3029 return
3031 if {![info exists commitinfo($id)]} {
3032 getcommit $id
3034 assigncolor $id
3035 set olds [lindex $parentlist $row]
3036 if {$olds ne {}} {
3037 set rmx [drawparentlinks $id $row $col $olds]
3038 } else {
3039 set rmx 0
3041 drawcmittext $id $row $col $rmx
3042 set iddrawn($id) 1
3045 proc drawfrac {f0 f1} {
3046 global numcommits canv
3047 global linespc
3049 set ymax [lindex [$canv cget -scrollregion] 3]
3050 if {$ymax eq {} || $ymax == 0} return
3051 set y0 [expr {int($f0 * $ymax)}]
3052 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3053 if {$row < 0} {
3054 set row 0
3056 set y1 [expr {int($f1 * $ymax)}]
3057 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3058 if {$endrow >= $numcommits} {
3059 set endrow [expr {$numcommits - 1}]
3061 for {} {$row <= $endrow} {incr row} {
3062 drawcmitrow $row
3066 proc drawvisible {} {
3067 global canv
3068 eval drawfrac [$canv yview]
3071 proc clear_display {} {
3072 global iddrawn idrangedrawn
3073 global vhighlights fhighlights nhighlights rhighlights
3075 allcanvs delete all
3076 catch {unset iddrawn}
3077 catch {unset idrangedrawn}
3078 catch {unset vhighlights}
3079 catch {unset fhighlights}
3080 catch {unset nhighlights}
3081 catch {unset rhighlights}
3084 proc findcrossings {id} {
3085 global rowidlist parentlist numcommits rowoffsets displayorder
3087 set cross {}
3088 set ccross {}
3089 foreach {s e} [rowranges $id] {
3090 if {$e >= $numcommits} {
3091 set e [expr {$numcommits - 1}]
3093 if {$e <= $s} continue
3094 set x [lsearch -exact [lindex $rowidlist $e] $id]
3095 if {$x < 0} {
3096 puts "findcrossings: oops, no [shortids $id] in row $e"
3097 continue
3099 for {set row $e} {[incr row -1] >= $s} {} {
3100 set olds [lindex $parentlist $row]
3101 set kid [lindex $displayorder $row]
3102 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3103 if {$kidx < 0} continue
3104 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3105 foreach p $olds {
3106 set px [lsearch -exact $nextrow $p]
3107 if {$px < 0} continue
3108 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3109 if {[lsearch -exact $ccross $p] >= 0} continue
3110 if {$x == $px + ($kidx < $px? -1: 1)} {
3111 lappend ccross $p
3112 } elseif {[lsearch -exact $cross $p] < 0} {
3113 lappend cross $p
3117 set inc [lindex $rowoffsets $row $x]
3118 if {$inc eq {}} break
3119 incr x $inc
3122 return [concat $ccross {{}} $cross]
3125 proc assigncolor {id} {
3126 global colormap colors nextcolor
3127 global commitrow parentlist children children curview
3129 if {[info exists colormap($id)]} return
3130 set ncolors [llength $colors]
3131 if {[info exists children($curview,$id)]} {
3132 set kids $children($curview,$id)
3133 } else {
3134 set kids {}
3136 if {[llength $kids] == 1} {
3137 set child [lindex $kids 0]
3138 if {[info exists colormap($child)]
3139 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3140 set colormap($id) $colormap($child)
3141 return
3144 set badcolors {}
3145 set origbad {}
3146 foreach x [findcrossings $id] {
3147 if {$x eq {}} {
3148 # delimiter between corner crossings and other crossings
3149 if {[llength $badcolors] >= $ncolors - 1} break
3150 set origbad $badcolors
3152 if {[info exists colormap($x)]
3153 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3154 lappend badcolors $colormap($x)
3157 if {[llength $badcolors] >= $ncolors} {
3158 set badcolors $origbad
3160 set origbad $badcolors
3161 if {[llength $badcolors] < $ncolors - 1} {
3162 foreach child $kids {
3163 if {[info exists colormap($child)]
3164 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3165 lappend badcolors $colormap($child)
3167 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3168 if {[info exists colormap($p)]
3169 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3170 lappend badcolors $colormap($p)
3174 if {[llength $badcolors] >= $ncolors} {
3175 set badcolors $origbad
3178 for {set i 0} {$i <= $ncolors} {incr i} {
3179 set c [lindex $colors $nextcolor]
3180 if {[incr nextcolor] >= $ncolors} {
3181 set nextcolor 0
3183 if {[lsearch -exact $badcolors $c]} break
3185 set colormap($id) $c
3188 proc bindline {t id} {
3189 global canv
3191 $canv bind $t <Enter> "lineenter %x %y $id"
3192 $canv bind $t <Motion> "linemotion %x %y $id"
3193 $canv bind $t <Leave> "lineleave $id"
3194 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3197 proc drawtags {id x xt y1} {
3198 global idtags idheads idotherrefs mainhead
3199 global linespc lthickness
3200 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3202 set marks {}
3203 set ntags 0
3204 set nheads 0
3205 if {[info exists idtags($id)]} {
3206 set marks $idtags($id)
3207 set ntags [llength $marks]
3209 if {[info exists idheads($id)]} {
3210 set marks [concat $marks $idheads($id)]
3211 set nheads [llength $idheads($id)]
3213 if {[info exists idotherrefs($id)]} {
3214 set marks [concat $marks $idotherrefs($id)]
3216 if {$marks eq {}} {
3217 return $xt
3220 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3221 set yt [expr {$y1 - 0.5 * $linespc}]
3222 set yb [expr {$yt + $linespc - 1}]
3223 set xvals {}
3224 set wvals {}
3225 set i -1
3226 foreach tag $marks {
3227 incr i
3228 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3229 set wid [font measure [concat $mainfont bold] $tag]
3230 } else {
3231 set wid [font measure $mainfont $tag]
3233 lappend xvals $xt
3234 lappend wvals $wid
3235 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3237 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3238 -width $lthickness -fill black -tags tag.$id]
3239 $canv lower $t
3240 foreach tag $marks x $xvals wid $wvals {
3241 set xl [expr {$x + $delta}]
3242 set xr [expr {$x + $delta + $wid + $lthickness}]
3243 set font $mainfont
3244 if {[incr ntags -1] >= 0} {
3245 # draw a tag
3246 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3247 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3248 -width 1 -outline black -fill yellow -tags tag.$id]
3249 $canv bind $t <1> [list showtag $tag 1]
3250 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3251 } else {
3252 # draw a head or other ref
3253 if {[incr nheads -1] >= 0} {
3254 set col green
3255 if {$tag eq $mainhead} {
3256 lappend font bold
3258 } else {
3259 set col "#ddddff"
3261 set xl [expr {$xl - $delta/2}]
3262 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3263 -width 1 -outline black -fill $col -tags tag.$id
3264 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3265 set rwid [font measure $mainfont $remoteprefix]
3266 set xi [expr {$x + 1}]
3267 set yti [expr {$yt + 1}]
3268 set xri [expr {$x + $rwid}]
3269 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3270 -width 0 -fill "#ffddaa" -tags tag.$id
3273 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3274 -font $font -tags [list tag.$id text]]
3275 if {$ntags >= 0} {
3276 $canv bind $t <1> [list showtag $tag 1]
3277 } elseif {$nheads >= 0} {
3278 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3281 return $xt
3284 proc xcoord {i level ln} {
3285 global canvx0 xspc1 xspc2
3287 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3288 if {$i > 0 && $i == $level} {
3289 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3290 } elseif {$i > $level} {
3291 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3293 return $x
3296 proc show_status {msg} {
3297 global canv mainfont fgcolor
3299 clear_display
3300 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3301 -tags text -fill $fgcolor
3304 proc finishcommits {} {
3305 global commitidx phase curview
3306 global pending_select
3308 if {$commitidx($curview) > 0} {
3309 drawrest
3310 } else {
3311 show_status "No commits selected"
3313 set phase {}
3314 catch {unset pending_select}
3317 # Insert a new commit as the child of the commit on row $row.
3318 # The new commit will be displayed on row $row and the commits
3319 # on that row and below will move down one row.
3320 proc insertrow {row newcmit} {
3321 global displayorder parentlist childlist commitlisted
3322 global commitrow curview rowidlist rowoffsets numcommits
3323 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3324 global linesegends selectedline
3326 if {$row >= $numcommits} {
3327 puts "oops, inserting new row $row but only have $numcommits rows"
3328 return
3330 set p [lindex $displayorder $row]
3331 set displayorder [linsert $displayorder $row $newcmit]
3332 set parentlist [linsert $parentlist $row $p]
3333 set kids [lindex $childlist $row]
3334 lappend kids $newcmit
3335 lset childlist $row $kids
3336 set childlist [linsert $childlist $row {}]
3337 set commitlisted [linsert $commitlisted $row 1]
3338 set l [llength $displayorder]
3339 for {set r $row} {$r < $l} {incr r} {
3340 set id [lindex $displayorder $r]
3341 set commitrow($curview,$id) $r
3344 set idlist [lindex $rowidlist $row]
3345 set offs [lindex $rowoffsets $row]
3346 set newoffs {}
3347 foreach x $idlist {
3348 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3349 lappend newoffs {}
3350 } else {
3351 lappend newoffs 0
3354 if {[llength $kids] == 1} {
3355 set col [lsearch -exact $idlist $p]
3356 lset idlist $col $newcmit
3357 } else {
3358 set col [llength $idlist]
3359 lappend idlist $newcmit
3360 lappend offs {}
3361 lset rowoffsets $row $offs
3363 set rowidlist [linsert $rowidlist $row $idlist]
3364 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3366 set rowrangelist [linsert $rowrangelist $row {}]
3367 set l [llength $rowrangelist]
3368 for {set r 0} {$r < $l} {incr r} {
3369 set ranges [lindex $rowrangelist $r]
3370 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3371 set newranges {}
3372 foreach x $ranges {
3373 if {$x >= $row} {
3374 lappend newranges [expr {$x + 1}]
3375 } else {
3376 lappend newranges $x
3379 lset rowrangelist $r $newranges
3382 if {[llength $kids] > 1} {
3383 set rp1 [expr {$row + 1}]
3384 set ranges [lindex $rowrangelist $rp1]
3385 if {$ranges eq {}} {
3386 set ranges [list $row $rp1]
3387 } elseif {[lindex $ranges end-1] == $rp1} {
3388 lset ranges end-1 $row
3390 lset rowrangelist $rp1 $ranges
3392 foreach id [array names idrowranges] {
3393 set ranges $idrowranges($id)
3394 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3395 set newranges {}
3396 foreach x $ranges {
3397 if {$x >= $row} {
3398 lappend newranges [expr {$x + 1}]
3399 } else {
3400 lappend newranges $x
3403 set idrowranges($id) $newranges
3407 set linesegends [linsert $linesegends $row {}]
3409 incr rowlaidout
3410 incr rowoptim
3411 incr numcommits
3413 if {[info exists selectedline] && $selectedline >= $row} {
3414 incr selectedline
3416 redisplay
3419 # Don't change the text pane cursor if it is currently the hand cursor,
3420 # showing that we are over a sha1 ID link.
3421 proc settextcursor {c} {
3422 global ctext curtextcursor
3424 if {[$ctext cget -cursor] == $curtextcursor} {
3425 $ctext config -cursor $c
3427 set curtextcursor $c
3430 proc nowbusy {what} {
3431 global isbusy
3433 if {[array names isbusy] eq {}} {
3434 . config -cursor watch
3435 settextcursor watch
3437 set isbusy($what) 1
3440 proc notbusy {what} {
3441 global isbusy maincursor textcursor
3443 catch {unset isbusy($what)}
3444 if {[array names isbusy] eq {}} {
3445 . config -cursor $maincursor
3446 settextcursor $textcursor
3450 proc drawrest {} {
3451 global startmsecs
3452 global rowlaidout commitidx curview
3453 global pending_select
3455 set row $rowlaidout
3456 layoutrows $rowlaidout $commitidx($curview) 1
3457 layouttail
3458 optimize_rows $row 0 $commitidx($curview)
3459 showstuff $commitidx($curview)
3460 if {[info exists pending_select]} {
3461 selectline 0 1
3464 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3465 #global numcommits
3466 #puts "overall $drawmsecs ms for $numcommits commits"
3469 proc findmatches {f} {
3470 global findtype foundstring foundstrlen
3471 if {$findtype == "Regexp"} {
3472 set matches [regexp -indices -all -inline $foundstring $f]
3473 } else {
3474 if {$findtype == "IgnCase"} {
3475 set str [string tolower $f]
3476 } else {
3477 set str $f
3479 set matches {}
3480 set i 0
3481 while {[set j [string first $foundstring $str $i]] >= 0} {
3482 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3483 set i [expr {$j + $foundstrlen}]
3486 return $matches
3489 proc dofind {} {
3490 global findtype findloc findstring markedmatches commitinfo
3491 global numcommits displayorder linehtag linentag linedtag
3492 global mainfont canv canv2 canv3 selectedline
3493 global matchinglines foundstring foundstrlen matchstring
3494 global commitdata
3496 stopfindproc
3497 unmarkmatches
3498 cancel_next_highlight
3499 focus .
3500 set matchinglines {}
3501 if {$findtype == "IgnCase"} {
3502 set foundstring [string tolower $findstring]
3503 } else {
3504 set foundstring $findstring
3506 set foundstrlen [string length $findstring]
3507 if {$foundstrlen == 0} return
3508 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3509 set matchstring "*$matchstring*"
3510 if {![info exists selectedline]} {
3511 set oldsel -1
3512 } else {
3513 set oldsel $selectedline
3515 set didsel 0
3516 set fldtypes {Headline Author Date Committer CDate Comments}
3517 set l -1
3518 foreach id $displayorder {
3519 set d $commitdata($id)
3520 incr l
3521 if {$findtype == "Regexp"} {
3522 set doesmatch [regexp $foundstring $d]
3523 } elseif {$findtype == "IgnCase"} {
3524 set doesmatch [string match -nocase $matchstring $d]
3525 } else {
3526 set doesmatch [string match $matchstring $d]
3528 if {!$doesmatch} continue
3529 if {![info exists commitinfo($id)]} {
3530 getcommit $id
3532 set info $commitinfo($id)
3533 set doesmatch 0
3534 foreach f $info ty $fldtypes {
3535 if {$findloc != "All fields" && $findloc != $ty} {
3536 continue
3538 set matches [findmatches $f]
3539 if {$matches == {}} continue
3540 set doesmatch 1
3541 if {$ty == "Headline"} {
3542 drawcmitrow $l
3543 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3544 } elseif {$ty == "Author"} {
3545 drawcmitrow $l
3546 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3547 } elseif {$ty == "Date"} {
3548 drawcmitrow $l
3549 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3552 if {$doesmatch} {
3553 lappend matchinglines $l
3554 if {!$didsel && $l > $oldsel} {
3555 findselectline $l
3556 set didsel 1
3560 if {$matchinglines == {}} {
3561 bell
3562 } elseif {!$didsel} {
3563 findselectline [lindex $matchinglines 0]
3567 proc findselectline {l} {
3568 global findloc commentend ctext
3569 selectline $l 1
3570 if {$findloc == "All fields" || $findloc == "Comments"} {
3571 # highlight the matches in the comments
3572 set f [$ctext get 1.0 $commentend]
3573 set matches [findmatches $f]
3574 foreach match $matches {
3575 set start [lindex $match 0]
3576 set end [expr {[lindex $match 1] + 1}]
3577 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3582 proc findnext {restart} {
3583 global matchinglines selectedline
3584 if {![info exists matchinglines]} {
3585 if {$restart} {
3586 dofind
3588 return
3590 if {![info exists selectedline]} return
3591 foreach l $matchinglines {
3592 if {$l > $selectedline} {
3593 findselectline $l
3594 return
3597 bell
3600 proc findprev {} {
3601 global matchinglines selectedline
3602 if {![info exists matchinglines]} {
3603 dofind
3604 return
3606 if {![info exists selectedline]} return
3607 set prev {}
3608 foreach l $matchinglines {
3609 if {$l >= $selectedline} break
3610 set prev $l
3612 if {$prev != {}} {
3613 findselectline $prev
3614 } else {
3615 bell
3619 proc stopfindproc {{done 0}} {
3620 global findprocpid findprocfile findids
3621 global ctext findoldcursor phase maincursor textcursor
3622 global findinprogress
3624 catch {unset findids}
3625 if {[info exists findprocpid]} {
3626 if {!$done} {
3627 catch {exec kill $findprocpid}
3629 catch {close $findprocfile}
3630 unset findprocpid
3632 catch {unset findinprogress}
3633 notbusy find
3636 # mark a commit as matching by putting a yellow background
3637 # behind the headline
3638 proc markheadline {l id} {
3639 global canv mainfont linehtag
3641 drawcmitrow $l
3642 set bbox [$canv bbox $linehtag($l)]
3643 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3644 $canv lower $t
3647 # mark the bits of a headline, author or date that match a find string
3648 proc markmatches {canv l str tag matches font} {
3649 set bbox [$canv bbox $tag]
3650 set x0 [lindex $bbox 0]
3651 set y0 [lindex $bbox 1]
3652 set y1 [lindex $bbox 3]
3653 foreach match $matches {
3654 set start [lindex $match 0]
3655 set end [lindex $match 1]
3656 if {$start > $end} continue
3657 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3658 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3659 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3660 [expr {$x0+$xlen+2}] $y1 \
3661 -outline {} -tags matches -fill yellow]
3662 $canv lower $t
3666 proc unmarkmatches {} {
3667 global matchinglines findids
3668 allcanvs delete matches
3669 catch {unset matchinglines}
3670 catch {unset findids}
3673 proc selcanvline {w x y} {
3674 global canv canvy0 ctext linespc
3675 global rowtextx
3676 set ymax [lindex [$canv cget -scrollregion] 3]
3677 if {$ymax == {}} return
3678 set yfrac [lindex [$canv yview] 0]
3679 set y [expr {$y + $yfrac * $ymax}]
3680 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3681 if {$l < 0} {
3682 set l 0
3684 if {$w eq $canv} {
3685 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3687 unmarkmatches
3688 selectline $l 1
3691 proc commit_descriptor {p} {
3692 global commitinfo
3693 if {![info exists commitinfo($p)]} {
3694 getcommit $p
3696 set l "..."
3697 if {[llength $commitinfo($p)] > 1} {
3698 set l [lindex $commitinfo($p) 0]
3700 return "$p ($l)\n"
3703 # append some text to the ctext widget, and make any SHA1 ID
3704 # that we know about be a clickable link.
3705 proc appendwithlinks {text tags} {
3706 global ctext commitrow linknum curview
3708 set start [$ctext index "end - 1c"]
3709 $ctext insert end $text $tags
3710 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3711 foreach l $links {
3712 set s [lindex $l 0]
3713 set e [lindex $l 1]
3714 set linkid [string range $text $s $e]
3715 if {![info exists commitrow($curview,$linkid)]} continue
3716 incr e
3717 $ctext tag add link "$start + $s c" "$start + $e c"
3718 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3719 $ctext tag bind link$linknum <1> \
3720 [list selectline $commitrow($curview,$linkid) 1]
3721 incr linknum
3723 $ctext tag conf link -foreground blue -underline 1
3724 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3725 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3728 proc viewnextline {dir} {
3729 global canv linespc
3731 $canv delete hover
3732 set ymax [lindex [$canv cget -scrollregion] 3]
3733 set wnow [$canv yview]
3734 set wtop [expr {[lindex $wnow 0] * $ymax}]
3735 set newtop [expr {$wtop + $dir * $linespc}]
3736 if {$newtop < 0} {
3737 set newtop 0
3738 } elseif {$newtop > $ymax} {
3739 set newtop $ymax
3741 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3744 # add a list of tag or branch names at position pos
3745 # returns the number of names inserted
3746 proc appendrefs {pos tags var} {
3747 global ctext commitrow linknum curview $var
3749 if {[catch {$ctext index $pos}]} {
3750 return 0
3752 set tags [lsort $tags]
3753 set sep {}
3754 foreach tag $tags {
3755 set id [set $var\($tag\)]
3756 set lk link$linknum
3757 incr linknum
3758 $ctext insert $pos $sep
3759 $ctext insert $pos $tag $lk
3760 $ctext tag conf $lk -foreground blue
3761 if {[info exists commitrow($curview,$id)]} {
3762 $ctext tag bind $lk <1> \
3763 [list selectline $commitrow($curview,$id) 1]
3764 $ctext tag conf $lk -underline 1
3765 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3766 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3768 set sep ", "
3770 return [llength $tags]
3773 proc taglist {ids} {
3774 global idtags
3776 set tags {}
3777 foreach id $ids {
3778 foreach tag $idtags($id) {
3779 lappend tags $tag
3782 return $tags
3785 # called when we have finished computing the nearby tags
3786 proc dispneartags {} {
3787 global selectedline currentid ctext anc_tags desc_tags showneartags
3788 global desc_heads
3790 if {![info exists selectedline] || !$showneartags} return
3791 set id $currentid
3792 $ctext conf -state normal
3793 if {[info exists desc_heads($id)]} {
3794 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3795 $ctext insert "branch -2c" "es"
3798 if {[info exists anc_tags($id)]} {
3799 appendrefs follows [taglist $anc_tags($id)] tagids
3801 if {[info exists desc_tags($id)]} {
3802 appendrefs precedes [taglist $desc_tags($id)] tagids
3804 $ctext conf -state disabled
3807 proc selectline {l isnew} {
3808 global canv canv2 canv3 ctext commitinfo selectedline
3809 global displayorder linehtag linentag linedtag
3810 global canvy0 linespc parentlist childlist
3811 global currentid sha1entry
3812 global commentend idtags linknum
3813 global mergemax numcommits pending_select
3814 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3816 catch {unset pending_select}
3817 $canv delete hover
3818 normalline
3819 cancel_next_highlight
3820 if {$l < 0 || $l >= $numcommits} return
3821 set y [expr {$canvy0 + $l * $linespc}]
3822 set ymax [lindex [$canv cget -scrollregion] 3]
3823 set ytop [expr {$y - $linespc - 1}]
3824 set ybot [expr {$y + $linespc + 1}]
3825 set wnow [$canv yview]
3826 set wtop [expr {[lindex $wnow 0] * $ymax}]
3827 set wbot [expr {[lindex $wnow 1] * $ymax}]
3828 set wh [expr {$wbot - $wtop}]
3829 set newtop $wtop
3830 if {$ytop < $wtop} {
3831 if {$ybot < $wtop} {
3832 set newtop [expr {$y - $wh / 2.0}]
3833 } else {
3834 set newtop $ytop
3835 if {$newtop > $wtop - $linespc} {
3836 set newtop [expr {$wtop - $linespc}]
3839 } elseif {$ybot > $wbot} {
3840 if {$ytop > $wbot} {
3841 set newtop [expr {$y - $wh / 2.0}]
3842 } else {
3843 set newtop [expr {$ybot - $wh}]
3844 if {$newtop < $wtop + $linespc} {
3845 set newtop [expr {$wtop + $linespc}]
3849 if {$newtop != $wtop} {
3850 if {$newtop < 0} {
3851 set newtop 0
3853 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3854 drawvisible
3857 if {![info exists linehtag($l)]} return
3858 $canv delete secsel
3859 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3860 -tags secsel -fill [$canv cget -selectbackground]]
3861 $canv lower $t
3862 $canv2 delete secsel
3863 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3864 -tags secsel -fill [$canv2 cget -selectbackground]]
3865 $canv2 lower $t
3866 $canv3 delete secsel
3867 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3868 -tags secsel -fill [$canv3 cget -selectbackground]]
3869 $canv3 lower $t
3871 if {$isnew} {
3872 addtohistory [list selectline $l 0]
3875 set selectedline $l
3877 set id [lindex $displayorder $l]
3878 set currentid $id
3879 $sha1entry delete 0 end
3880 $sha1entry insert 0 $id
3881 $sha1entry selection from 0
3882 $sha1entry selection to end
3883 rhighlight_sel $id
3885 $ctext conf -state normal
3886 clear_ctext
3887 set linknum 0
3888 set info $commitinfo($id)
3889 set date [formatdate [lindex $info 2]]
3890 $ctext insert end "Author: [lindex $info 1] $date\n"
3891 set date [formatdate [lindex $info 4]]
3892 $ctext insert end "Committer: [lindex $info 3] $date\n"
3893 if {[info exists idtags($id)]} {
3894 $ctext insert end "Tags:"
3895 foreach tag $idtags($id) {
3896 $ctext insert end " $tag"
3898 $ctext insert end "\n"
3901 set headers {}
3902 set olds [lindex $parentlist $l]
3903 if {[llength $olds] > 1} {
3904 set np 0
3905 foreach p $olds {
3906 if {$np >= $mergemax} {
3907 set tag mmax
3908 } else {
3909 set tag m$np
3911 $ctext insert end "Parent: " $tag
3912 appendwithlinks [commit_descriptor $p] {}
3913 incr np
3915 } else {
3916 foreach p $olds {
3917 append headers "Parent: [commit_descriptor $p]"
3921 foreach c [lindex $childlist $l] {
3922 append headers "Child: [commit_descriptor $c]"
3925 # make anything that looks like a SHA1 ID be a clickable link
3926 appendwithlinks $headers {}
3927 if {$showneartags} {
3928 if {![info exists allcommits]} {
3929 getallcommits
3931 $ctext insert end "Branch: "
3932 $ctext mark set branch "end -1c"
3933 $ctext mark gravity branch left
3934 if {[info exists desc_heads($id)]} {
3935 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3936 # turn "Branch" into "Branches"
3937 $ctext insert "branch -2c" "es"
3940 $ctext insert end "\nFollows: "
3941 $ctext mark set follows "end -1c"
3942 $ctext mark gravity follows left
3943 if {[info exists anc_tags($id)]} {
3944 appendrefs follows [taglist $anc_tags($id)] tagids
3946 $ctext insert end "\nPrecedes: "
3947 $ctext mark set precedes "end -1c"
3948 $ctext mark gravity precedes left
3949 if {[info exists desc_tags($id)]} {
3950 appendrefs precedes [taglist $desc_tags($id)] tagids
3952 $ctext insert end "\n"
3954 $ctext insert end "\n"
3955 appendwithlinks [lindex $info 5] {comment}
3957 $ctext tag delete Comments
3958 $ctext tag remove found 1.0 end
3959 $ctext conf -state disabled
3960 set commentend [$ctext index "end - 1c"]
3962 init_flist "Comments"
3963 if {$cmitmode eq "tree"} {
3964 gettree $id
3965 } elseif {[llength $olds] <= 1} {
3966 startdiff $id
3967 } else {
3968 mergediff $id $l
3972 proc selfirstline {} {
3973 unmarkmatches
3974 selectline 0 1
3977 proc sellastline {} {
3978 global numcommits
3979 unmarkmatches
3980 set l [expr {$numcommits - 1}]
3981 selectline $l 1
3984 proc selnextline {dir} {
3985 global selectedline
3986 if {![info exists selectedline]} return
3987 set l [expr {$selectedline + $dir}]
3988 unmarkmatches
3989 selectline $l 1
3992 proc selnextpage {dir} {
3993 global canv linespc selectedline numcommits
3995 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3996 if {$lpp < 1} {
3997 set lpp 1
3999 allcanvs yview scroll [expr {$dir * $lpp}] units
4000 drawvisible
4001 if {![info exists selectedline]} return
4002 set l [expr {$selectedline + $dir * $lpp}]
4003 if {$l < 0} {
4004 set l 0
4005 } elseif {$l >= $numcommits} {
4006 set l [expr $numcommits - 1]
4008 unmarkmatches
4009 selectline $l 1
4012 proc unselectline {} {
4013 global selectedline currentid
4015 catch {unset selectedline}
4016 catch {unset currentid}
4017 allcanvs delete secsel
4018 rhighlight_none
4019 cancel_next_highlight
4022 proc reselectline {} {
4023 global selectedline
4025 if {[info exists selectedline]} {
4026 selectline $selectedline 0
4030 proc addtohistory {cmd} {
4031 global history historyindex curview
4033 set elt [list $curview $cmd]
4034 if {$historyindex > 0
4035 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4036 return
4039 if {$historyindex < [llength $history]} {
4040 set history [lreplace $history $historyindex end $elt]
4041 } else {
4042 lappend history $elt
4044 incr historyindex
4045 if {$historyindex > 1} {
4046 .ctop.top.bar.leftbut conf -state normal
4047 } else {
4048 .ctop.top.bar.leftbut conf -state disabled
4050 .ctop.top.bar.rightbut conf -state disabled
4053 proc godo {elt} {
4054 global curview
4056 set view [lindex $elt 0]
4057 set cmd [lindex $elt 1]
4058 if {$curview != $view} {
4059 showview $view
4061 eval $cmd
4064 proc goback {} {
4065 global history historyindex
4067 if {$historyindex > 1} {
4068 incr historyindex -1
4069 godo [lindex $history [expr {$historyindex - 1}]]
4070 .ctop.top.bar.rightbut conf -state normal
4072 if {$historyindex <= 1} {
4073 .ctop.top.bar.leftbut conf -state disabled
4077 proc goforw {} {
4078 global history historyindex
4080 if {$historyindex < [llength $history]} {
4081 set cmd [lindex $history $historyindex]
4082 incr historyindex
4083 godo $cmd
4084 .ctop.top.bar.leftbut conf -state normal
4086 if {$historyindex >= [llength $history]} {
4087 .ctop.top.bar.rightbut conf -state disabled
4091 proc gettree {id} {
4092 global treefilelist treeidlist diffids diffmergeid treepending
4094 set diffids $id
4095 catch {unset diffmergeid}
4096 if {![info exists treefilelist($id)]} {
4097 if {![info exists treepending]} {
4098 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4099 return
4101 set treepending $id
4102 set treefilelist($id) {}
4103 set treeidlist($id) {}
4104 fconfigure $gtf -blocking 0
4105 fileevent $gtf readable [list gettreeline $gtf $id]
4107 } else {
4108 setfilelist $id
4112 proc gettreeline {gtf id} {
4113 global treefilelist treeidlist treepending cmitmode diffids
4115 while {[gets $gtf line] >= 0} {
4116 if {[lindex $line 1] ne "blob"} continue
4117 set sha1 [lindex $line 2]
4118 set fname [lindex $line 3]
4119 lappend treefilelist($id) $fname
4120 lappend treeidlist($id) $sha1
4122 if {![eof $gtf]} return
4123 close $gtf
4124 unset treepending
4125 if {$cmitmode ne "tree"} {
4126 if {![info exists diffmergeid]} {
4127 gettreediffs $diffids
4129 } elseif {$id ne $diffids} {
4130 gettree $diffids
4131 } else {
4132 setfilelist $id
4136 proc showfile {f} {
4137 global treefilelist treeidlist diffids
4138 global ctext commentend
4140 set i [lsearch -exact $treefilelist($diffids) $f]
4141 if {$i < 0} {
4142 puts "oops, $f not in list for id $diffids"
4143 return
4145 set blob [lindex $treeidlist($diffids) $i]
4146 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4147 puts "oops, error reading blob $blob: $err"
4148 return
4150 fconfigure $bf -blocking 0
4151 fileevent $bf readable [list getblobline $bf $diffids]
4152 $ctext config -state normal
4153 clear_ctext $commentend
4154 $ctext insert end "\n"
4155 $ctext insert end "$f\n" filesep
4156 $ctext config -state disabled
4157 $ctext yview $commentend
4160 proc getblobline {bf id} {
4161 global diffids cmitmode ctext
4163 if {$id ne $diffids || $cmitmode ne "tree"} {
4164 catch {close $bf}
4165 return
4167 $ctext config -state normal
4168 while {[gets $bf line] >= 0} {
4169 $ctext insert end "$line\n"
4171 if {[eof $bf]} {
4172 # delete last newline
4173 $ctext delete "end - 2c" "end - 1c"
4174 close $bf
4176 $ctext config -state disabled
4179 proc mergediff {id l} {
4180 global diffmergeid diffopts mdifffd
4181 global diffids
4182 global parentlist
4184 set diffmergeid $id
4185 set diffids $id
4186 # this doesn't seem to actually affect anything...
4187 set env(GIT_DIFF_OPTS) $diffopts
4188 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4189 if {[catch {set mdf [open $cmd r]} err]} {
4190 error_popup "Error getting merge diffs: $err"
4191 return
4193 fconfigure $mdf -blocking 0
4194 set mdifffd($id) $mdf
4195 set np [llength [lindex $parentlist $l]]
4196 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4197 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4200 proc getmergediffline {mdf id np} {
4201 global diffmergeid ctext cflist nextupdate mergemax
4202 global difffilestart mdifffd
4204 set n [gets $mdf line]
4205 if {$n < 0} {
4206 if {[eof $mdf]} {
4207 close $mdf
4209 return
4211 if {![info exists diffmergeid] || $id != $diffmergeid
4212 || $mdf != $mdifffd($id)} {
4213 return
4215 $ctext conf -state normal
4216 if {[regexp {^diff --cc (.*)} $line match fname]} {
4217 # start of a new file
4218 $ctext insert end "\n"
4219 set here [$ctext index "end - 1c"]
4220 lappend difffilestart $here
4221 add_flist [list $fname]
4222 set l [expr {(78 - [string length $fname]) / 2}]
4223 set pad [string range "----------------------------------------" 1 $l]
4224 $ctext insert end "$pad $fname $pad\n" filesep
4225 } elseif {[regexp {^@@} $line]} {
4226 $ctext insert end "$line\n" hunksep
4227 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4228 # do nothing
4229 } else {
4230 # parse the prefix - one ' ', '-' or '+' for each parent
4231 set spaces {}
4232 set minuses {}
4233 set pluses {}
4234 set isbad 0
4235 for {set j 0} {$j < $np} {incr j} {
4236 set c [string range $line $j $j]
4237 if {$c == " "} {
4238 lappend spaces $j
4239 } elseif {$c == "-"} {
4240 lappend minuses $j
4241 } elseif {$c == "+"} {
4242 lappend pluses $j
4243 } else {
4244 set isbad 1
4245 break
4248 set tags {}
4249 set num {}
4250 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4251 # line doesn't appear in result, parents in $minuses have the line
4252 set num [lindex $minuses 0]
4253 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4254 # line appears in result, parents in $pluses don't have the line
4255 lappend tags mresult
4256 set num [lindex $spaces 0]
4258 if {$num ne {}} {
4259 if {$num >= $mergemax} {
4260 set num "max"
4262 lappend tags m$num
4264 $ctext insert end "$line\n" $tags
4266 $ctext conf -state disabled
4267 if {[clock clicks -milliseconds] >= $nextupdate} {
4268 incr nextupdate 100
4269 fileevent $mdf readable {}
4270 update
4271 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4275 proc startdiff {ids} {
4276 global treediffs diffids treepending diffmergeid
4278 set diffids $ids
4279 catch {unset diffmergeid}
4280 if {![info exists treediffs($ids)]} {
4281 if {![info exists treepending]} {
4282 gettreediffs $ids
4284 } else {
4285 addtocflist $ids
4289 proc addtocflist {ids} {
4290 global treediffs cflist
4291 add_flist $treediffs($ids)
4292 getblobdiffs $ids
4295 proc gettreediffs {ids} {
4296 global treediff treepending
4297 set treepending $ids
4298 set treediff {}
4299 if {[catch \
4300 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4301 ]} return
4302 fconfigure $gdtf -blocking 0
4303 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4306 proc gettreediffline {gdtf ids} {
4307 global treediff treediffs treepending diffids diffmergeid
4308 global cmitmode
4310 set n [gets $gdtf line]
4311 if {$n < 0} {
4312 if {![eof $gdtf]} return
4313 close $gdtf
4314 set treediffs($ids) $treediff
4315 unset treepending
4316 if {$cmitmode eq "tree"} {
4317 gettree $diffids
4318 } elseif {$ids != $diffids} {
4319 if {![info exists diffmergeid]} {
4320 gettreediffs $diffids
4322 } else {
4323 addtocflist $ids
4325 return
4327 set file [lindex $line 5]
4328 lappend treediff $file
4331 proc getblobdiffs {ids} {
4332 global diffopts blobdifffd diffids env curdifftag curtagstart
4333 global nextupdate diffinhdr treediffs
4335 set env(GIT_DIFF_OPTS) $diffopts
4336 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4337 if {[catch {set bdf [open $cmd r]} err]} {
4338 puts "error getting diffs: $err"
4339 return
4341 set diffinhdr 0
4342 fconfigure $bdf -blocking 0
4343 set blobdifffd($ids) $bdf
4344 set curdifftag Comments
4345 set curtagstart 0.0
4346 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4347 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4350 proc setinlist {var i val} {
4351 global $var
4353 while {[llength [set $var]] < $i} {
4354 lappend $var {}
4356 if {[llength [set $var]] == $i} {
4357 lappend $var $val
4358 } else {
4359 lset $var $i $val
4363 proc getblobdiffline {bdf ids} {
4364 global diffids blobdifffd ctext curdifftag curtagstart
4365 global diffnexthead diffnextnote difffilestart
4366 global nextupdate diffinhdr treediffs
4368 set n [gets $bdf line]
4369 if {$n < 0} {
4370 if {[eof $bdf]} {
4371 close $bdf
4372 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4373 $ctext tag add $curdifftag $curtagstart end
4376 return
4378 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4379 return
4381 $ctext conf -state normal
4382 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4383 # start of a new file
4384 $ctext insert end "\n"
4385 $ctext tag add $curdifftag $curtagstart end
4386 set here [$ctext index "end - 1c"]
4387 set curtagstart $here
4388 set header $newname
4389 set i [lsearch -exact $treediffs($ids) $fname]
4390 if {$i >= 0} {
4391 setinlist difffilestart $i $here
4393 if {$newname ne $fname} {
4394 set i [lsearch -exact $treediffs($ids) $newname]
4395 if {$i >= 0} {
4396 setinlist difffilestart $i $here
4399 set curdifftag "f:$fname"
4400 $ctext tag delete $curdifftag
4401 set l [expr {(78 - [string length $header]) / 2}]
4402 set pad [string range "----------------------------------------" 1 $l]
4403 $ctext insert end "$pad $header $pad\n" filesep
4404 set diffinhdr 1
4405 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4406 # do nothing
4407 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4408 set diffinhdr 0
4409 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4410 $line match f1l f1c f2l f2c rest]} {
4411 $ctext insert end "$line\n" hunksep
4412 set diffinhdr 0
4413 } else {
4414 set x [string range $line 0 0]
4415 if {$x == "-" || $x == "+"} {
4416 set tag [expr {$x == "+"}]
4417 $ctext insert end "$line\n" d$tag
4418 } elseif {$x == " "} {
4419 $ctext insert end "$line\n"
4420 } elseif {$diffinhdr || $x == "\\"} {
4421 # e.g. "\ No newline at end of file"
4422 $ctext insert end "$line\n" filesep
4423 } else {
4424 # Something else we don't recognize
4425 if {$curdifftag != "Comments"} {
4426 $ctext insert end "\n"
4427 $ctext tag add $curdifftag $curtagstart end
4428 set curtagstart [$ctext index "end - 1c"]
4429 set curdifftag Comments
4431 $ctext insert end "$line\n" filesep
4434 $ctext conf -state disabled
4435 if {[clock clicks -milliseconds] >= $nextupdate} {
4436 incr nextupdate 100
4437 fileevent $bdf readable {}
4438 update
4439 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4443 proc prevfile {} {
4444 global difffilestart ctext
4445 set prev [lindex $difffilestart 0]
4446 set here [$ctext index @0,0]
4447 foreach loc $difffilestart {
4448 if {[$ctext compare $loc >= $here]} {
4449 $ctext yview $prev
4450 return
4452 set prev $loc
4454 $ctext yview $prev
4457 proc nextfile {} {
4458 global difffilestart ctext
4459 set here [$ctext index @0,0]
4460 foreach loc $difffilestart {
4461 if {[$ctext compare $loc > $here]} {
4462 $ctext yview $loc
4463 return
4468 proc clear_ctext {{first 1.0}} {
4469 global ctext smarktop smarkbot
4471 set l [lindex [split $first .] 0]
4472 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4473 set smarktop $l
4475 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4476 set smarkbot $l
4478 $ctext delete $first end
4481 proc incrsearch {name ix op} {
4482 global ctext searchstring searchdirn
4484 $ctext tag remove found 1.0 end
4485 if {[catch {$ctext index anchor}]} {
4486 # no anchor set, use start of selection, or of visible area
4487 set sel [$ctext tag ranges sel]
4488 if {$sel ne {}} {
4489 $ctext mark set anchor [lindex $sel 0]
4490 } elseif {$searchdirn eq "-forwards"} {
4491 $ctext mark set anchor @0,0
4492 } else {
4493 $ctext mark set anchor @0,[winfo height $ctext]
4496 if {$searchstring ne {}} {
4497 set here [$ctext search $searchdirn -- $searchstring anchor]
4498 if {$here ne {}} {
4499 $ctext see $here
4501 searchmarkvisible 1
4505 proc dosearch {} {
4506 global sstring ctext searchstring searchdirn
4508 focus $sstring
4509 $sstring icursor end
4510 set searchdirn -forwards
4511 if {$searchstring ne {}} {
4512 set sel [$ctext tag ranges sel]
4513 if {$sel ne {}} {
4514 set start "[lindex $sel 0] + 1c"
4515 } elseif {[catch {set start [$ctext index anchor]}]} {
4516 set start "@0,0"
4518 set match [$ctext search -count mlen -- $searchstring $start]
4519 $ctext tag remove sel 1.0 end
4520 if {$match eq {}} {
4521 bell
4522 return
4524 $ctext see $match
4525 set mend "$match + $mlen c"
4526 $ctext tag add sel $match $mend
4527 $ctext mark unset anchor
4531 proc dosearchback {} {
4532 global sstring ctext searchstring searchdirn
4534 focus $sstring
4535 $sstring icursor end
4536 set searchdirn -backwards
4537 if {$searchstring ne {}} {
4538 set sel [$ctext tag ranges sel]
4539 if {$sel ne {}} {
4540 set start [lindex $sel 0]
4541 } elseif {[catch {set start [$ctext index anchor]}]} {
4542 set start @0,[winfo height $ctext]
4544 set match [$ctext search -backwards -count ml -- $searchstring $start]
4545 $ctext tag remove sel 1.0 end
4546 if {$match eq {}} {
4547 bell
4548 return
4550 $ctext see $match
4551 set mend "$match + $ml c"
4552 $ctext tag add sel $match $mend
4553 $ctext mark unset anchor
4557 proc searchmark {first last} {
4558 global ctext searchstring
4560 set mend $first.0
4561 while {1} {
4562 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4563 if {$match eq {}} break
4564 set mend "$match + $mlen c"
4565 $ctext tag add found $match $mend
4569 proc searchmarkvisible {doall} {
4570 global ctext smarktop smarkbot
4572 set topline [lindex [split [$ctext index @0,0] .] 0]
4573 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4574 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4575 # no overlap with previous
4576 searchmark $topline $botline
4577 set smarktop $topline
4578 set smarkbot $botline
4579 } else {
4580 if {$topline < $smarktop} {
4581 searchmark $topline [expr {$smarktop-1}]
4582 set smarktop $topline
4584 if {$botline > $smarkbot} {
4585 searchmark [expr {$smarkbot+1}] $botline
4586 set smarkbot $botline
4591 proc scrolltext {f0 f1} {
4592 global searchstring
4594 .ctop.cdet.left.sb set $f0 $f1
4595 if {$searchstring ne {}} {
4596 searchmarkvisible 0
4600 proc setcoords {} {
4601 global linespc charspc canvx0 canvy0 mainfont
4602 global xspc1 xspc2 lthickness
4604 set linespc [font metrics $mainfont -linespace]
4605 set charspc [font measure $mainfont "m"]
4606 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4607 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4608 set lthickness [expr {int($linespc / 9) + 1}]
4609 set xspc1(0) $linespc
4610 set xspc2 $linespc
4613 proc redisplay {} {
4614 global canv
4615 global selectedline
4617 set ymax [lindex [$canv cget -scrollregion] 3]
4618 if {$ymax eq {} || $ymax == 0} return
4619 set span [$canv yview]
4620 clear_display
4621 setcanvscroll
4622 allcanvs yview moveto [lindex $span 0]
4623 drawvisible
4624 if {[info exists selectedline]} {
4625 selectline $selectedline 0
4626 allcanvs yview moveto [lindex $span 0]
4630 proc incrfont {inc} {
4631 global mainfont textfont ctext canv phase
4632 global stopped entries
4633 unmarkmatches
4634 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4635 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4636 setcoords
4637 $ctext conf -font $textfont
4638 $ctext tag conf filesep -font [concat $textfont bold]
4639 foreach e $entries {
4640 $e conf -font $mainfont
4642 if {$phase eq "getcommits"} {
4643 $canv itemconf textitems -font $mainfont
4645 redisplay
4648 proc clearsha1 {} {
4649 global sha1entry sha1string
4650 if {[string length $sha1string] == 40} {
4651 $sha1entry delete 0 end
4655 proc sha1change {n1 n2 op} {
4656 global sha1string currentid sha1but
4657 if {$sha1string == {}
4658 || ([info exists currentid] && $sha1string == $currentid)} {
4659 set state disabled
4660 } else {
4661 set state normal
4663 if {[$sha1but cget -state] == $state} return
4664 if {$state == "normal"} {
4665 $sha1but conf -state normal -relief raised -text "Goto: "
4666 } else {
4667 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4671 proc gotocommit {} {
4672 global sha1string currentid commitrow tagids headids
4673 global displayorder numcommits curview
4675 if {$sha1string == {}
4676 || ([info exists currentid] && $sha1string == $currentid)} return
4677 if {[info exists tagids($sha1string)]} {
4678 set id $tagids($sha1string)
4679 } elseif {[info exists headids($sha1string)]} {
4680 set id $headids($sha1string)
4681 } else {
4682 set id [string tolower $sha1string]
4683 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4684 set matches {}
4685 foreach i $displayorder {
4686 if {[string match $id* $i]} {
4687 lappend matches $i
4690 if {$matches ne {}} {
4691 if {[llength $matches] > 1} {
4692 error_popup "Short SHA1 id $id is ambiguous"
4693 return
4695 set id [lindex $matches 0]
4699 if {[info exists commitrow($curview,$id)]} {
4700 selectline $commitrow($curview,$id) 1
4701 return
4703 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4704 set type "SHA1 id"
4705 } else {
4706 set type "Tag/Head"
4708 error_popup "$type $sha1string is not known"
4711 proc lineenter {x y id} {
4712 global hoverx hovery hoverid hovertimer
4713 global commitinfo canv
4715 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4716 set hoverx $x
4717 set hovery $y
4718 set hoverid $id
4719 if {[info exists hovertimer]} {
4720 after cancel $hovertimer
4722 set hovertimer [after 500 linehover]
4723 $canv delete hover
4726 proc linemotion {x y id} {
4727 global hoverx hovery hoverid hovertimer
4729 if {[info exists hoverid] && $id == $hoverid} {
4730 set hoverx $x
4731 set hovery $y
4732 if {[info exists hovertimer]} {
4733 after cancel $hovertimer
4735 set hovertimer [after 500 linehover]
4739 proc lineleave {id} {
4740 global hoverid hovertimer canv
4742 if {[info exists hoverid] && $id == $hoverid} {
4743 $canv delete hover
4744 if {[info exists hovertimer]} {
4745 after cancel $hovertimer
4746 unset hovertimer
4748 unset hoverid
4752 proc linehover {} {
4753 global hoverx hovery hoverid hovertimer
4754 global canv linespc lthickness
4755 global commitinfo mainfont
4757 set text [lindex $commitinfo($hoverid) 0]
4758 set ymax [lindex [$canv cget -scrollregion] 3]
4759 if {$ymax == {}} return
4760 set yfrac [lindex [$canv yview] 0]
4761 set x [expr {$hoverx + 2 * $linespc}]
4762 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4763 set x0 [expr {$x - 2 * $lthickness}]
4764 set y0 [expr {$y - 2 * $lthickness}]
4765 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4766 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4767 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4768 -fill \#ffff80 -outline black -width 1 -tags hover]
4769 $canv raise $t
4770 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4771 -font $mainfont]
4772 $canv raise $t
4775 proc clickisonarrow {id y} {
4776 global lthickness
4778 set ranges [rowranges $id]
4779 set thresh [expr {2 * $lthickness + 6}]
4780 set n [expr {[llength $ranges] - 1}]
4781 for {set i 1} {$i < $n} {incr i} {
4782 set row [lindex $ranges $i]
4783 if {abs([yc $row] - $y) < $thresh} {
4784 return $i
4787 return {}
4790 proc arrowjump {id n y} {
4791 global canv
4793 # 1 <-> 2, 3 <-> 4, etc...
4794 set n [expr {(($n - 1) ^ 1) + 1}]
4795 set row [lindex [rowranges $id] $n]
4796 set yt [yc $row]
4797 set ymax [lindex [$canv cget -scrollregion] 3]
4798 if {$ymax eq {} || $ymax <= 0} return
4799 set view [$canv yview]
4800 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4801 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4802 if {$yfrac < 0} {
4803 set yfrac 0
4805 allcanvs yview moveto $yfrac
4808 proc lineclick {x y id isnew} {
4809 global ctext commitinfo children canv thickerline curview
4811 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4812 unmarkmatches
4813 unselectline
4814 normalline
4815 $canv delete hover
4816 # draw this line thicker than normal
4817 set thickerline $id
4818 drawlines $id
4819 if {$isnew} {
4820 set ymax [lindex [$canv cget -scrollregion] 3]
4821 if {$ymax eq {}} return
4822 set yfrac [lindex [$canv yview] 0]
4823 set y [expr {$y + $yfrac * $ymax}]
4825 set dirn [clickisonarrow $id $y]
4826 if {$dirn ne {}} {
4827 arrowjump $id $dirn $y
4828 return
4831 if {$isnew} {
4832 addtohistory [list lineclick $x $y $id 0]
4834 # fill the details pane with info about this line
4835 $ctext conf -state normal
4836 clear_ctext
4837 $ctext tag conf link -foreground blue -underline 1
4838 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4839 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4840 $ctext insert end "Parent:\t"
4841 $ctext insert end $id [list link link0]
4842 $ctext tag bind link0 <1> [list selbyid $id]
4843 set info $commitinfo($id)
4844 $ctext insert end "\n\t[lindex $info 0]\n"
4845 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4846 set date [formatdate [lindex $info 2]]
4847 $ctext insert end "\tDate:\t$date\n"
4848 set kids $children($curview,$id)
4849 if {$kids ne {}} {
4850 $ctext insert end "\nChildren:"
4851 set i 0
4852 foreach child $kids {
4853 incr i
4854 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4855 set info $commitinfo($child)
4856 $ctext insert end "\n\t"
4857 $ctext insert end $child [list link link$i]
4858 $ctext tag bind link$i <1> [list selbyid $child]
4859 $ctext insert end "\n\t[lindex $info 0]"
4860 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4861 set date [formatdate [lindex $info 2]]
4862 $ctext insert end "\n\tDate:\t$date\n"
4865 $ctext conf -state disabled
4866 init_flist {}
4869 proc normalline {} {
4870 global thickerline
4871 if {[info exists thickerline]} {
4872 set id $thickerline
4873 unset thickerline
4874 drawlines $id
4878 proc selbyid {id} {
4879 global commitrow curview
4880 if {[info exists commitrow($curview,$id)]} {
4881 selectline $commitrow($curview,$id) 1
4885 proc mstime {} {
4886 global startmstime
4887 if {![info exists startmstime]} {
4888 set startmstime [clock clicks -milliseconds]
4890 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4893 proc rowmenu {x y id} {
4894 global rowctxmenu commitrow selectedline rowmenuid curview
4896 if {![info exists selectedline]
4897 || $commitrow($curview,$id) eq $selectedline} {
4898 set state disabled
4899 } else {
4900 set state normal
4902 $rowctxmenu entryconfigure "Diff this*" -state $state
4903 $rowctxmenu entryconfigure "Diff selected*" -state $state
4904 $rowctxmenu entryconfigure "Make patch" -state $state
4905 set rowmenuid $id
4906 tk_popup $rowctxmenu $x $y
4909 proc diffvssel {dirn} {
4910 global rowmenuid selectedline displayorder
4912 if {![info exists selectedline]} return
4913 if {$dirn} {
4914 set oldid [lindex $displayorder $selectedline]
4915 set newid $rowmenuid
4916 } else {
4917 set oldid $rowmenuid
4918 set newid [lindex $displayorder $selectedline]
4920 addtohistory [list doseldiff $oldid $newid]
4921 doseldiff $oldid $newid
4924 proc doseldiff {oldid newid} {
4925 global ctext
4926 global commitinfo
4928 $ctext conf -state normal
4929 clear_ctext
4930 init_flist "Top"
4931 $ctext insert end "From "
4932 $ctext tag conf link -foreground blue -underline 1
4933 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4934 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4935 $ctext tag bind link0 <1> [list selbyid $oldid]
4936 $ctext insert end $oldid [list link link0]
4937 $ctext insert end "\n "
4938 $ctext insert end [lindex $commitinfo($oldid) 0]
4939 $ctext insert end "\n\nTo "
4940 $ctext tag bind link1 <1> [list selbyid $newid]
4941 $ctext insert end $newid [list link link1]
4942 $ctext insert end "\n "
4943 $ctext insert end [lindex $commitinfo($newid) 0]
4944 $ctext insert end "\n"
4945 $ctext conf -state disabled
4946 $ctext tag delete Comments
4947 $ctext tag remove found 1.0 end
4948 startdiff [list $oldid $newid]
4951 proc mkpatch {} {
4952 global rowmenuid currentid commitinfo patchtop patchnum
4954 if {![info exists currentid]} return
4955 set oldid $currentid
4956 set oldhead [lindex $commitinfo($oldid) 0]
4957 set newid $rowmenuid
4958 set newhead [lindex $commitinfo($newid) 0]
4959 set top .patch
4960 set patchtop $top
4961 catch {destroy $top}
4962 toplevel $top
4963 label $top.title -text "Generate patch"
4964 grid $top.title - -pady 10
4965 label $top.from -text "From:"
4966 entry $top.fromsha1 -width 40 -relief flat
4967 $top.fromsha1 insert 0 $oldid
4968 $top.fromsha1 conf -state readonly
4969 grid $top.from $top.fromsha1 -sticky w
4970 entry $top.fromhead -width 60 -relief flat
4971 $top.fromhead insert 0 $oldhead
4972 $top.fromhead conf -state readonly
4973 grid x $top.fromhead -sticky w
4974 label $top.to -text "To:"
4975 entry $top.tosha1 -width 40 -relief flat
4976 $top.tosha1 insert 0 $newid
4977 $top.tosha1 conf -state readonly
4978 grid $top.to $top.tosha1 -sticky w
4979 entry $top.tohead -width 60 -relief flat
4980 $top.tohead insert 0 $newhead
4981 $top.tohead conf -state readonly
4982 grid x $top.tohead -sticky w
4983 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4984 grid $top.rev x -pady 10
4985 label $top.flab -text "Output file:"
4986 entry $top.fname -width 60
4987 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4988 incr patchnum
4989 grid $top.flab $top.fname -sticky w
4990 frame $top.buts
4991 button $top.buts.gen -text "Generate" -command mkpatchgo
4992 button $top.buts.can -text "Cancel" -command mkpatchcan
4993 grid $top.buts.gen $top.buts.can
4994 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4995 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4996 grid $top.buts - -pady 10 -sticky ew
4997 focus $top.fname
5000 proc mkpatchrev {} {
5001 global patchtop
5003 set oldid [$patchtop.fromsha1 get]
5004 set oldhead [$patchtop.fromhead get]
5005 set newid [$patchtop.tosha1 get]
5006 set newhead [$patchtop.tohead get]
5007 foreach e [list fromsha1 fromhead tosha1 tohead] \
5008 v [list $newid $newhead $oldid $oldhead] {
5009 $patchtop.$e conf -state normal
5010 $patchtop.$e delete 0 end
5011 $patchtop.$e insert 0 $v
5012 $patchtop.$e conf -state readonly
5016 proc mkpatchgo {} {
5017 global patchtop
5019 set oldid [$patchtop.fromsha1 get]
5020 set newid [$patchtop.tosha1 get]
5021 set fname [$patchtop.fname get]
5022 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5023 error_popup "Error creating patch: $err"
5025 catch {destroy $patchtop}
5026 unset patchtop
5029 proc mkpatchcan {} {
5030 global patchtop
5032 catch {destroy $patchtop}
5033 unset patchtop
5036 proc mktag {} {
5037 global rowmenuid mktagtop commitinfo
5039 set top .maketag
5040 set mktagtop $top
5041 catch {destroy $top}
5042 toplevel $top
5043 label $top.title -text "Create tag"
5044 grid $top.title - -pady 10
5045 label $top.id -text "ID:"
5046 entry $top.sha1 -width 40 -relief flat
5047 $top.sha1 insert 0 $rowmenuid
5048 $top.sha1 conf -state readonly
5049 grid $top.id $top.sha1 -sticky w
5050 entry $top.head -width 60 -relief flat
5051 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5052 $top.head conf -state readonly
5053 grid x $top.head -sticky w
5054 label $top.tlab -text "Tag name:"
5055 entry $top.tag -width 60
5056 grid $top.tlab $top.tag -sticky w
5057 frame $top.buts
5058 button $top.buts.gen -text "Create" -command mktaggo
5059 button $top.buts.can -text "Cancel" -command mktagcan
5060 grid $top.buts.gen $top.buts.can
5061 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5062 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5063 grid $top.buts - -pady 10 -sticky ew
5064 focus $top.tag
5067 proc domktag {} {
5068 global mktagtop env tagids idtags
5070 set id [$mktagtop.sha1 get]
5071 set tag [$mktagtop.tag get]
5072 if {$tag == {}} {
5073 error_popup "No tag name specified"
5074 return
5076 if {[info exists tagids($tag)]} {
5077 error_popup "Tag \"$tag\" already exists"
5078 return
5080 if {[catch {
5081 set dir [gitdir]
5082 set fname [file join $dir "refs/tags" $tag]
5083 set f [open $fname w]
5084 puts $f $id
5085 close $f
5086 } err]} {
5087 error_popup "Error creating tag: $err"
5088 return
5091 set tagids($tag) $id
5092 lappend idtags($id) $tag
5093 redrawtags $id
5094 addedtag $id
5097 proc redrawtags {id} {
5098 global canv linehtag commitrow idpos selectedline curview
5099 global mainfont canvxmax
5101 if {![info exists commitrow($curview,$id)]} return
5102 drawcmitrow $commitrow($curview,$id)
5103 $canv delete tag.$id
5104 set xt [eval drawtags $id $idpos($id)]
5105 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5106 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5107 set xr [expr {$xt + [font measure $mainfont $text]}]
5108 if {$xr > $canvxmax} {
5109 set canvxmax $xr
5110 setcanvscroll
5112 if {[info exists selectedline]
5113 && $selectedline == $commitrow($curview,$id)} {
5114 selectline $selectedline 0
5118 proc mktagcan {} {
5119 global mktagtop
5121 catch {destroy $mktagtop}
5122 unset mktagtop
5125 proc mktaggo {} {
5126 domktag
5127 mktagcan
5130 proc writecommit {} {
5131 global rowmenuid wrcomtop commitinfo wrcomcmd
5133 set top .writecommit
5134 set wrcomtop $top
5135 catch {destroy $top}
5136 toplevel $top
5137 label $top.title -text "Write commit to file"
5138 grid $top.title - -pady 10
5139 label $top.id -text "ID:"
5140 entry $top.sha1 -width 40 -relief flat
5141 $top.sha1 insert 0 $rowmenuid
5142 $top.sha1 conf -state readonly
5143 grid $top.id $top.sha1 -sticky w
5144 entry $top.head -width 60 -relief flat
5145 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5146 $top.head conf -state readonly
5147 grid x $top.head -sticky w
5148 label $top.clab -text "Command:"
5149 entry $top.cmd -width 60 -textvariable wrcomcmd
5150 grid $top.clab $top.cmd -sticky w -pady 10
5151 label $top.flab -text "Output file:"
5152 entry $top.fname -width 60
5153 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5154 grid $top.flab $top.fname -sticky w
5155 frame $top.buts
5156 button $top.buts.gen -text "Write" -command wrcomgo
5157 button $top.buts.can -text "Cancel" -command wrcomcan
5158 grid $top.buts.gen $top.buts.can
5159 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5160 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5161 grid $top.buts - -pady 10 -sticky ew
5162 focus $top.fname
5165 proc wrcomgo {} {
5166 global wrcomtop
5168 set id [$wrcomtop.sha1 get]
5169 set cmd "echo $id | [$wrcomtop.cmd get]"
5170 set fname [$wrcomtop.fname get]
5171 if {[catch {exec sh -c $cmd >$fname &} err]} {
5172 error_popup "Error writing commit: $err"
5174 catch {destroy $wrcomtop}
5175 unset wrcomtop
5178 proc wrcomcan {} {
5179 global wrcomtop
5181 catch {destroy $wrcomtop}
5182 unset wrcomtop
5185 proc mkbranch {} {
5186 global rowmenuid mkbrtop
5188 set top .makebranch
5189 catch {destroy $top}
5190 toplevel $top
5191 label $top.title -text "Create new branch"
5192 grid $top.title - -pady 10
5193 label $top.id -text "ID:"
5194 entry $top.sha1 -width 40 -relief flat
5195 $top.sha1 insert 0 $rowmenuid
5196 $top.sha1 conf -state readonly
5197 grid $top.id $top.sha1 -sticky w
5198 label $top.nlab -text "Name:"
5199 entry $top.name -width 40
5200 grid $top.nlab $top.name -sticky w
5201 frame $top.buts
5202 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5203 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5204 grid $top.buts.go $top.buts.can
5205 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5206 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5207 grid $top.buts - -pady 10 -sticky ew
5208 focus $top.name
5211 proc mkbrgo {top} {
5212 global headids idheads
5214 set name [$top.name get]
5215 set id [$top.sha1 get]
5216 if {$name eq {}} {
5217 error_popup "Please specify a name for the new branch"
5218 return
5220 catch {destroy $top}
5221 nowbusy newbranch
5222 update
5223 if {[catch {
5224 exec git branch $name $id
5225 } err]} {
5226 notbusy newbranch
5227 error_popup $err
5228 } else {
5229 addedhead $id $name
5230 # XXX should update list of heads displayed for selected commit
5231 notbusy newbranch
5232 redrawtags $id
5236 proc cherrypick {} {
5237 global rowmenuid curview commitrow
5238 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5240 if {[info exists desc_heads($rowmenuid)]
5241 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5242 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5243 included in branch $mainhead -- really re-apply it?"]
5244 if {!$ok} return
5246 nowbusy cherrypick
5247 update
5248 set oldhead [exec git rev-parse HEAD]
5249 # Unfortunately git-cherry-pick writes stuff to stderr even when
5250 # no error occurs, and exec takes that as an indication of error...
5251 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5252 notbusy cherrypick
5253 error_popup $err
5254 return
5256 set newhead [exec git rev-parse HEAD]
5257 if {$newhead eq $oldhead} {
5258 notbusy cherrypick
5259 error_popup "No changes committed"
5260 return
5262 set allparents($newhead) $oldhead
5263 lappend allchildren($oldhead) $newhead
5264 set desc_heads($newhead) $mainhead
5265 if {[info exists anc_tags($oldhead)]} {
5266 set anc_tags($newhead) $anc_tags($oldhead)
5268 set desc_tags($newhead) {}
5269 if {[info exists commitrow($curview,$oldhead)]} {
5270 insertrow $commitrow($curview,$oldhead) $newhead
5271 if {$mainhead ne {}} {
5272 movedhead $newhead $mainhead
5274 redrawtags $oldhead
5275 redrawtags $newhead
5277 notbusy cherrypick
5280 # context menu for a head
5281 proc headmenu {x y id head} {
5282 global headmenuid headmenuhead headctxmenu
5284 set headmenuid $id
5285 set headmenuhead $head
5286 tk_popup $headctxmenu $x $y
5289 proc cobranch {} {
5290 global headmenuid headmenuhead mainhead headids
5292 # check the tree is clean first??
5293 set oldmainhead $mainhead
5294 nowbusy checkout
5295 update
5296 if {[catch {
5297 exec git checkout $headmenuhead
5298 } err]} {
5299 notbusy checkout
5300 error_popup $err
5301 } else {
5302 notbusy checkout
5303 set mainhead $headmenuhead
5304 if {[info exists headids($oldmainhead)]} {
5305 redrawtags $headids($oldmainhead)
5307 redrawtags $headmenuid
5311 proc rmbranch {} {
5312 global desc_heads headmenuid headmenuhead mainhead
5313 global headids idheads
5315 set head $headmenuhead
5316 set id $headmenuid
5317 if {$head eq $mainhead} {
5318 error_popup "Cannot delete the currently checked-out branch"
5319 return
5321 if {$desc_heads($id) eq $head} {
5322 # the stuff on this branch isn't on any other branch
5323 if {![confirm_popup "The commits on branch $head aren't on any other\
5324 branch.\nReally delete branch $head?"]} return
5326 nowbusy rmbranch
5327 update
5328 if {[catch {exec git branch -D $head} err]} {
5329 notbusy rmbranch
5330 error_popup $err
5331 return
5333 removedhead $id $head
5334 redrawtags $id
5335 notbusy rmbranch
5338 # Stuff for finding nearby tags
5339 proc getallcommits {} {
5340 global allcstart allcommits allcfd allids
5342 set allids {}
5343 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5344 set allcfd $fd
5345 fconfigure $fd -blocking 0
5346 set allcommits "reading"
5347 nowbusy allcommits
5348 restartgetall $fd
5351 proc discardallcommits {} {
5352 global allparents allchildren allcommits allcfd
5353 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5355 if {![info exists allcommits]} return
5356 if {$allcommits eq "reading"} {
5357 catch {close $allcfd}
5359 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5360 alldtags tagisdesc desc_heads} {
5361 catch {unset $v}
5365 proc restartgetall {fd} {
5366 global allcstart
5368 fileevent $fd readable [list getallclines $fd]
5369 set allcstart [clock clicks -milliseconds]
5372 proc combine_dtags {l1 l2} {
5373 global tagisdesc notfirstd
5375 set res [lsort -unique [concat $l1 $l2]]
5376 for {set i 0} {$i < [llength $res]} {incr i} {
5377 set x [lindex $res $i]
5378 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5379 set y [lindex $res $j]
5380 if {[info exists tagisdesc($x,$y)]} {
5381 if {$tagisdesc($x,$y) > 0} {
5382 # x is a descendent of y, exclude x
5383 set res [lreplace $res $i $i]
5384 incr i -1
5385 break
5386 } else {
5387 # y is a descendent of x, exclude y
5388 set res [lreplace $res $j $j]
5390 } else {
5391 # no relation, keep going
5392 incr j
5396 return $res
5399 proc combine_atags {l1 l2} {
5400 global tagisdesc
5402 set res [lsort -unique [concat $l1 $l2]]
5403 for {set i 0} {$i < [llength $res]} {incr i} {
5404 set x [lindex $res $i]
5405 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5406 set y [lindex $res $j]
5407 if {[info exists tagisdesc($x,$y)]} {
5408 if {$tagisdesc($x,$y) < 0} {
5409 # x is an ancestor of y, exclude x
5410 set res [lreplace $res $i $i]
5411 incr i -1
5412 break
5413 } else {
5414 # y is an ancestor of x, exclude y
5415 set res [lreplace $res $j $j]
5417 } else {
5418 # no relation, keep going
5419 incr j
5423 return $res
5426 proc forward_pass {id children} {
5427 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5429 set dtags {}
5430 set dheads {}
5431 foreach child $children {
5432 if {[info exists idtags($child)]} {
5433 set ctags [list $child]
5434 } else {
5435 set ctags $desc_tags($child)
5437 if {$dtags eq {}} {
5438 set dtags $ctags
5439 } elseif {$ctags ne $dtags} {
5440 set dtags [combine_dtags $dtags $ctags]
5442 set cheads $desc_heads($child)
5443 if {$dheads eq {}} {
5444 set dheads $cheads
5445 } elseif {$cheads ne $dheads} {
5446 set dheads [lsort -unique [concat $dheads $cheads]]
5449 set desc_tags($id) $dtags
5450 if {[info exists idtags($id)]} {
5451 set adt $dtags
5452 foreach tag $dtags {
5453 set adt [concat $adt $alldtags($tag)]
5455 set adt [lsort -unique $adt]
5456 set alldtags($id) $adt
5457 foreach tag $adt {
5458 set tagisdesc($id,$tag) -1
5459 set tagisdesc($tag,$id) 1
5462 if {[info exists idheads($id)]} {
5463 set dheads [concat $dheads $idheads($id)]
5465 set desc_heads($id) $dheads
5468 proc getallclines {fd} {
5469 global allparents allchildren allcommits allcstart
5470 global desc_tags anc_tags idtags tagisdesc allids
5471 global idheads travindex
5473 while {[gets $fd line] >= 0} {
5474 set id [lindex $line 0]
5475 lappend allids $id
5476 set olds [lrange $line 1 end]
5477 set allparents($id) $olds
5478 if {![info exists allchildren($id)]} {
5479 set allchildren($id) {}
5481 foreach p $olds {
5482 lappend allchildren($p) $id
5484 # compute nearest tagged descendents as we go
5485 # also compute descendent heads
5486 forward_pass $id $allchildren($id)
5487 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5488 fileevent $fd readable {}
5489 after idle restartgetall $fd
5490 return
5493 if {[eof $fd]} {
5494 set travindex [llength $allids]
5495 set allcommits "traversing"
5496 after idle restartatags
5497 if {[catch {close $fd} err]} {
5498 error_popup "Error reading full commit graph: $err.\n\
5499 Results may be incomplete."
5504 # walk backward through the tree and compute nearest tagged ancestors
5505 proc restartatags {} {
5506 global allids allparents idtags anc_tags travindex
5508 set t0 [clock clicks -milliseconds]
5509 set i $travindex
5510 while {[incr i -1] >= 0} {
5511 set id [lindex $allids $i]
5512 set atags {}
5513 foreach p $allparents($id) {
5514 if {[info exists idtags($p)]} {
5515 set ptags [list $p]
5516 } else {
5517 set ptags $anc_tags($p)
5519 if {$atags eq {}} {
5520 set atags $ptags
5521 } elseif {$ptags ne $atags} {
5522 set atags [combine_atags $atags $ptags]
5525 set anc_tags($id) $atags
5526 if {[clock clicks -milliseconds] - $t0 >= 50} {
5527 set travindex $i
5528 after idle restartatags
5529 return
5532 set allcommits "done"
5533 set travindex 0
5534 notbusy allcommits
5535 dispneartags
5538 # update the desc_tags and anc_tags arrays for a new tag just added
5539 proc addedtag {id} {
5540 global desc_tags anc_tags allparents allchildren allcommits
5541 global idtags tagisdesc alldtags
5543 if {![info exists desc_tags($id)]} return
5544 set adt $desc_tags($id)
5545 foreach t $desc_tags($id) {
5546 set adt [concat $adt $alldtags($t)]
5548 set adt [lsort -unique $adt]
5549 set alldtags($id) $adt
5550 foreach t $adt {
5551 set tagisdesc($id,$t) -1
5552 set tagisdesc($t,$id) 1
5554 if {[info exists anc_tags($id)]} {
5555 set todo $anc_tags($id)
5556 while {$todo ne {}} {
5557 set do [lindex $todo 0]
5558 set todo [lrange $todo 1 end]
5559 if {[info exists tagisdesc($id,$do)]} continue
5560 set tagisdesc($do,$id) -1
5561 set tagisdesc($id,$do) 1
5562 if {[info exists anc_tags($do)]} {
5563 set todo [concat $todo $anc_tags($do)]
5568 set lastold $desc_tags($id)
5569 set lastnew [list $id]
5570 set nup 0
5571 set nch 0
5572 set todo $allparents($id)
5573 while {$todo ne {}} {
5574 set do [lindex $todo 0]
5575 set todo [lrange $todo 1 end]
5576 if {![info exists desc_tags($do)]} continue
5577 if {$desc_tags($do) ne $lastold} {
5578 set lastold $desc_tags($do)
5579 set lastnew [combine_dtags $lastold [list $id]]
5580 incr nch
5582 if {$lastold eq $lastnew} continue
5583 set desc_tags($do) $lastnew
5584 incr nup
5585 if {![info exists idtags($do)]} {
5586 set todo [concat $todo $allparents($do)]
5590 if {![info exists anc_tags($id)]} return
5591 set lastold $anc_tags($id)
5592 set lastnew [list $id]
5593 set nup 0
5594 set nch 0
5595 set todo $allchildren($id)
5596 while {$todo ne {}} {
5597 set do [lindex $todo 0]
5598 set todo [lrange $todo 1 end]
5599 if {![info exists anc_tags($do)]} continue
5600 if {$anc_tags($do) ne $lastold} {
5601 set lastold $anc_tags($do)
5602 set lastnew [combine_atags $lastold [list $id]]
5603 incr nch
5605 if {$lastold eq $lastnew} continue
5606 set anc_tags($do) $lastnew
5607 incr nup
5608 if {![info exists idtags($do)]} {
5609 set todo [concat $todo $allchildren($do)]
5614 # update the desc_heads array for a new head just added
5615 proc addedhead {hid head} {
5616 global desc_heads allparents headids idheads
5618 set headids($head) $hid
5619 lappend idheads($hid) $head
5621 set todo [list $hid]
5622 while {$todo ne {}} {
5623 set do [lindex $todo 0]
5624 set todo [lrange $todo 1 end]
5625 if {![info exists desc_heads($do)] ||
5626 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5627 set oldheads $desc_heads($do)
5628 lappend desc_heads($do) $head
5629 set heads $desc_heads($do)
5630 while {1} {
5631 set p $allparents($do)
5632 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5633 $desc_heads($p) ne $oldheads} break
5634 set do $p
5635 set desc_heads($do) $heads
5637 set todo [concat $todo $p]
5641 # update the desc_heads array for a head just removed
5642 proc removedhead {hid head} {
5643 global desc_heads allparents headids idheads
5645 unset headids($head)
5646 if {$idheads($hid) eq $head} {
5647 unset idheads($hid)
5648 } else {
5649 set i [lsearch -exact $idheads($hid) $head]
5650 if {$i >= 0} {
5651 set idheads($hid) [lreplace $idheads($hid) $i $i]
5655 set todo [list $hid]
5656 while {$todo ne {}} {
5657 set do [lindex $todo 0]
5658 set todo [lrange $todo 1 end]
5659 if {![info exists desc_heads($do)]} continue
5660 set i [lsearch -exact $desc_heads($do) $head]
5661 if {$i < 0} continue
5662 set oldheads $desc_heads($do)
5663 set heads [lreplace $desc_heads($do) $i $i]
5664 while {1} {
5665 set desc_heads($do) $heads
5666 set p $allparents($do)
5667 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5668 $desc_heads($p) ne $oldheads} break
5669 set do $p
5671 set todo [concat $todo $p]
5675 # update things for a head moved to a child of its previous location
5676 proc movedhead {id name} {
5677 global headids idheads
5679 set oldid $headids($name)
5680 set headids($name) $id
5681 if {$idheads($oldid) eq $name} {
5682 unset idheads($oldid)
5683 } else {
5684 set i [lsearch -exact $idheads($oldid) $name]
5685 if {$i >= 0} {
5686 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5689 lappend idheads($id) $name
5692 proc changedrefs {} {
5693 global desc_heads desc_tags anc_tags allcommits allids
5694 global allchildren allparents idtags travindex
5696 if {![info exists allcommits]} return
5697 catch {unset desc_heads}
5698 catch {unset desc_tags}
5699 catch {unset anc_tags}
5700 catch {unset alldtags}
5701 catch {unset tagisdesc}
5702 foreach id $allids {
5703 forward_pass $id $allchildren($id)
5705 if {$allcommits ne "reading"} {
5706 set travindex [llength $allids]
5707 if {$allcommits ne "traversing"} {
5708 set allcommits "traversing"
5709 after idle restartatags
5714 proc rereadrefs {} {
5715 global idtags idheads idotherrefs mainhead
5717 set refids [concat [array names idtags] \
5718 [array names idheads] [array names idotherrefs]]
5719 foreach id $refids {
5720 if {![info exists ref($id)]} {
5721 set ref($id) [listrefs $id]
5724 set oldmainhead $mainhead
5725 readrefs
5726 changedrefs
5727 set refids [lsort -unique [concat $refids [array names idtags] \
5728 [array names idheads] [array names idotherrefs]]]
5729 foreach id $refids {
5730 set v [listrefs $id]
5731 if {![info exists ref($id)] || $ref($id) != $v ||
5732 ($id eq $oldmainhead && $id ne $mainhead) ||
5733 ($id eq $mainhead && $id ne $oldmainhead)} {
5734 redrawtags $id
5739 proc listrefs {id} {
5740 global idtags idheads idotherrefs
5742 set x {}
5743 if {[info exists idtags($id)]} {
5744 set x $idtags($id)
5746 set y {}
5747 if {[info exists idheads($id)]} {
5748 set y $idheads($id)
5750 set z {}
5751 if {[info exists idotherrefs($id)]} {
5752 set z $idotherrefs($id)
5754 return [list $x $y $z]
5757 proc showtag {tag isnew} {
5758 global ctext tagcontents tagids linknum
5760 if {$isnew} {
5761 addtohistory [list showtag $tag 0]
5763 $ctext conf -state normal
5764 clear_ctext
5765 set linknum 0
5766 if {[info exists tagcontents($tag)]} {
5767 set text $tagcontents($tag)
5768 } else {
5769 set text "Tag: $tag\nId: $tagids($tag)"
5771 appendwithlinks $text {}
5772 $ctext conf -state disabled
5773 init_flist {}
5776 proc doquit {} {
5777 global stopped
5778 set stopped 100
5779 destroy .
5782 proc doprefs {} {
5783 global maxwidth maxgraphpct diffopts
5784 global oldprefs prefstop showneartags
5785 global bgcolor fgcolor ctext diffcolors
5787 set top .gitkprefs
5788 set prefstop $top
5789 if {[winfo exists $top]} {
5790 raise $top
5791 return
5793 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5794 set oldprefs($v) [set $v]
5796 toplevel $top
5797 wm title $top "Gitk preferences"
5798 label $top.ldisp -text "Commit list display options"
5799 grid $top.ldisp - -sticky w -pady 10
5800 label $top.spacer -text " "
5801 label $top.maxwidthl -text "Maximum graph width (lines)" \
5802 -font optionfont
5803 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5804 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5805 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5806 -font optionfont
5807 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5808 grid x $top.maxpctl $top.maxpct -sticky w
5810 label $top.ddisp -text "Diff display options"
5811 grid $top.ddisp - -sticky w -pady 10
5812 label $top.diffoptl -text "Options for diff program" \
5813 -font optionfont
5814 entry $top.diffopt -width 20 -textvariable diffopts
5815 grid x $top.diffoptl $top.diffopt -sticky w
5816 frame $top.ntag
5817 label $top.ntag.l -text "Display nearby tags" -font optionfont
5818 checkbutton $top.ntag.b -variable showneartags
5819 pack $top.ntag.b $top.ntag.l -side left
5820 grid x $top.ntag -sticky w
5822 label $top.cdisp -text "Colors: press to choose"
5823 grid $top.cdisp - -sticky w -pady 10
5824 label $top.bg -padx 40 -relief sunk -background $bgcolor
5825 button $top.bgbut -text "Background" -font optionfont \
5826 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5827 grid x $top.bgbut $top.bg -sticky w
5828 label $top.fg -padx 40 -relief sunk -background $fgcolor
5829 button $top.fgbut -text "Foreground" -font optionfont \
5830 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5831 grid x $top.fgbut $top.fg -sticky w
5832 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5833 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5834 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5835 [list $ctext tag conf d0 -foreground]]
5836 grid x $top.diffoldbut $top.diffold -sticky w
5837 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5838 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5839 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5840 [list $ctext tag conf d1 -foreground]]
5841 grid x $top.diffnewbut $top.diffnew -sticky w
5842 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5843 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5844 -command [list choosecolor diffcolors 2 $top.hunksep \
5845 "diff hunk header" \
5846 [list $ctext tag conf hunksep -foreground]]
5847 grid x $top.hunksepbut $top.hunksep -sticky w
5849 frame $top.buts
5850 button $top.buts.ok -text "OK" -command prefsok
5851 button $top.buts.can -text "Cancel" -command prefscan
5852 grid $top.buts.ok $top.buts.can
5853 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5854 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5855 grid $top.buts - - -pady 10 -sticky ew
5858 proc choosecolor {v vi w x cmd} {
5859 global $v
5861 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5862 -title "Gitk: choose color for $x"]
5863 if {$c eq {}} return
5864 $w conf -background $c
5865 lset $v $vi $c
5866 eval $cmd $c
5869 proc setbg {c} {
5870 global bglist
5872 foreach w $bglist {
5873 $w conf -background $c
5877 proc setfg {c} {
5878 global fglist canv
5880 foreach w $fglist {
5881 $w conf -foreground $c
5883 allcanvs itemconf text -fill $c
5884 $canv itemconf circle -outline $c
5887 proc prefscan {} {
5888 global maxwidth maxgraphpct diffopts
5889 global oldprefs prefstop showneartags
5891 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5892 set $v $oldprefs($v)
5894 catch {destroy $prefstop}
5895 unset prefstop
5898 proc prefsok {} {
5899 global maxwidth maxgraphpct
5900 global oldprefs prefstop showneartags
5902 catch {destroy $prefstop}
5903 unset prefstop
5904 if {$maxwidth != $oldprefs(maxwidth)
5905 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5906 redisplay
5907 } elseif {$showneartags != $oldprefs(showneartags)} {
5908 reselectline
5912 proc formatdate {d} {
5913 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5916 # This list of encoding names and aliases is distilled from
5917 # http://www.iana.org/assignments/character-sets.
5918 # Not all of them are supported by Tcl.
5919 set encoding_aliases {
5920 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5921 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5922 { ISO-10646-UTF-1 csISO10646UTF1 }
5923 { ISO_646.basic:1983 ref csISO646basic1983 }
5924 { INVARIANT csINVARIANT }
5925 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5926 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5927 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5928 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5929 { NATS-DANO iso-ir-9-1 csNATSDANO }
5930 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5931 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5932 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5933 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5934 { ISO-2022-KR csISO2022KR }
5935 { EUC-KR csEUCKR }
5936 { ISO-2022-JP csISO2022JP }
5937 { ISO-2022-JP-2 csISO2022JP2 }
5938 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5939 csISO13JISC6220jp }
5940 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5941 { IT iso-ir-15 ISO646-IT csISO15Italian }
5942 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5943 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5944 { greek7-old iso-ir-18 csISO18Greek7Old }
5945 { latin-greek iso-ir-19 csISO19LatinGreek }
5946 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5947 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5948 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5949 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5950 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5951 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5952 { INIS iso-ir-49 csISO49INIS }
5953 { INIS-8 iso-ir-50 csISO50INIS8 }
5954 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5955 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5956 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5957 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5958 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5959 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5960 csISO60Norwegian1 }
5961 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5962 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5963 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5964 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5965 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5966 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5967 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5968 { greek7 iso-ir-88 csISO88Greek7 }
5969 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5970 { iso-ir-90 csISO90 }
5971 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5972 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5973 csISO92JISC62991984b }
5974 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5975 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5976 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5977 csISO95JIS62291984handadd }
5978 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5979 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5980 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5981 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5982 CP819 csISOLatin1 }
5983 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5984 { T.61-7bit iso-ir-102 csISO102T617bit }
5985 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5986 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5987 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5988 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5989 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5990 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5991 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5992 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5993 arabic csISOLatinArabic }
5994 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5995 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5996 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5997 greek greek8 csISOLatinGreek }
5998 { T.101-G2 iso-ir-128 csISO128T101G2 }
5999 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6000 csISOLatinHebrew }
6001 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6002 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6003 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6004 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6005 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6006 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6007 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6008 csISOLatinCyrillic }
6009 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6010 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6011 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6012 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6013 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6014 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6015 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6016 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6017 { ISO_10367-box iso-ir-155 csISO10367Box }
6018 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6019 { latin-lap lap iso-ir-158 csISO158Lap }
6020 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6021 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6022 { us-dk csUSDK }
6023 { dk-us csDKUS }
6024 { JIS_X0201 X0201 csHalfWidthKatakana }
6025 { KSC5636 ISO646-KR csKSC5636 }
6026 { ISO-10646-UCS-2 csUnicode }
6027 { ISO-10646-UCS-4 csUCS4 }
6028 { DEC-MCS dec csDECMCS }
6029 { hp-roman8 roman8 r8 csHPRoman8 }
6030 { macintosh mac csMacintosh }
6031 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6032 csIBM037 }
6033 { IBM038 EBCDIC-INT cp038 csIBM038 }
6034 { IBM273 CP273 csIBM273 }
6035 { IBM274 EBCDIC-BE CP274 csIBM274 }
6036 { IBM275 EBCDIC-BR cp275 csIBM275 }
6037 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6038 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6039 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6040 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6041 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6042 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6043 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6044 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6045 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6046 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6047 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6048 { IBM437 cp437 437 csPC8CodePage437 }
6049 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6050 { IBM775 cp775 csPC775Baltic }
6051 { IBM850 cp850 850 csPC850Multilingual }
6052 { IBM851 cp851 851 csIBM851 }
6053 { IBM852 cp852 852 csPCp852 }
6054 { IBM855 cp855 855 csIBM855 }
6055 { IBM857 cp857 857 csIBM857 }
6056 { IBM860 cp860 860 csIBM860 }
6057 { IBM861 cp861 861 cp-is csIBM861 }
6058 { IBM862 cp862 862 csPC862LatinHebrew }
6059 { IBM863 cp863 863 csIBM863 }
6060 { IBM864 cp864 csIBM864 }
6061 { IBM865 cp865 865 csIBM865 }
6062 { IBM866 cp866 866 csIBM866 }
6063 { IBM868 CP868 cp-ar csIBM868 }
6064 { IBM869 cp869 869 cp-gr csIBM869 }
6065 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6066 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6067 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6068 { IBM891 cp891 csIBM891 }
6069 { IBM903 cp903 csIBM903 }
6070 { IBM904 cp904 904 csIBBM904 }
6071 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6072 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6073 { IBM1026 CP1026 csIBM1026 }
6074 { EBCDIC-AT-DE csIBMEBCDICATDE }
6075 { EBCDIC-AT-DE-A csEBCDICATDEA }
6076 { EBCDIC-CA-FR csEBCDICCAFR }
6077 { EBCDIC-DK-NO csEBCDICDKNO }
6078 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6079 { EBCDIC-FI-SE csEBCDICFISE }
6080 { EBCDIC-FI-SE-A csEBCDICFISEA }
6081 { EBCDIC-FR csEBCDICFR }
6082 { EBCDIC-IT csEBCDICIT }
6083 { EBCDIC-PT csEBCDICPT }
6084 { EBCDIC-ES csEBCDICES }
6085 { EBCDIC-ES-A csEBCDICESA }
6086 { EBCDIC-ES-S csEBCDICESS }
6087 { EBCDIC-UK csEBCDICUK }
6088 { EBCDIC-US csEBCDICUS }
6089 { UNKNOWN-8BIT csUnknown8BiT }
6090 { MNEMONIC csMnemonic }
6091 { MNEM csMnem }
6092 { VISCII csVISCII }
6093 { VIQR csVIQR }
6094 { KOI8-R csKOI8R }
6095 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6096 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6097 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6098 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6099 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6100 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6101 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6102 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6103 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6104 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6105 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6106 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6107 { IBM1047 IBM-1047 }
6108 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6109 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6110 { UNICODE-1-1 csUnicode11 }
6111 { CESU-8 csCESU-8 }
6112 { BOCU-1 csBOCU-1 }
6113 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6114 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6115 l8 }
6116 { ISO-8859-15 ISO_8859-15 Latin-9 }
6117 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6118 { GBK CP936 MS936 windows-936 }
6119 { JIS_Encoding csJISEncoding }
6120 { Shift_JIS MS_Kanji csShiftJIS }
6121 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6122 EUC-JP }
6123 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6124 { ISO-10646-UCS-Basic csUnicodeASCII }
6125 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6126 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6127 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6128 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6129 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6130 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6131 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6132 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6133 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6134 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6135 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6136 { Ventura-US csVenturaUS }
6137 { Ventura-International csVenturaInternational }
6138 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6139 { PC8-Turkish csPC8Turkish }
6140 { IBM-Symbols csIBMSymbols }
6141 { IBM-Thai csIBMThai }
6142 { HP-Legal csHPLegal }
6143 { HP-Pi-font csHPPiFont }
6144 { HP-Math8 csHPMath8 }
6145 { Adobe-Symbol-Encoding csHPPSMath }
6146 { HP-DeskTop csHPDesktop }
6147 { Ventura-Math csVenturaMath }
6148 { Microsoft-Publishing csMicrosoftPublishing }
6149 { Windows-31J csWindows31J }
6150 { GB2312 csGB2312 }
6151 { Big5 csBig5 }
6154 proc tcl_encoding {enc} {
6155 global encoding_aliases
6156 set names [encoding names]
6157 set lcnames [string tolower $names]
6158 set enc [string tolower $enc]
6159 set i [lsearch -exact $lcnames $enc]
6160 if {$i < 0} {
6161 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6162 if {[regsub {^iso[-_]} $enc iso encx]} {
6163 set i [lsearch -exact $lcnames $encx]
6166 if {$i < 0} {
6167 foreach l $encoding_aliases {
6168 set ll [string tolower $l]
6169 if {[lsearch -exact $ll $enc] < 0} continue
6170 # look through the aliases for one that tcl knows about
6171 foreach e $ll {
6172 set i [lsearch -exact $lcnames $e]
6173 if {$i < 0} {
6174 if {[regsub {^iso[-_]} $e iso ex]} {
6175 set i [lsearch -exact $lcnames $ex]
6178 if {$i >= 0} break
6180 break
6183 if {$i >= 0} {
6184 return [lindex $names $i]
6186 return {}
6189 # defaults...
6190 set datemode 0
6191 set diffopts "-U 5 -p"
6192 set wrcomcmd "git diff-tree --stdin -p --pretty"
6194 set gitencoding {}
6195 catch {
6196 set gitencoding [exec git config --get i18n.commitencoding]
6198 if {$gitencoding == ""} {
6199 set gitencoding "utf-8"
6201 set tclencoding [tcl_encoding $gitencoding]
6202 if {$tclencoding == {}} {
6203 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6206 set mainfont {Helvetica 9}
6207 set textfont {Courier 9}
6208 set uifont {Helvetica 9 bold}
6209 set findmergefiles 0
6210 set maxgraphpct 50
6211 set maxwidth 16
6212 set revlistorder 0
6213 set fastdate 0
6214 set uparrowlen 7
6215 set downarrowlen 7
6216 set mingaplen 30
6217 set cmitmode "patch"
6218 set wrapcomment "none"
6219 set showneartags 1
6221 set colors {green red blue magenta darkgrey brown orange}
6222 set bgcolor white
6223 set fgcolor black
6224 set diffcolors {red "#00a000" blue}
6226 catch {source ~/.gitk}
6228 font create optionfont -family sans-serif -size -12
6230 set revtreeargs {}
6231 foreach arg $argv {
6232 switch -regexp -- $arg {
6233 "^$" { }
6234 "^-d" { set datemode 1 }
6235 default {
6236 lappend revtreeargs $arg
6241 # check that we can find a .git directory somewhere...
6242 set gitdir [gitdir]
6243 if {![file isdirectory $gitdir]} {
6244 show_error {} . "Cannot find the git directory \"$gitdir\"."
6245 exit 1
6248 set cmdline_files {}
6249 set i [lsearch -exact $revtreeargs "--"]
6250 if {$i >= 0} {
6251 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6252 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6253 } elseif {$revtreeargs ne {}} {
6254 if {[catch {
6255 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6256 set cmdline_files [split $f "\n"]
6257 set n [llength $cmdline_files]
6258 set revtreeargs [lrange $revtreeargs 0 end-$n]
6259 } err]} {
6260 # unfortunately we get both stdout and stderr in $err,
6261 # so look for "fatal:".
6262 set i [string first "fatal:" $err]
6263 if {$i > 0} {
6264 set err [string range $err [expr {$i + 6}] end]
6266 show_error {} . "Bad arguments to gitk:\n$err"
6267 exit 1
6271 set history {}
6272 set historyindex 0
6273 set fh_serial 0
6274 set nhl_names {}
6275 set highlight_paths {}
6276 set searchdirn -forwards
6277 set boldrows {}
6278 set boldnamerows {}
6280 set optim_delay 16
6282 set nextviewnum 1
6283 set curview 0
6284 set selectedview 0
6285 set selectedhlview None
6286 set viewfiles(0) {}
6287 set viewperm(0) 0
6288 set viewargs(0) {}
6290 set cmdlineok 0
6291 set stopped 0
6292 set stuffsaved 0
6293 set patchnum 0
6294 setcoords
6295 makewindow
6296 wm title . "[file tail $argv0]: [file tail [pwd]]"
6297 readrefs
6299 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6300 # create a view for the files/dirs specified on the command line
6301 set curview 1
6302 set selectedview 1
6303 set nextviewnum 2
6304 set viewname(1) "Command line"
6305 set viewfiles(1) $cmdline_files
6306 set viewargs(1) $revtreeargs
6307 set viewperm(1) 0
6308 addviewmenu 1
6309 .bar.view entryconf Edit* -state normal
6310 .bar.view entryconf Delete* -state normal
6313 if {[info exists permviews]} {
6314 foreach v $permviews {
6315 set n $nextviewnum
6316 incr nextviewnum
6317 set viewname($n) [lindex $v 0]
6318 set viewfiles($n) [lindex $v 1]
6319 set viewargs($n) [lindex $v 2]
6320 set viewperm($n) 1
6321 addviewmenu $n
6324 getcommits