Avoid Windows's find by using the full path of /usr/bin/find.
[git/dscho.git] / gitk
blobf36ade0b7ba41ea58f3a740a3b51dcc0083971d7
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 show-ref] 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 # the gui has upper and lower half, parts of a paned window.
439 panedwindow .ctop -orient vertical
441 # possibly use assumed geometry
442 if {![info exists geometry(pwsash0)]} {
443 set geometry(topheight) [expr {15 * $linespc}]
444 set geometry(topwidth) [expr {80 * $charspc}]
445 set geometry(botheight) [expr {15 * $linespc}]
446 set geometry(botwidth) [expr {50 * $charspc}]
447 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
448 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
451 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
452 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
453 frame .tf.histframe
454 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
456 # create three canvases
457 set cscroll .tf.histframe.csb
458 set canv .tf.histframe.pwclist.canv
459 canvas $canv \
460 -background $bgcolor -bd 0 \
461 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
462 .tf.histframe.pwclist add $canv
463 set canv2 .tf.histframe.pwclist.canv2
464 canvas $canv2 \
465 -background $bgcolor -bd 0 -yscrollincr $linespc
466 .tf.histframe.pwclist add $canv2
467 set canv3 .tf.histframe.pwclist.canv3
468 canvas $canv3 \
469 -background $bgcolor -bd 0 -yscrollincr $linespc
470 .tf.histframe.pwclist add $canv3
471 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
472 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
474 # a scroll bar to rule them
475 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
476 pack $cscroll -side right -fill y
477 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
478 lappend bglist $canv $canv2 $canv3
479 pack .tf.histframe.pwclist -fill both -expand 1 -side left
481 # we have two button bars at bottom of top frame. Bar 1
482 frame .tf.bar
483 frame .tf.lbar -height 15
485 set sha1entry .tf.bar.sha1
486 set entries $sha1entry
487 set sha1but .tf.bar.sha1label
488 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
489 -command gotocommit -width 8 -font $uifont
490 $sha1but conf -disabledforeground [$sha1but cget -foreground]
491 pack .tf.bar.sha1label -side left
492 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
493 trace add variable sha1string write sha1change
494 pack $sha1entry -side left -pady 2
496 image create bitmap bm-left -data {
497 #define left_width 16
498 #define left_height 16
499 static unsigned char left_bits[] = {
500 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
501 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
502 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
504 image create bitmap bm-right -data {
505 #define right_width 16
506 #define right_height 16
507 static unsigned char right_bits[] = {
508 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
509 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
510 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
512 button .tf.bar.leftbut -image bm-left -command goback \
513 -state disabled -width 26
514 pack .tf.bar.leftbut -side left -fill y
515 button .tf.bar.rightbut -image bm-right -command goforw \
516 -state disabled -width 26
517 pack .tf.bar.rightbut -side left -fill y
519 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
520 pack .tf.bar.findbut -side left
521 set findstring {}
522 set fstring .tf.bar.findstring
523 lappend entries $fstring
524 entry $fstring -width 30 -font $textfont -textvariable findstring
525 trace add variable findstring write find_change
526 pack $fstring -side left -expand 1 -fill x -in .tf.bar
527 set findtype Exact
528 set findtypemenu [tk_optionMenu .tf.bar.findtype \
529 findtype Exact IgnCase Regexp]
530 trace add variable findtype write find_change
531 .tf.bar.findtype configure -font $uifont
532 .tf.bar.findtype.menu configure -font $uifont
533 set findloc "All fields"
534 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
535 Comments Author Committer
536 trace add variable findloc write find_change
537 .tf.bar.findloc configure -font $uifont
538 .tf.bar.findloc.menu configure -font $uifont
539 pack .tf.bar.findloc -side right
540 pack .tf.bar.findtype -side right
542 # build up the bottom bar of upper window
543 label .tf.lbar.flabel -text "Highlight: Commits " \
544 -font $uifont
545 pack .tf.lbar.flabel -side left -fill y
546 set gdttype "touching paths:"
547 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
548 "adding/removing string:"]
549 trace add variable gdttype write hfiles_change
550 $gm conf -font $uifont
551 .tf.lbar.gdttype conf -font $uifont
552 pack .tf.lbar.gdttype -side left -fill y
553 entry .tf.lbar.fent -width 25 -font $textfont \
554 -textvariable highlight_files
555 trace add variable highlight_files write hfiles_change
556 lappend entries .tf.lbar.fent
557 pack .tf.lbar.fent -side left -fill x -expand 1
558 label .tf.lbar.vlabel -text " OR in view" -font $uifont
559 pack .tf.lbar.vlabel -side left -fill y
560 global viewhlmenu selectedhlview
561 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
562 $viewhlmenu entryconf None -command delvhighlight
563 $viewhlmenu conf -font $uifont
564 .tf.lbar.vhl conf -font $uifont
565 pack .tf.lbar.vhl -side left -fill y
566 label .tf.lbar.rlabel -text " OR " -font $uifont
567 pack .tf.lbar.rlabel -side left -fill y
568 global highlight_related
569 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
570 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
571 $m conf -font $uifont
572 .tf.lbar.relm conf -font $uifont
573 trace add variable highlight_related write vrel_change
574 pack .tf.lbar.relm -side left -fill y
576 # Finish putting the upper half of the viewer together
577 pack .tf.lbar -in .tf -side bottom -fill x
578 pack .tf.bar -in .tf -side bottom -fill x
579 pack .tf.histframe -fill both -side top -expand 1
580 .ctop add .tf
581 .ctop paneconfigure .tf -height $geometry(topheight)
582 .ctop paneconfigure .tf -width $geometry(topwidth)
584 # now build up the bottom
585 panedwindow .pwbottom -orient horizontal
587 # lower left, a text box over search bar, scroll bar to the right
588 # if we know window height, then that will set the lower text height, otherwise
589 # we set lower text height which will drive window height
590 if {[info exists geometry(main)]} {
591 frame .bleft -width $geometry(botwidth)
592 } else {
593 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
595 frame .bleft.top
597 button .bleft.top.search -text "Search" -command dosearch \
598 -font $uifont
599 pack .bleft.top.search -side left -padx 5
600 set sstring .bleft.top.sstring
601 entry $sstring -width 20 -font $textfont -textvariable searchstring
602 lappend entries $sstring
603 trace add variable searchstring write incrsearch
604 pack $sstring -side left -expand 1 -fill x
605 set ctext .bleft.ctext
606 text $ctext -background $bgcolor -foreground $fgcolor \
607 -state disabled -font $textfont \
608 -yscrollcommand scrolltext -wrap none
609 scrollbar .bleft.sb -command "$ctext yview"
610 pack .bleft.top -side top -fill x
611 pack .bleft.sb -side right -fill y
612 pack $ctext -side left -fill both -expand 1
613 lappend bglist $ctext
614 lappend fglist $ctext
616 $ctext tag conf comment -wrap $wrapcomment
617 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
618 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
619 $ctext tag conf d0 -fore [lindex $diffcolors 0]
620 $ctext tag conf d1 -fore [lindex $diffcolors 1]
621 $ctext tag conf m0 -fore red
622 $ctext tag conf m1 -fore blue
623 $ctext tag conf m2 -fore green
624 $ctext tag conf m3 -fore purple
625 $ctext tag conf m4 -fore brown
626 $ctext tag conf m5 -fore "#009090"
627 $ctext tag conf m6 -fore magenta
628 $ctext tag conf m7 -fore "#808000"
629 $ctext tag conf m8 -fore "#009000"
630 $ctext tag conf m9 -fore "#ff0080"
631 $ctext tag conf m10 -fore cyan
632 $ctext tag conf m11 -fore "#b07070"
633 $ctext tag conf m12 -fore "#70b0f0"
634 $ctext tag conf m13 -fore "#70f0b0"
635 $ctext tag conf m14 -fore "#f0b070"
636 $ctext tag conf m15 -fore "#ff70b0"
637 $ctext tag conf mmax -fore darkgrey
638 set mergemax 16
639 $ctext tag conf mresult -font [concat $textfont bold]
640 $ctext tag conf msep -font [concat $textfont bold]
641 $ctext tag conf found -back yellow
643 .pwbottom add .bleft
644 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
646 # lower right
647 frame .bright
648 frame .bright.mode
649 radiobutton .bright.mode.patch -text "Patch" \
650 -command reselectline -variable cmitmode -value "patch"
651 radiobutton .bright.mode.tree -text "Tree" \
652 -command reselectline -variable cmitmode -value "tree"
653 grid .bright.mode.patch .bright.mode.tree -sticky ew
654 pack .bright.mode -side top -fill x
655 set cflist .bright.cfiles
656 set indent [font measure $mainfont "nn"]
657 text $cflist \
658 -background $bgcolor -foreground $fgcolor \
659 -font $mainfont \
660 -tabs [list $indent [expr {2 * $indent}]] \
661 -yscrollcommand ".bright.sb set" \
662 -cursor [. cget -cursor] \
663 -spacing1 1 -spacing3 1
664 lappend bglist $cflist
665 lappend fglist $cflist
666 scrollbar .bright.sb -command "$cflist yview"
667 pack .bright.sb -side right -fill y
668 pack $cflist -side left -fill both -expand 1
669 $cflist tag configure highlight \
670 -background [$cflist cget -highlightbackground]
671 $cflist tag configure bold -font [concat $mainfont bold]
673 .pwbottom add .bright
674 .ctop add .pwbottom
676 # restore window position if known
677 if {[info exists geometry(main)]} {
678 wm geometry . "$geometry(main)"
681 bind .pwbottom <Configure> {resizecdetpanes %W %w}
682 pack .ctop -fill both -expand 1
683 bindall <1> {selcanvline %W %x %y}
684 #bindall <B1-Motion> {selcanvline %W %x %y}
685 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
686 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
687 bindall <2> "canvscan mark %W %x %y"
688 bindall <B2-Motion> "canvscan dragto %W %x %y"
689 bindkey <Home> selfirstline
690 bindkey <End> sellastline
691 bind . <Key-Up> "selnextline -1"
692 bind . <Key-Down> "selnextline 1"
693 bind . <Shift-Key-Up> "next_highlight -1"
694 bind . <Shift-Key-Down> "next_highlight 1"
695 bindkey <Key-Right> "goforw"
696 bindkey <Key-Left> "goback"
697 bind . <Key-Prior> "selnextpage -1"
698 bind . <Key-Next> "selnextpage 1"
699 bind . <Control-Home> "allcanvs yview moveto 0.0"
700 bind . <Control-End> "allcanvs yview moveto 1.0"
701 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
702 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
703 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
704 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
705 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
706 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
707 bindkey <Key-space> "$ctext yview scroll 1 pages"
708 bindkey p "selnextline -1"
709 bindkey n "selnextline 1"
710 bindkey z "goback"
711 bindkey x "goforw"
712 bindkey i "selnextline -1"
713 bindkey k "selnextline 1"
714 bindkey j "goback"
715 bindkey l "goforw"
716 bindkey b "$ctext yview scroll -1 pages"
717 bindkey d "$ctext yview scroll 18 units"
718 bindkey u "$ctext yview scroll -18 units"
719 bindkey / {findnext 1}
720 bindkey <Key-Return> {findnext 0}
721 bindkey ? findprev
722 bindkey f nextfile
723 bindkey <F5> updatecommits
724 bind . <Control-q> doquit
725 bind . <Control-f> dofind
726 bind . <Control-g> {findnext 0}
727 bind . <Control-r> dosearchback
728 bind . <Control-s> dosearch
729 bind . <Control-equal> {incrfont 1}
730 bind . <Control-KP_Add> {incrfont 1}
731 bind . <Control-minus> {incrfont -1}
732 bind . <Control-KP_Subtract> {incrfont -1}
733 wm protocol . WM_DELETE_WINDOW doquit
734 bind . <Button-1> "click %W"
735 bind $fstring <Key-Return> dofind
736 bind $sha1entry <Key-Return> gotocommit
737 bind $sha1entry <<PasteSelection>> clearsha1
738 bind $cflist <1> {sel_flist %W %x %y; break}
739 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
740 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
742 set maincursor [. cget -cursor]
743 set textcursor [$ctext cget -cursor]
744 set curtextcursor $textcursor
746 set rowctxmenu .rowctxmenu
747 menu $rowctxmenu -tearoff 0
748 $rowctxmenu add command -label "Diff this -> selected" \
749 -command {diffvssel 0}
750 $rowctxmenu add command -label "Diff selected -> this" \
751 -command {diffvssel 1}
752 $rowctxmenu add command -label "Make patch" -command mkpatch
753 $rowctxmenu add command -label "Create tag" -command mktag
754 $rowctxmenu add command -label "Write commit to file" -command writecommit
755 $rowctxmenu add command -label "Create new branch" -command mkbranch
756 $rowctxmenu add command -label "Cherry-pick this commit" \
757 -command cherrypick
759 set headctxmenu .headctxmenu
760 menu $headctxmenu -tearoff 0
761 $headctxmenu add command -label "Check out this branch" \
762 -command cobranch
763 $headctxmenu add command -label "Remove this branch" \
764 -command rmbranch
767 # mouse-2 makes all windows scan vertically, but only the one
768 # the cursor is in scans horizontally
769 proc canvscan {op w x y} {
770 global canv canv2 canv3
771 foreach c [list $canv $canv2 $canv3] {
772 if {$c == $w} {
773 $c scan $op $x $y
774 } else {
775 $c scan $op 0 $y
780 proc scrollcanv {cscroll f0 f1} {
781 $cscroll set $f0 $f1
782 drawfrac $f0 $f1
783 flushhighlights
786 # when we make a key binding for the toplevel, make sure
787 # it doesn't get triggered when that key is pressed in the
788 # find string entry widget.
789 proc bindkey {ev script} {
790 global entries
791 bind . $ev $script
792 set escript [bind Entry $ev]
793 if {$escript == {}} {
794 set escript [bind Entry <Key>]
796 foreach e $entries {
797 bind $e $ev "$escript; break"
801 # set the focus back to the toplevel for any click outside
802 # the entry widgets
803 proc click {w} {
804 global entries
805 foreach e $entries {
806 if {$w == $e} return
808 focus .
811 proc savestuff {w} {
812 global canv canv2 canv3 ctext cflist mainfont textfont uifont
813 global stuffsaved findmergefiles maxgraphpct
814 global maxwidth showneartags
815 global viewname viewfiles viewargs viewperm nextviewnum
816 global cmitmode wrapcomment
817 global colors bgcolor fgcolor diffcolors
819 if {$stuffsaved} return
820 if {![winfo viewable .]} return
821 catch {
822 set f [open "~/.gitk-new" w]
823 puts $f [list set mainfont $mainfont]
824 puts $f [list set textfont $textfont]
825 puts $f [list set uifont $uifont]
826 puts $f [list set findmergefiles $findmergefiles]
827 puts $f [list set maxgraphpct $maxgraphpct]
828 puts $f [list set maxwidth $maxwidth]
829 puts $f [list set cmitmode $cmitmode]
830 puts $f [list set wrapcomment $wrapcomment]
831 puts $f [list set showneartags $showneartags]
832 puts $f [list set bgcolor $bgcolor]
833 puts $f [list set fgcolor $fgcolor]
834 puts $f [list set colors $colors]
835 puts $f [list set diffcolors $diffcolors]
837 puts $f "set geometry(main) [wm geometry .]"
838 puts $f "set geometry(topwidth) [winfo width .tf]"
839 puts $f "set geometry(topheight) [winfo height .tf]"
840 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
841 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
842 puts $f "set geometry(botwidth) [winfo width .bleft]"
843 puts $f "set geometry(botheight) [winfo height .bleft]"
845 puts -nonewline $f "set permviews {"
846 for {set v 0} {$v < $nextviewnum} {incr v} {
847 if {$viewperm($v)} {
848 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
851 puts $f "}"
852 close $f
853 catch {file delete "~/.gitk"}
854 file rename -force "~/.gitk-new" "~/.gitk"
856 set stuffsaved 1
859 proc resizeclistpanes {win w} {
860 global oldwidth
861 if {[info exists oldwidth($win)]} {
862 set s0 [$win sash coord 0]
863 set s1 [$win sash coord 1]
864 if {$w < 60} {
865 set sash0 [expr {int($w/2 - 2)}]
866 set sash1 [expr {int($w*5/6 - 2)}]
867 } else {
868 set factor [expr {1.0 * $w / $oldwidth($win)}]
869 set sash0 [expr {int($factor * [lindex $s0 0])}]
870 set sash1 [expr {int($factor * [lindex $s1 0])}]
871 if {$sash0 < 30} {
872 set sash0 30
874 if {$sash1 < $sash0 + 20} {
875 set sash1 [expr {$sash0 + 20}]
877 if {$sash1 > $w - 10} {
878 set sash1 [expr {$w - 10}]
879 if {$sash0 > $sash1 - 20} {
880 set sash0 [expr {$sash1 - 20}]
884 $win sash place 0 $sash0 [lindex $s0 1]
885 $win sash place 1 $sash1 [lindex $s1 1]
887 set oldwidth($win) $w
890 proc resizecdetpanes {win w} {
891 global oldwidth
892 if {[info exists oldwidth($win)]} {
893 set s0 [$win sash coord 0]
894 if {$w < 60} {
895 set sash0 [expr {int($w*3/4 - 2)}]
896 } else {
897 set factor [expr {1.0 * $w / $oldwidth($win)}]
898 set sash0 [expr {int($factor * [lindex $s0 0])}]
899 if {$sash0 < 45} {
900 set sash0 45
902 if {$sash0 > $w - 15} {
903 set sash0 [expr {$w - 15}]
906 $win sash place 0 $sash0 [lindex $s0 1]
908 set oldwidth($win) $w
911 proc allcanvs args {
912 global canv canv2 canv3
913 eval $canv $args
914 eval $canv2 $args
915 eval $canv3 $args
918 proc bindall {event action} {
919 global canv canv2 canv3
920 bind $canv $event $action
921 bind $canv2 $event $action
922 bind $canv3 $event $action
925 proc about {} {
926 set w .about
927 if {[winfo exists $w]} {
928 raise $w
929 return
931 toplevel $w
932 wm title $w "About gitk"
933 message $w.m -text {
934 Gitk - a commit viewer for git
936 Copyright © 2005-2006 Paul Mackerras
938 Use and redistribute under the terms of the GNU General Public License} \
939 -justify center -aspect 400
940 pack $w.m -side top -fill x -padx 20 -pady 20
941 button $w.ok -text Close -command "destroy $w"
942 pack $w.ok -side bottom
945 proc keys {} {
946 set w .keys
947 if {[winfo exists $w]} {
948 raise $w
949 return
951 toplevel $w
952 wm title $w "Gitk key bindings"
953 message $w.m -text {
954 Gitk key bindings:
956 <Ctrl-Q> Quit
957 <Home> Move to first commit
958 <End> Move to last commit
959 <Up>, p, i Move up one commit
960 <Down>, n, k Move down one commit
961 <Left>, z, j Go back in history list
962 <Right>, x, l Go forward in history list
963 <PageUp> Move up one page in commit list
964 <PageDown> Move down one page in commit list
965 <Ctrl-Home> Scroll to top of commit list
966 <Ctrl-End> Scroll to bottom of commit list
967 <Ctrl-Up> Scroll commit list up one line
968 <Ctrl-Down> Scroll commit list down one line
969 <Ctrl-PageUp> Scroll commit list up one page
970 <Ctrl-PageDown> Scroll commit list down one page
971 <Shift-Up> Move to previous highlighted line
972 <Shift-Down> Move to next highlighted line
973 <Delete>, b Scroll diff view up one page
974 <Backspace> Scroll diff view up one page
975 <Space> Scroll diff view down one page
976 u Scroll diff view up 18 lines
977 d Scroll diff view down 18 lines
978 <Ctrl-F> Find
979 <Ctrl-G> Move to next find hit
980 <Return> Move to next find hit
981 / Move to next find hit, or redo find
982 ? Move to previous find hit
983 f Scroll diff view to next file
984 <Ctrl-S> Search for next hit in diff view
985 <Ctrl-R> Search for previous hit in diff view
986 <Ctrl-KP+> Increase font size
987 <Ctrl-plus> Increase font size
988 <Ctrl-KP-> Decrease font size
989 <Ctrl-minus> Decrease font size
990 <F5> Update
992 -justify left -bg white -border 2 -relief sunken
993 pack $w.m -side top -fill both
994 button $w.ok -text Close -command "destroy $w"
995 pack $w.ok -side bottom
998 # Procedures for manipulating the file list window at the
999 # bottom right of the overall window.
1001 proc treeview {w l openlevs} {
1002 global treecontents treediropen treeheight treeparent treeindex
1004 set ix 0
1005 set treeindex() 0
1006 set lev 0
1007 set prefix {}
1008 set prefixend -1
1009 set prefendstack {}
1010 set htstack {}
1011 set ht 0
1012 set treecontents() {}
1013 $w conf -state normal
1014 foreach f $l {
1015 while {[string range $f 0 $prefixend] ne $prefix} {
1016 if {$lev <= $openlevs} {
1017 $w mark set e:$treeindex($prefix) "end -1c"
1018 $w mark gravity e:$treeindex($prefix) left
1020 set treeheight($prefix) $ht
1021 incr ht [lindex $htstack end]
1022 set htstack [lreplace $htstack end end]
1023 set prefixend [lindex $prefendstack end]
1024 set prefendstack [lreplace $prefendstack end end]
1025 set prefix [string range $prefix 0 $prefixend]
1026 incr lev -1
1028 set tail [string range $f [expr {$prefixend+1}] end]
1029 while {[set slash [string first "/" $tail]] >= 0} {
1030 lappend htstack $ht
1031 set ht 0
1032 lappend prefendstack $prefixend
1033 incr prefixend [expr {$slash + 1}]
1034 set d [string range $tail 0 $slash]
1035 lappend treecontents($prefix) $d
1036 set oldprefix $prefix
1037 append prefix $d
1038 set treecontents($prefix) {}
1039 set treeindex($prefix) [incr ix]
1040 set treeparent($prefix) $oldprefix
1041 set tail [string range $tail [expr {$slash+1}] end]
1042 if {$lev <= $openlevs} {
1043 set ht 1
1044 set treediropen($prefix) [expr {$lev < $openlevs}]
1045 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1046 $w mark set d:$ix "end -1c"
1047 $w mark gravity d:$ix left
1048 set str "\n"
1049 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1050 $w insert end $str
1051 $w image create end -align center -image $bm -padx 1 \
1052 -name a:$ix
1053 $w insert end $d [highlight_tag $prefix]
1054 $w mark set s:$ix "end -1c"
1055 $w mark gravity s:$ix left
1057 incr lev
1059 if {$tail ne {}} {
1060 if {$lev <= $openlevs} {
1061 incr ht
1062 set str "\n"
1063 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1064 $w insert end $str
1065 $w insert end $tail [highlight_tag $f]
1067 lappend treecontents($prefix) $tail
1070 while {$htstack ne {}} {
1071 set treeheight($prefix) $ht
1072 incr ht [lindex $htstack end]
1073 set htstack [lreplace $htstack end end]
1075 $w conf -state disabled
1078 proc linetoelt {l} {
1079 global treeheight treecontents
1081 set y 2
1082 set prefix {}
1083 while {1} {
1084 foreach e $treecontents($prefix) {
1085 if {$y == $l} {
1086 return "$prefix$e"
1088 set n 1
1089 if {[string index $e end] eq "/"} {
1090 set n $treeheight($prefix$e)
1091 if {$y + $n > $l} {
1092 append prefix $e
1093 incr y
1094 break
1097 incr y $n
1102 proc highlight_tree {y prefix} {
1103 global treeheight treecontents cflist
1105 foreach e $treecontents($prefix) {
1106 set path $prefix$e
1107 if {[highlight_tag $path] ne {}} {
1108 $cflist tag add bold $y.0 "$y.0 lineend"
1110 incr y
1111 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1112 set y [highlight_tree $y $path]
1115 return $y
1118 proc treeclosedir {w dir} {
1119 global treediropen treeheight treeparent treeindex
1121 set ix $treeindex($dir)
1122 $w conf -state normal
1123 $w delete s:$ix e:$ix
1124 set treediropen($dir) 0
1125 $w image configure a:$ix -image tri-rt
1126 $w conf -state disabled
1127 set n [expr {1 - $treeheight($dir)}]
1128 while {$dir ne {}} {
1129 incr treeheight($dir) $n
1130 set dir $treeparent($dir)
1134 proc treeopendir {w dir} {
1135 global treediropen treeheight treeparent treecontents treeindex
1137 set ix $treeindex($dir)
1138 $w conf -state normal
1139 $w image configure a:$ix -image tri-dn
1140 $w mark set e:$ix s:$ix
1141 $w mark gravity e:$ix right
1142 set lev 0
1143 set str "\n"
1144 set n [llength $treecontents($dir)]
1145 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1146 incr lev
1147 append str "\t"
1148 incr treeheight($x) $n
1150 foreach e $treecontents($dir) {
1151 set de $dir$e
1152 if {[string index $e end] eq "/"} {
1153 set iy $treeindex($de)
1154 $w mark set d:$iy e:$ix
1155 $w mark gravity d:$iy left
1156 $w insert e:$ix $str
1157 set treediropen($de) 0
1158 $w image create e:$ix -align center -image tri-rt -padx 1 \
1159 -name a:$iy
1160 $w insert e:$ix $e [highlight_tag $de]
1161 $w mark set s:$iy e:$ix
1162 $w mark gravity s:$iy left
1163 set treeheight($de) 1
1164 } else {
1165 $w insert e:$ix $str
1166 $w insert e:$ix $e [highlight_tag $de]
1169 $w mark gravity e:$ix left
1170 $w conf -state disabled
1171 set treediropen($dir) 1
1172 set top [lindex [split [$w index @0,0] .] 0]
1173 set ht [$w cget -height]
1174 set l [lindex [split [$w index s:$ix] .] 0]
1175 if {$l < $top} {
1176 $w yview $l.0
1177 } elseif {$l + $n + 1 > $top + $ht} {
1178 set top [expr {$l + $n + 2 - $ht}]
1179 if {$l < $top} {
1180 set top $l
1182 $w yview $top.0
1186 proc treeclick {w x y} {
1187 global treediropen cmitmode ctext cflist cflist_top
1189 if {$cmitmode ne "tree"} return
1190 if {![info exists cflist_top]} return
1191 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1192 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1193 $cflist tag add highlight $l.0 "$l.0 lineend"
1194 set cflist_top $l
1195 if {$l == 1} {
1196 $ctext yview 1.0
1197 return
1199 set e [linetoelt $l]
1200 if {[string index $e end] ne "/"} {
1201 showfile $e
1202 } elseif {$treediropen($e)} {
1203 treeclosedir $w $e
1204 } else {
1205 treeopendir $w $e
1209 proc setfilelist {id} {
1210 global treefilelist cflist
1212 treeview $cflist $treefilelist($id) 0
1215 image create bitmap tri-rt -background black -foreground blue -data {
1216 #define tri-rt_width 13
1217 #define tri-rt_height 13
1218 static unsigned char tri-rt_bits[] = {
1219 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1220 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1221 0x00, 0x00};
1222 } -maskdata {
1223 #define tri-rt-mask_width 13
1224 #define tri-rt-mask_height 13
1225 static unsigned char tri-rt-mask_bits[] = {
1226 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1227 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1228 0x08, 0x00};
1230 image create bitmap tri-dn -background black -foreground blue -data {
1231 #define tri-dn_width 13
1232 #define tri-dn_height 13
1233 static unsigned char tri-dn_bits[] = {
1234 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1235 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1236 0x00, 0x00};
1237 } -maskdata {
1238 #define tri-dn-mask_width 13
1239 #define tri-dn-mask_height 13
1240 static unsigned char tri-dn-mask_bits[] = {
1241 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1242 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1243 0x00, 0x00};
1246 proc init_flist {first} {
1247 global cflist cflist_top selectedline difffilestart
1249 $cflist conf -state normal
1250 $cflist delete 0.0 end
1251 if {$first ne {}} {
1252 $cflist insert end $first
1253 set cflist_top 1
1254 $cflist tag add highlight 1.0 "1.0 lineend"
1255 } else {
1256 catch {unset cflist_top}
1258 $cflist conf -state disabled
1259 set difffilestart {}
1262 proc highlight_tag {f} {
1263 global highlight_paths
1265 foreach p $highlight_paths {
1266 if {[string match $p $f]} {
1267 return "bold"
1270 return {}
1273 proc highlight_filelist {} {
1274 global cmitmode cflist
1276 $cflist conf -state normal
1277 if {$cmitmode ne "tree"} {
1278 set end [lindex [split [$cflist index end] .] 0]
1279 for {set l 2} {$l < $end} {incr l} {
1280 set line [$cflist get $l.0 "$l.0 lineend"]
1281 if {[highlight_tag $line] ne {}} {
1282 $cflist tag add bold $l.0 "$l.0 lineend"
1285 } else {
1286 highlight_tree 2 {}
1288 $cflist conf -state disabled
1291 proc unhighlight_filelist {} {
1292 global cflist
1294 $cflist conf -state normal
1295 $cflist tag remove bold 1.0 end
1296 $cflist conf -state disabled
1299 proc add_flist {fl} {
1300 global cflist
1302 $cflist conf -state normal
1303 foreach f $fl {
1304 $cflist insert end "\n"
1305 $cflist insert end $f [highlight_tag $f]
1307 $cflist conf -state disabled
1310 proc sel_flist {w x y} {
1311 global ctext difffilestart cflist cflist_top cmitmode
1313 if {$cmitmode eq "tree"} return
1314 if {![info exists cflist_top]} return
1315 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1316 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1317 $cflist tag add highlight $l.0 "$l.0 lineend"
1318 set cflist_top $l
1319 if {$l == 1} {
1320 $ctext yview 1.0
1321 } else {
1322 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1326 # Functions for adding and removing shell-type quoting
1328 proc shellquote {str} {
1329 if {![string match "*\['\"\\ \t]*" $str]} {
1330 return $str
1332 if {![string match "*\['\"\\]*" $str]} {
1333 return "\"$str\""
1335 if {![string match "*'*" $str]} {
1336 return "'$str'"
1338 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1341 proc shellarglist {l} {
1342 set str {}
1343 foreach a $l {
1344 if {$str ne {}} {
1345 append str " "
1347 append str [shellquote $a]
1349 return $str
1352 proc shelldequote {str} {
1353 set ret {}
1354 set used -1
1355 while {1} {
1356 incr used
1357 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1358 append ret [string range $str $used end]
1359 set used [string length $str]
1360 break
1362 set first [lindex $first 0]
1363 set ch [string index $str $first]
1364 if {$first > $used} {
1365 append ret [string range $str $used [expr {$first - 1}]]
1366 set used $first
1368 if {$ch eq " " || $ch eq "\t"} break
1369 incr used
1370 if {$ch eq "'"} {
1371 set first [string first "'" $str $used]
1372 if {$first < 0} {
1373 error "unmatched single-quote"
1375 append ret [string range $str $used [expr {$first - 1}]]
1376 set used $first
1377 continue
1379 if {$ch eq "\\"} {
1380 if {$used >= [string length $str]} {
1381 error "trailing backslash"
1383 append ret [string index $str $used]
1384 continue
1386 # here ch == "\""
1387 while {1} {
1388 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1389 error "unmatched double-quote"
1391 set first [lindex $first 0]
1392 set ch [string index $str $first]
1393 if {$first > $used} {
1394 append ret [string range $str $used [expr {$first - 1}]]
1395 set used $first
1397 if {$ch eq "\""} break
1398 incr used
1399 append ret [string index $str $used]
1400 incr used
1403 return [list $used $ret]
1406 proc shellsplit {str} {
1407 set l {}
1408 while {1} {
1409 set str [string trimleft $str]
1410 if {$str eq {}} break
1411 set dq [shelldequote $str]
1412 set n [lindex $dq 0]
1413 set word [lindex $dq 1]
1414 set str [string range $str $n end]
1415 lappend l $word
1417 return $l
1420 # Code to implement multiple views
1422 proc newview {ishighlight} {
1423 global nextviewnum newviewname newviewperm uifont newishighlight
1424 global newviewargs revtreeargs
1426 set newishighlight $ishighlight
1427 set top .gitkview
1428 if {[winfo exists $top]} {
1429 raise $top
1430 return
1432 set newviewname($nextviewnum) "View $nextviewnum"
1433 set newviewperm($nextviewnum) 0
1434 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1435 vieweditor $top $nextviewnum "Gitk view definition"
1438 proc editview {} {
1439 global curview
1440 global viewname viewperm newviewname newviewperm
1441 global viewargs newviewargs
1443 set top .gitkvedit-$curview
1444 if {[winfo exists $top]} {
1445 raise $top
1446 return
1448 set newviewname($curview) $viewname($curview)
1449 set newviewperm($curview) $viewperm($curview)
1450 set newviewargs($curview) [shellarglist $viewargs($curview)]
1451 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1454 proc vieweditor {top n title} {
1455 global newviewname newviewperm viewfiles
1456 global uifont
1458 toplevel $top
1459 wm title $top $title
1460 label $top.nl -text "Name" -font $uifont
1461 entry $top.name -width 20 -textvariable newviewname($n)
1462 grid $top.nl $top.name -sticky w -pady 5
1463 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1464 grid $top.perm - -pady 5 -sticky w
1465 message $top.al -aspect 1000 -font $uifont \
1466 -text "Commits to include (arguments to git rev-list):"
1467 grid $top.al - -sticky w -pady 5
1468 entry $top.args -width 50 -textvariable newviewargs($n) \
1469 -background white
1470 grid $top.args - -sticky ew -padx 5
1471 message $top.l -aspect 1000 -font $uifont \
1472 -text "Enter files and directories to include, one per line:"
1473 grid $top.l - -sticky w
1474 text $top.t -width 40 -height 10 -background white
1475 if {[info exists viewfiles($n)]} {
1476 foreach f $viewfiles($n) {
1477 $top.t insert end $f
1478 $top.t insert end "\n"
1480 $top.t delete {end - 1c} end
1481 $top.t mark set insert 0.0
1483 grid $top.t - -sticky ew -padx 5
1484 frame $top.buts
1485 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1486 button $top.buts.can -text "Cancel" -command [list destroy $top]
1487 grid $top.buts.ok $top.buts.can
1488 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1489 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1490 grid $top.buts - -pady 10 -sticky ew
1491 focus $top.t
1494 proc doviewmenu {m first cmd op argv} {
1495 set nmenu [$m index end]
1496 for {set i $first} {$i <= $nmenu} {incr i} {
1497 if {[$m entrycget $i -command] eq $cmd} {
1498 eval $m $op $i $argv
1499 break
1504 proc allviewmenus {n op args} {
1505 global viewhlmenu
1507 doviewmenu .bar.view 5 [list showview $n] $op $args
1508 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1511 proc newviewok {top n} {
1512 global nextviewnum newviewperm newviewname newishighlight
1513 global viewname viewfiles viewperm selectedview curview
1514 global viewargs newviewargs viewhlmenu
1516 if {[catch {
1517 set newargs [shellsplit $newviewargs($n)]
1518 } err]} {
1519 error_popup "Error in commit selection arguments: $err"
1520 wm raise $top
1521 focus $top
1522 return
1524 set files {}
1525 foreach f [split [$top.t get 0.0 end] "\n"] {
1526 set ft [string trim $f]
1527 if {$ft ne {}} {
1528 lappend files $ft
1531 if {![info exists viewfiles($n)]} {
1532 # creating a new view
1533 incr nextviewnum
1534 set viewname($n) $newviewname($n)
1535 set viewperm($n) $newviewperm($n)
1536 set viewfiles($n) $files
1537 set viewargs($n) $newargs
1538 addviewmenu $n
1539 if {!$newishighlight} {
1540 after idle showview $n
1541 } else {
1542 after idle addvhighlight $n
1544 } else {
1545 # editing an existing view
1546 set viewperm($n) $newviewperm($n)
1547 if {$newviewname($n) ne $viewname($n)} {
1548 set viewname($n) $newviewname($n)
1549 doviewmenu .bar.view 5 [list showview $n] \
1550 entryconf [list -label $viewname($n)]
1551 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1552 entryconf [list -label $viewname($n) -value $viewname($n)]
1554 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1555 set viewfiles($n) $files
1556 set viewargs($n) $newargs
1557 if {$curview == $n} {
1558 after idle updatecommits
1562 catch {destroy $top}
1565 proc delview {} {
1566 global curview viewdata viewperm hlview selectedhlview
1568 if {$curview == 0} return
1569 if {[info exists hlview] && $hlview == $curview} {
1570 set selectedhlview None
1571 unset hlview
1573 allviewmenus $curview delete
1574 set viewdata($curview) {}
1575 set viewperm($curview) 0
1576 showview 0
1579 proc addviewmenu {n} {
1580 global viewname viewhlmenu
1582 .bar.view add radiobutton -label $viewname($n) \
1583 -command [list showview $n] -variable selectedview -value $n
1584 $viewhlmenu add radiobutton -label $viewname($n) \
1585 -command [list addvhighlight $n] -variable selectedhlview
1588 proc flatten {var} {
1589 global $var
1591 set ret {}
1592 foreach i [array names $var] {
1593 lappend ret $i [set $var\($i\)]
1595 return $ret
1598 proc unflatten {var l} {
1599 global $var
1601 catch {unset $var}
1602 foreach {i v} $l {
1603 set $var\($i\) $v
1607 proc showview {n} {
1608 global curview viewdata viewfiles
1609 global displayorder parentlist childlist rowidlist rowoffsets
1610 global colormap rowtextx commitrow nextcolor canvxmax
1611 global numcommits rowrangelist commitlisted idrowranges
1612 global selectedline currentid canv canvy0
1613 global matchinglines treediffs
1614 global pending_select phase
1615 global commitidx rowlaidout rowoptim linesegends
1616 global commfd nextupdate
1617 global selectedview
1618 global vparentlist vchildlist vdisporder vcmitlisted
1619 global hlview selectedhlview
1621 if {$n == $curview} return
1622 set selid {}
1623 if {[info exists selectedline]} {
1624 set selid $currentid
1625 set y [yc $selectedline]
1626 set ymax [lindex [$canv cget -scrollregion] 3]
1627 set span [$canv yview]
1628 set ytop [expr {[lindex $span 0] * $ymax}]
1629 set ybot [expr {[lindex $span 1] * $ymax}]
1630 if {$ytop < $y && $y < $ybot} {
1631 set yscreen [expr {$y - $ytop}]
1632 } else {
1633 set yscreen [expr {($ybot - $ytop) / 2}]
1636 unselectline
1637 normalline
1638 stopfindproc
1639 if {$curview >= 0} {
1640 set vparentlist($curview) $parentlist
1641 set vchildlist($curview) $childlist
1642 set vdisporder($curview) $displayorder
1643 set vcmitlisted($curview) $commitlisted
1644 if {$phase ne {}} {
1645 set viewdata($curview) \
1646 [list $phase $rowidlist $rowoffsets $rowrangelist \
1647 [flatten idrowranges] [flatten idinlist] \
1648 $rowlaidout $rowoptim $numcommits $linesegends]
1649 } elseif {![info exists viewdata($curview)]
1650 || [lindex $viewdata($curview) 0] ne {}} {
1651 set viewdata($curview) \
1652 [list {} $rowidlist $rowoffsets $rowrangelist]
1655 catch {unset matchinglines}
1656 catch {unset treediffs}
1657 clear_display
1658 if {[info exists hlview] && $hlview == $n} {
1659 unset hlview
1660 set selectedhlview None
1663 set curview $n
1664 set selectedview $n
1665 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1666 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1668 if {![info exists viewdata($n)]} {
1669 set pending_select $selid
1670 getcommits
1671 return
1674 set v $viewdata($n)
1675 set phase [lindex $v 0]
1676 set displayorder $vdisporder($n)
1677 set parentlist $vparentlist($n)
1678 set childlist $vchildlist($n)
1679 set commitlisted $vcmitlisted($n)
1680 set rowidlist [lindex $v 1]
1681 set rowoffsets [lindex $v 2]
1682 set rowrangelist [lindex $v 3]
1683 if {$phase eq {}} {
1684 set numcommits [llength $displayorder]
1685 catch {unset idrowranges}
1686 } else {
1687 unflatten idrowranges [lindex $v 4]
1688 unflatten idinlist [lindex $v 5]
1689 set rowlaidout [lindex $v 6]
1690 set rowoptim [lindex $v 7]
1691 set numcommits [lindex $v 8]
1692 set linesegends [lindex $v 9]
1695 catch {unset colormap}
1696 catch {unset rowtextx}
1697 set nextcolor 0
1698 set canvxmax [$canv cget -width]
1699 set curview $n
1700 set row 0
1701 setcanvscroll
1702 set yf 0
1703 set row 0
1704 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1705 set row $commitrow($n,$selid)
1706 # try to get the selected row in the same position on the screen
1707 set ymax [lindex [$canv cget -scrollregion] 3]
1708 set ytop [expr {[yc $row] - $yscreen}]
1709 if {$ytop < 0} {
1710 set ytop 0
1712 set yf [expr {$ytop * 1.0 / $ymax}]
1714 allcanvs yview moveto $yf
1715 drawvisible
1716 selectline $row 0
1717 if {$phase ne {}} {
1718 if {$phase eq "getcommits"} {
1719 show_status "Reading commits..."
1721 if {[info exists commfd($n)]} {
1722 layoutmore {}
1723 } else {
1724 finishcommits
1726 } elseif {$numcommits == 0} {
1727 show_status "No commits selected"
1731 # Stuff relating to the highlighting facility
1733 proc ishighlighted {row} {
1734 global vhighlights fhighlights nhighlights rhighlights
1736 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1737 return $nhighlights($row)
1739 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1740 return $vhighlights($row)
1742 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1743 return $fhighlights($row)
1745 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1746 return $rhighlights($row)
1748 return 0
1751 proc bolden {row font} {
1752 global canv linehtag selectedline boldrows
1754 lappend boldrows $row
1755 $canv itemconf $linehtag($row) -font $font
1756 if {[info exists selectedline] && $row == $selectedline} {
1757 $canv delete secsel
1758 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1759 -outline {{}} -tags secsel \
1760 -fill [$canv cget -highlightbackground]]
1761 $canv lower $t
1765 proc bolden_name {row font} {
1766 global canv2 linentag selectedline boldnamerows
1768 lappend boldnamerows $row
1769 $canv2 itemconf $linentag($row) -font $font
1770 if {[info exists selectedline] && $row == $selectedline} {
1771 $canv2 delete secsel
1772 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1773 -outline {{}} -tags secsel \
1774 -fill [$canv2 cget -highlightbackground]]
1775 $canv2 lower $t
1779 proc unbolden {} {
1780 global mainfont boldrows
1782 set stillbold {}
1783 foreach row $boldrows {
1784 if {![ishighlighted $row]} {
1785 bolden $row $mainfont
1786 } else {
1787 lappend stillbold $row
1790 set boldrows $stillbold
1793 proc addvhighlight {n} {
1794 global hlview curview viewdata vhl_done vhighlights commitidx
1796 if {[info exists hlview]} {
1797 delvhighlight
1799 set hlview $n
1800 if {$n != $curview && ![info exists viewdata($n)]} {
1801 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1802 set vparentlist($n) {}
1803 set vchildlist($n) {}
1804 set vdisporder($n) {}
1805 set vcmitlisted($n) {}
1806 start_rev_list $n
1808 set vhl_done $commitidx($hlview)
1809 if {$vhl_done > 0} {
1810 drawvisible
1814 proc delvhighlight {} {
1815 global hlview vhighlights
1817 if {![info exists hlview]} return
1818 unset hlview
1819 catch {unset vhighlights}
1820 unbolden
1823 proc vhighlightmore {} {
1824 global hlview vhl_done commitidx vhighlights
1825 global displayorder vdisporder curview mainfont
1827 set font [concat $mainfont bold]
1828 set max $commitidx($hlview)
1829 if {$hlview == $curview} {
1830 set disp $displayorder
1831 } else {
1832 set disp $vdisporder($hlview)
1834 set vr [visiblerows]
1835 set r0 [lindex $vr 0]
1836 set r1 [lindex $vr 1]
1837 for {set i $vhl_done} {$i < $max} {incr i} {
1838 set id [lindex $disp $i]
1839 if {[info exists commitrow($curview,$id)]} {
1840 set row $commitrow($curview,$id)
1841 if {$r0 <= $row && $row <= $r1} {
1842 if {![highlighted $row]} {
1843 bolden $row $font
1845 set vhighlights($row) 1
1849 set vhl_done $max
1852 proc askvhighlight {row id} {
1853 global hlview vhighlights commitrow iddrawn mainfont
1855 if {[info exists commitrow($hlview,$id)]} {
1856 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1857 bolden $row [concat $mainfont bold]
1859 set vhighlights($row) 1
1860 } else {
1861 set vhighlights($row) 0
1865 proc hfiles_change {name ix op} {
1866 global highlight_files filehighlight fhighlights fh_serial
1867 global mainfont highlight_paths
1869 if {[info exists filehighlight]} {
1870 # delete previous highlights
1871 catch {close $filehighlight}
1872 unset filehighlight
1873 catch {unset fhighlights}
1874 unbolden
1875 unhighlight_filelist
1877 set highlight_paths {}
1878 after cancel do_file_hl $fh_serial
1879 incr fh_serial
1880 if {$highlight_files ne {}} {
1881 after 300 do_file_hl $fh_serial
1885 proc makepatterns {l} {
1886 set ret {}
1887 foreach e $l {
1888 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1889 if {[string index $ee end] eq "/"} {
1890 lappend ret "$ee*"
1891 } else {
1892 lappend ret $ee
1893 lappend ret "$ee/*"
1896 return $ret
1899 proc do_file_hl {serial} {
1900 global highlight_files filehighlight highlight_paths gdttype fhl_list
1902 if {$gdttype eq "touching paths:"} {
1903 if {[catch {set paths [shellsplit $highlight_files]}]} return
1904 set highlight_paths [makepatterns $paths]
1905 highlight_filelist
1906 set gdtargs [concat -- $paths]
1907 } else {
1908 set gdtargs [list "-S$highlight_files"]
1910 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1911 set filehighlight [open $cmd r+]
1912 fconfigure $filehighlight -blocking 0
1913 fileevent $filehighlight readable readfhighlight
1914 set fhl_list {}
1915 drawvisible
1916 flushhighlights
1919 proc flushhighlights {} {
1920 global filehighlight fhl_list
1922 if {[info exists filehighlight]} {
1923 lappend fhl_list {}
1924 puts $filehighlight ""
1925 flush $filehighlight
1929 proc askfilehighlight {row id} {
1930 global filehighlight fhighlights fhl_list
1932 lappend fhl_list $id
1933 set fhighlights($row) -1
1934 puts $filehighlight $id
1937 proc readfhighlight {} {
1938 global filehighlight fhighlights commitrow curview mainfont iddrawn
1939 global fhl_list
1941 while {[gets $filehighlight line] >= 0} {
1942 set line [string trim $line]
1943 set i [lsearch -exact $fhl_list $line]
1944 if {$i < 0} continue
1945 for {set j 0} {$j < $i} {incr j} {
1946 set id [lindex $fhl_list $j]
1947 if {[info exists commitrow($curview,$id)]} {
1948 set fhighlights($commitrow($curview,$id)) 0
1951 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1952 if {$line eq {}} continue
1953 if {![info exists commitrow($curview,$line)]} continue
1954 set row $commitrow($curview,$line)
1955 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1956 bolden $row [concat $mainfont bold]
1958 set fhighlights($row) 1
1960 if {[eof $filehighlight]} {
1961 # strange...
1962 puts "oops, git diff-tree died"
1963 catch {close $filehighlight}
1964 unset filehighlight
1966 next_hlcont
1969 proc find_change {name ix op} {
1970 global nhighlights mainfont boldnamerows
1971 global findstring findpattern findtype
1973 # delete previous highlights, if any
1974 foreach row $boldnamerows {
1975 bolden_name $row $mainfont
1977 set boldnamerows {}
1978 catch {unset nhighlights}
1979 unbolden
1980 if {$findtype ne "Regexp"} {
1981 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1982 $findstring]
1983 set findpattern "*$e*"
1985 drawvisible
1988 proc askfindhighlight {row id} {
1989 global nhighlights commitinfo iddrawn mainfont
1990 global findstring findtype findloc findpattern
1992 if {![info exists commitinfo($id)]} {
1993 getcommit $id
1995 set info $commitinfo($id)
1996 set isbold 0
1997 set fldtypes {Headline Author Date Committer CDate Comments}
1998 foreach f $info ty $fldtypes {
1999 if {$findloc ne "All fields" && $findloc ne $ty} {
2000 continue
2002 if {$findtype eq "Regexp"} {
2003 set doesmatch [regexp $findstring $f]
2004 } elseif {$findtype eq "IgnCase"} {
2005 set doesmatch [string match -nocase $findpattern $f]
2006 } else {
2007 set doesmatch [string match $findpattern $f]
2009 if {$doesmatch} {
2010 if {$ty eq "Author"} {
2011 set isbold 2
2012 } else {
2013 set isbold 1
2017 if {[info exists iddrawn($id)]} {
2018 if {$isbold && ![ishighlighted $row]} {
2019 bolden $row [concat $mainfont bold]
2021 if {$isbold >= 2} {
2022 bolden_name $row [concat $mainfont bold]
2025 set nhighlights($row) $isbold
2028 proc vrel_change {name ix op} {
2029 global highlight_related
2031 rhighlight_none
2032 if {$highlight_related ne "None"} {
2033 after idle drawvisible
2037 # prepare for testing whether commits are descendents or ancestors of a
2038 proc rhighlight_sel {a} {
2039 global descendent desc_todo ancestor anc_todo
2040 global highlight_related rhighlights
2042 catch {unset descendent}
2043 set desc_todo [list $a]
2044 catch {unset ancestor}
2045 set anc_todo [list $a]
2046 if {$highlight_related ne "None"} {
2047 rhighlight_none
2048 after idle drawvisible
2052 proc rhighlight_none {} {
2053 global rhighlights
2055 catch {unset rhighlights}
2056 unbolden
2059 proc is_descendent {a} {
2060 global curview children commitrow descendent desc_todo
2062 set v $curview
2063 set la $commitrow($v,$a)
2064 set todo $desc_todo
2065 set leftover {}
2066 set done 0
2067 for {set i 0} {$i < [llength $todo]} {incr i} {
2068 set do [lindex $todo $i]
2069 if {$commitrow($v,$do) < $la} {
2070 lappend leftover $do
2071 continue
2073 foreach nk $children($v,$do) {
2074 if {![info exists descendent($nk)]} {
2075 set descendent($nk) 1
2076 lappend todo $nk
2077 if {$nk eq $a} {
2078 set done 1
2082 if {$done} {
2083 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2084 return
2087 set descendent($a) 0
2088 set desc_todo $leftover
2091 proc is_ancestor {a} {
2092 global curview parentlist commitrow ancestor anc_todo
2094 set v $curview
2095 set la $commitrow($v,$a)
2096 set todo $anc_todo
2097 set leftover {}
2098 set done 0
2099 for {set i 0} {$i < [llength $todo]} {incr i} {
2100 set do [lindex $todo $i]
2101 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2102 lappend leftover $do
2103 continue
2105 foreach np [lindex $parentlist $commitrow($v,$do)] {
2106 if {![info exists ancestor($np)]} {
2107 set ancestor($np) 1
2108 lappend todo $np
2109 if {$np eq $a} {
2110 set done 1
2114 if {$done} {
2115 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2116 return
2119 set ancestor($a) 0
2120 set anc_todo $leftover
2123 proc askrelhighlight {row id} {
2124 global descendent highlight_related iddrawn mainfont rhighlights
2125 global selectedline ancestor
2127 if {![info exists selectedline]} return
2128 set isbold 0
2129 if {$highlight_related eq "Descendent" ||
2130 $highlight_related eq "Not descendent"} {
2131 if {![info exists descendent($id)]} {
2132 is_descendent $id
2134 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2135 set isbold 1
2137 } elseif {$highlight_related eq "Ancestor" ||
2138 $highlight_related eq "Not ancestor"} {
2139 if {![info exists ancestor($id)]} {
2140 is_ancestor $id
2142 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2143 set isbold 1
2146 if {[info exists iddrawn($id)]} {
2147 if {$isbold && ![ishighlighted $row]} {
2148 bolden $row [concat $mainfont bold]
2151 set rhighlights($row) $isbold
2154 proc next_hlcont {} {
2155 global fhl_row fhl_dirn displayorder numcommits
2156 global vhighlights fhighlights nhighlights rhighlights
2157 global hlview filehighlight findstring highlight_related
2159 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2160 set row $fhl_row
2161 while {1} {
2162 if {$row < 0 || $row >= $numcommits} {
2163 bell
2164 set fhl_dirn 0
2165 return
2167 set id [lindex $displayorder $row]
2168 if {[info exists hlview]} {
2169 if {![info exists vhighlights($row)]} {
2170 askvhighlight $row $id
2172 if {$vhighlights($row) > 0} break
2174 if {$findstring ne {}} {
2175 if {![info exists nhighlights($row)]} {
2176 askfindhighlight $row $id
2178 if {$nhighlights($row) > 0} break
2180 if {$highlight_related ne "None"} {
2181 if {![info exists rhighlights($row)]} {
2182 askrelhighlight $row $id
2184 if {$rhighlights($row) > 0} break
2186 if {[info exists filehighlight]} {
2187 if {![info exists fhighlights($row)]} {
2188 # ask for a few more while we're at it...
2189 set r $row
2190 for {set n 0} {$n < 100} {incr n} {
2191 if {![info exists fhighlights($r)]} {
2192 askfilehighlight $r [lindex $displayorder $r]
2194 incr r $fhl_dirn
2195 if {$r < 0 || $r >= $numcommits} break
2197 flushhighlights
2199 if {$fhighlights($row) < 0} {
2200 set fhl_row $row
2201 return
2203 if {$fhighlights($row) > 0} break
2205 incr row $fhl_dirn
2207 set fhl_dirn 0
2208 selectline $row 1
2211 proc next_highlight {dirn} {
2212 global selectedline fhl_row fhl_dirn
2213 global hlview filehighlight findstring highlight_related
2215 if {![info exists selectedline]} return
2216 if {!([info exists hlview] || $findstring ne {} ||
2217 $highlight_related ne "None" || [info exists filehighlight])} return
2218 set fhl_row [expr {$selectedline + $dirn}]
2219 set fhl_dirn $dirn
2220 next_hlcont
2223 proc cancel_next_highlight {} {
2224 global fhl_dirn
2226 set fhl_dirn 0
2229 # Graph layout functions
2231 proc shortids {ids} {
2232 set res {}
2233 foreach id $ids {
2234 if {[llength $id] > 1} {
2235 lappend res [shortids $id]
2236 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2237 lappend res [string range $id 0 7]
2238 } else {
2239 lappend res $id
2242 return $res
2245 proc incrange {l x o} {
2246 set n [llength $l]
2247 while {$x < $n} {
2248 set e [lindex $l $x]
2249 if {$e ne {}} {
2250 lset l $x [expr {$e + $o}]
2252 incr x
2254 return $l
2257 proc ntimes {n o} {
2258 set ret {}
2259 for {} {$n > 0} {incr n -1} {
2260 lappend ret $o
2262 return $ret
2265 proc usedinrange {id l1 l2} {
2266 global children commitrow childlist curview
2268 if {[info exists commitrow($curview,$id)]} {
2269 set r $commitrow($curview,$id)
2270 if {$l1 <= $r && $r <= $l2} {
2271 return [expr {$r - $l1 + 1}]
2273 set kids [lindex $childlist $r]
2274 } else {
2275 set kids $children($curview,$id)
2277 foreach c $kids {
2278 set r $commitrow($curview,$c)
2279 if {$l1 <= $r && $r <= $l2} {
2280 return [expr {$r - $l1 + 1}]
2283 return 0
2286 proc sanity {row {full 0}} {
2287 global rowidlist rowoffsets
2289 set col -1
2290 set ids [lindex $rowidlist $row]
2291 foreach id $ids {
2292 incr col
2293 if {$id eq {}} continue
2294 if {$col < [llength $ids] - 1 &&
2295 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2296 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2298 set o [lindex $rowoffsets $row $col]
2299 set y $row
2300 set x $col
2301 while {$o ne {}} {
2302 incr y -1
2303 incr x $o
2304 if {[lindex $rowidlist $y $x] != $id} {
2305 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2306 puts " id=[shortids $id] check started at row $row"
2307 for {set i $row} {$i >= $y} {incr i -1} {
2308 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2310 break
2312 if {!$full} break
2313 set o [lindex $rowoffsets $y $x]
2318 proc makeuparrow {oid x y z} {
2319 global rowidlist rowoffsets uparrowlen idrowranges
2321 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2322 incr y -1
2323 incr x $z
2324 set off0 [lindex $rowoffsets $y]
2325 for {set x0 $x} {1} {incr x0} {
2326 if {$x0 >= [llength $off0]} {
2327 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2328 break
2330 set z [lindex $off0 $x0]
2331 if {$z ne {}} {
2332 incr x0 $z
2333 break
2336 set z [expr {$x0 - $x}]
2337 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2338 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2340 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2341 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2342 lappend idrowranges($oid) $y
2345 proc initlayout {} {
2346 global rowidlist rowoffsets displayorder commitlisted
2347 global rowlaidout rowoptim
2348 global idinlist rowchk rowrangelist idrowranges
2349 global numcommits canvxmax canv
2350 global nextcolor
2351 global parentlist childlist children
2352 global colormap rowtextx
2353 global linesegends
2355 set numcommits 0
2356 set displayorder {}
2357 set commitlisted {}
2358 set parentlist {}
2359 set childlist {}
2360 set rowrangelist {}
2361 set nextcolor 0
2362 set rowidlist {{}}
2363 set rowoffsets {{}}
2364 catch {unset idinlist}
2365 catch {unset rowchk}
2366 set rowlaidout 0
2367 set rowoptim 0
2368 set canvxmax [$canv cget -width]
2369 catch {unset colormap}
2370 catch {unset rowtextx}
2371 catch {unset idrowranges}
2372 set linesegends {}
2375 proc setcanvscroll {} {
2376 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2378 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2379 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2380 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2381 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2384 proc visiblerows {} {
2385 global canv numcommits linespc
2387 set ymax [lindex [$canv cget -scrollregion] 3]
2388 if {$ymax eq {} || $ymax == 0} return
2389 set f [$canv yview]
2390 set y0 [expr {int([lindex $f 0] * $ymax)}]
2391 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2392 if {$r0 < 0} {
2393 set r0 0
2395 set y1 [expr {int([lindex $f 1] * $ymax)}]
2396 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2397 if {$r1 >= $numcommits} {
2398 set r1 [expr {$numcommits - 1}]
2400 return [list $r0 $r1]
2403 proc layoutmore {tmax} {
2404 global rowlaidout rowoptim commitidx numcommits optim_delay
2405 global uparrowlen curview
2407 while {1} {
2408 if {$rowoptim - $optim_delay > $numcommits} {
2409 showstuff [expr {$rowoptim - $optim_delay}]
2410 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2411 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2412 if {$nr > 100} {
2413 set nr 100
2415 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2416 incr rowoptim $nr
2417 } elseif {$commitidx($curview) > $rowlaidout} {
2418 set nr [expr {$commitidx($curview) - $rowlaidout}]
2419 # may need to increase this threshold if uparrowlen or
2420 # mingaplen are increased...
2421 if {$nr > 150} {
2422 set nr 150
2424 set row $rowlaidout
2425 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2426 if {$rowlaidout == $row} {
2427 return 0
2429 } else {
2430 return 0
2432 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2433 return 1
2438 proc showstuff {canshow} {
2439 global numcommits commitrow pending_select selectedline
2440 global linesegends idrowranges idrangedrawn curview
2442 if {$numcommits == 0} {
2443 global phase
2444 set phase "incrdraw"
2445 allcanvs delete all
2447 set row $numcommits
2448 set numcommits $canshow
2449 setcanvscroll
2450 set rows [visiblerows]
2451 set r0 [lindex $rows 0]
2452 set r1 [lindex $rows 1]
2453 set selrow -1
2454 for {set r $row} {$r < $canshow} {incr r} {
2455 foreach id [lindex $linesegends [expr {$r+1}]] {
2456 set i -1
2457 foreach {s e} [rowranges $id] {
2458 incr i
2459 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2460 && ![info exists idrangedrawn($id,$i)]} {
2461 drawlineseg $id $i
2462 set idrangedrawn($id,$i) 1
2467 if {$canshow > $r1} {
2468 set canshow $r1
2470 while {$row < $canshow} {
2471 drawcmitrow $row
2472 incr row
2474 if {[info exists pending_select] &&
2475 [info exists commitrow($curview,$pending_select)] &&
2476 $commitrow($curview,$pending_select) < $numcommits} {
2477 selectline $commitrow($curview,$pending_select) 1
2479 if {![info exists selectedline] && ![info exists pending_select]} {
2480 selectline 0 1
2484 proc layoutrows {row endrow last} {
2485 global rowidlist rowoffsets displayorder
2486 global uparrowlen downarrowlen maxwidth mingaplen
2487 global childlist parentlist
2488 global idrowranges linesegends
2489 global commitidx curview
2490 global idinlist rowchk rowrangelist
2492 set idlist [lindex $rowidlist $row]
2493 set offs [lindex $rowoffsets $row]
2494 while {$row < $endrow} {
2495 set id [lindex $displayorder $row]
2496 set oldolds {}
2497 set newolds {}
2498 foreach p [lindex $parentlist $row] {
2499 if {![info exists idinlist($p)]} {
2500 lappend newolds $p
2501 } elseif {!$idinlist($p)} {
2502 lappend oldolds $p
2505 set lse {}
2506 set nev [expr {[llength $idlist] + [llength $newolds]
2507 + [llength $oldolds] - $maxwidth + 1}]
2508 if {$nev > 0} {
2509 if {!$last &&
2510 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2511 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2512 set i [lindex $idlist $x]
2513 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2514 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2515 [expr {$row + $uparrowlen + $mingaplen}]]
2516 if {$r == 0} {
2517 set idlist [lreplace $idlist $x $x]
2518 set offs [lreplace $offs $x $x]
2519 set offs [incrange $offs $x 1]
2520 set idinlist($i) 0
2521 set rm1 [expr {$row - 1}]
2522 lappend lse $i
2523 lappend idrowranges($i) $rm1
2524 if {[incr nev -1] <= 0} break
2525 continue
2527 set rowchk($id) [expr {$row + $r}]
2530 lset rowidlist $row $idlist
2531 lset rowoffsets $row $offs
2533 lappend linesegends $lse
2534 set col [lsearch -exact $idlist $id]
2535 if {$col < 0} {
2536 set col [llength $idlist]
2537 lappend idlist $id
2538 lset rowidlist $row $idlist
2539 set z {}
2540 if {[lindex $childlist $row] ne {}} {
2541 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2542 unset idinlist($id)
2544 lappend offs $z
2545 lset rowoffsets $row $offs
2546 if {$z ne {}} {
2547 makeuparrow $id $col $row $z
2549 } else {
2550 unset idinlist($id)
2552 set ranges {}
2553 if {[info exists idrowranges($id)]} {
2554 set ranges $idrowranges($id)
2555 lappend ranges $row
2556 unset idrowranges($id)
2558 lappend rowrangelist $ranges
2559 incr row
2560 set offs [ntimes [llength $idlist] 0]
2561 set l [llength $newolds]
2562 set idlist [eval lreplace \$idlist $col $col $newolds]
2563 set o 0
2564 if {$l != 1} {
2565 set offs [lrange $offs 0 [expr {$col - 1}]]
2566 foreach x $newolds {
2567 lappend offs {}
2568 incr o -1
2570 incr o
2571 set tmp [expr {[llength $idlist] - [llength $offs]}]
2572 if {$tmp > 0} {
2573 set offs [concat $offs [ntimes $tmp $o]]
2575 } else {
2576 lset offs $col {}
2578 foreach i $newolds {
2579 set idinlist($i) 1
2580 set idrowranges($i) $row
2582 incr col $l
2583 foreach oid $oldolds {
2584 set idinlist($oid) 1
2585 set idlist [linsert $idlist $col $oid]
2586 set offs [linsert $offs $col $o]
2587 makeuparrow $oid $col $row $o
2588 incr col
2590 lappend rowidlist $idlist
2591 lappend rowoffsets $offs
2593 return $row
2596 proc addextraid {id row} {
2597 global displayorder commitrow commitinfo
2598 global commitidx commitlisted
2599 global parentlist childlist children curview
2601 incr commitidx($curview)
2602 lappend displayorder $id
2603 lappend commitlisted 0
2604 lappend parentlist {}
2605 set commitrow($curview,$id) $row
2606 readcommit $id
2607 if {![info exists commitinfo($id)]} {
2608 set commitinfo($id) {"No commit information available"}
2610 if {![info exists children($curview,$id)]} {
2611 set children($curview,$id) {}
2613 lappend childlist $children($curview,$id)
2616 proc layouttail {} {
2617 global rowidlist rowoffsets idinlist commitidx curview
2618 global idrowranges rowrangelist
2620 set row $commitidx($curview)
2621 set idlist [lindex $rowidlist $row]
2622 while {$idlist ne {}} {
2623 set col [expr {[llength $idlist] - 1}]
2624 set id [lindex $idlist $col]
2625 addextraid $id $row
2626 unset idinlist($id)
2627 lappend idrowranges($id) $row
2628 lappend rowrangelist $idrowranges($id)
2629 unset idrowranges($id)
2630 incr row
2631 set offs [ntimes $col 0]
2632 set idlist [lreplace $idlist $col $col]
2633 lappend rowidlist $idlist
2634 lappend rowoffsets $offs
2637 foreach id [array names idinlist] {
2638 addextraid $id $row
2639 lset rowidlist $row [list $id]
2640 lset rowoffsets $row 0
2641 makeuparrow $id 0 $row 0
2642 lappend idrowranges($id) $row
2643 lappend rowrangelist $idrowranges($id)
2644 unset idrowranges($id)
2645 incr row
2646 lappend rowidlist {}
2647 lappend rowoffsets {}
2651 proc insert_pad {row col npad} {
2652 global rowidlist rowoffsets
2654 set pad [ntimes $npad {}]
2655 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2656 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2657 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2660 proc optimize_rows {row col endrow} {
2661 global rowidlist rowoffsets idrowranges displayorder
2663 for {} {$row < $endrow} {incr row} {
2664 set idlist [lindex $rowidlist $row]
2665 set offs [lindex $rowoffsets $row]
2666 set haspad 0
2667 for {} {$col < [llength $offs]} {incr col} {
2668 if {[lindex $idlist $col] eq {}} {
2669 set haspad 1
2670 continue
2672 set z [lindex $offs $col]
2673 if {$z eq {}} continue
2674 set isarrow 0
2675 set x0 [expr {$col + $z}]
2676 set y0 [expr {$row - 1}]
2677 set z0 [lindex $rowoffsets $y0 $x0]
2678 if {$z0 eq {}} {
2679 set id [lindex $idlist $col]
2680 set ranges [rowranges $id]
2681 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2682 set isarrow 1
2685 if {$z < -1 || ($z < 0 && $isarrow)} {
2686 set npad [expr {-1 - $z + $isarrow}]
2687 set offs [incrange $offs $col $npad]
2688 insert_pad $y0 $x0 $npad
2689 if {$y0 > 0} {
2690 optimize_rows $y0 $x0 $row
2692 set z [lindex $offs $col]
2693 set x0 [expr {$col + $z}]
2694 set z0 [lindex $rowoffsets $y0 $x0]
2695 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2696 set npad [expr {$z - 1 + $isarrow}]
2697 set y1 [expr {$row + 1}]
2698 set offs2 [lindex $rowoffsets $y1]
2699 set x1 -1
2700 foreach z $offs2 {
2701 incr x1
2702 if {$z eq {} || $x1 + $z < $col} continue
2703 if {$x1 + $z > $col} {
2704 incr npad
2706 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2707 break
2709 set pad [ntimes $npad {}]
2710 set idlist [eval linsert \$idlist $col $pad]
2711 set tmp [eval linsert \$offs $col $pad]
2712 incr col $npad
2713 set offs [incrange $tmp $col [expr {-$npad}]]
2714 set z [lindex $offs $col]
2715 set haspad 1
2717 if {$z0 eq {} && !$isarrow} {
2718 # this line links to its first child on row $row-2
2719 set rm2 [expr {$row - 2}]
2720 set id [lindex $displayorder $rm2]
2721 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2722 if {$xc >= 0} {
2723 set z0 [expr {$xc - $x0}]
2726 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2727 insert_pad $y0 $x0 1
2728 set offs [incrange $offs $col 1]
2729 optimize_rows $y0 [expr {$x0 + 1}] $row
2732 if {!$haspad} {
2733 set o {}
2734 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2735 set o [lindex $offs $col]
2736 if {$o eq {}} {
2737 # check if this is the link to the first child
2738 set id [lindex $idlist $col]
2739 set ranges [rowranges $id]
2740 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2741 # it is, work out offset to child
2742 set y0 [expr {$row - 1}]
2743 set id [lindex $displayorder $y0]
2744 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2745 if {$x0 >= 0} {
2746 set o [expr {$x0 - $col}]
2750 if {$o eq {} || $o <= 0} break
2752 if {$o ne {} && [incr col] < [llength $idlist]} {
2753 set y1 [expr {$row + 1}]
2754 set offs2 [lindex $rowoffsets $y1]
2755 set x1 -1
2756 foreach z $offs2 {
2757 incr x1
2758 if {$z eq {} || $x1 + $z < $col} continue
2759 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2760 break
2762 set idlist [linsert $idlist $col {}]
2763 set tmp [linsert $offs $col {}]
2764 incr col
2765 set offs [incrange $tmp $col -1]
2768 lset rowidlist $row $idlist
2769 lset rowoffsets $row $offs
2770 set col 0
2774 proc xc {row col} {
2775 global canvx0 linespc
2776 return [expr {$canvx0 + $col * $linespc}]
2779 proc yc {row} {
2780 global canvy0 linespc
2781 return [expr {$canvy0 + $row * $linespc}]
2784 proc linewidth {id} {
2785 global thickerline lthickness
2787 set wid $lthickness
2788 if {[info exists thickerline] && $id eq $thickerline} {
2789 set wid [expr {2 * $lthickness}]
2791 return $wid
2794 proc rowranges {id} {
2795 global phase idrowranges commitrow rowlaidout rowrangelist curview
2797 set ranges {}
2798 if {$phase eq {} ||
2799 ([info exists commitrow($curview,$id)]
2800 && $commitrow($curview,$id) < $rowlaidout)} {
2801 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2802 } elseif {[info exists idrowranges($id)]} {
2803 set ranges $idrowranges($id)
2805 return $ranges
2808 proc drawlineseg {id i} {
2809 global rowoffsets rowidlist
2810 global displayorder
2811 global canv colormap linespc
2812 global numcommits commitrow curview
2814 set ranges [rowranges $id]
2815 set downarrow 1
2816 if {[info exists commitrow($curview,$id)]
2817 && $commitrow($curview,$id) < $numcommits} {
2818 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2819 } else {
2820 set downarrow 1
2822 set startrow [lindex $ranges [expr {2 * $i}]]
2823 set row [lindex $ranges [expr {2 * $i + 1}]]
2824 if {$startrow == $row} return
2825 assigncolor $id
2826 set coords {}
2827 set col [lsearch -exact [lindex $rowidlist $row] $id]
2828 if {$col < 0} {
2829 puts "oops: drawline: id $id not on row $row"
2830 return
2832 set lasto {}
2833 set ns 0
2834 while {1} {
2835 set o [lindex $rowoffsets $row $col]
2836 if {$o eq {}} break
2837 if {$o ne $lasto} {
2838 # changing direction
2839 set x [xc $row $col]
2840 set y [yc $row]
2841 lappend coords $x $y
2842 set lasto $o
2844 incr col $o
2845 incr row -1
2847 set x [xc $row $col]
2848 set y [yc $row]
2849 lappend coords $x $y
2850 if {$i == 0} {
2851 # draw the link to the first child as part of this line
2852 incr row -1
2853 set child [lindex $displayorder $row]
2854 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2855 if {$ccol >= 0} {
2856 set x [xc $row $ccol]
2857 set y [yc $row]
2858 if {$ccol < $col - 1} {
2859 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2860 } elseif {$ccol > $col + 1} {
2861 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2863 lappend coords $x $y
2866 if {[llength $coords] < 4} return
2867 if {$downarrow} {
2868 # This line has an arrow at the lower end: check if the arrow is
2869 # on a diagonal segment, and if so, work around the Tk 8.4
2870 # refusal to draw arrows on diagonal lines.
2871 set x0 [lindex $coords 0]
2872 set x1 [lindex $coords 2]
2873 if {$x0 != $x1} {
2874 set y0 [lindex $coords 1]
2875 set y1 [lindex $coords 3]
2876 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2877 # we have a nearby vertical segment, just trim off the diag bit
2878 set coords [lrange $coords 2 end]
2879 } else {
2880 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2881 set xi [expr {$x0 - $slope * $linespc / 2}]
2882 set yi [expr {$y0 - $linespc / 2}]
2883 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2887 set arrow [expr {2 * ($i > 0) + $downarrow}]
2888 set arrow [lindex {none first last both} $arrow]
2889 set t [$canv create line $coords -width [linewidth $id] \
2890 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2891 $canv lower $t
2892 bindline $t $id
2895 proc drawparentlinks {id row col olds} {
2896 global rowidlist canv colormap
2898 set row2 [expr {$row + 1}]
2899 set x [xc $row $col]
2900 set y [yc $row]
2901 set y2 [yc $row2]
2902 set ids [lindex $rowidlist $row2]
2903 # rmx = right-most X coord used
2904 set rmx 0
2905 foreach p $olds {
2906 set i [lsearch -exact $ids $p]
2907 if {$i < 0} {
2908 puts "oops, parent $p of $id not in list"
2909 continue
2911 set x2 [xc $row2 $i]
2912 if {$x2 > $rmx} {
2913 set rmx $x2
2915 set ranges [rowranges $p]
2916 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2917 && $row2 < [lindex $ranges 1]} {
2918 # drawlineseg will do this one for us
2919 continue
2921 assigncolor $p
2922 # should handle duplicated parents here...
2923 set coords [list $x $y]
2924 if {$i < $col - 1} {
2925 lappend coords [xc $row [expr {$i + 1}]] $y
2926 } elseif {$i > $col + 1} {
2927 lappend coords [xc $row [expr {$i - 1}]] $y
2929 lappend coords $x2 $y2
2930 set t [$canv create line $coords -width [linewidth $p] \
2931 -fill $colormap($p) -tags lines.$p]
2932 $canv lower $t
2933 bindline $t $p
2935 return $rmx
2938 proc drawlines {id} {
2939 global colormap canv
2940 global idrangedrawn
2941 global children iddrawn commitrow rowidlist curview
2943 $canv delete lines.$id
2944 set nr [expr {[llength [rowranges $id]] / 2}]
2945 for {set i 0} {$i < $nr} {incr i} {
2946 if {[info exists idrangedrawn($id,$i)]} {
2947 drawlineseg $id $i
2950 foreach child $children($curview,$id) {
2951 if {[info exists iddrawn($child)]} {
2952 set row $commitrow($curview,$child)
2953 set col [lsearch -exact [lindex $rowidlist $row] $child]
2954 if {$col >= 0} {
2955 drawparentlinks $child $row $col [list $id]
2961 proc drawcmittext {id row col rmx} {
2962 global linespc canv canv2 canv3 canvy0 fgcolor
2963 global commitlisted commitinfo rowidlist
2964 global rowtextx idpos idtags idheads idotherrefs
2965 global linehtag linentag linedtag
2966 global mainfont canvxmax boldrows boldnamerows fgcolor
2968 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2969 set x [xc $row $col]
2970 set y [yc $row]
2971 set orad [expr {$linespc / 3}]
2972 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2973 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2974 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2975 $canv raise $t
2976 $canv bind $t <1> {selcanvline {} %x %y}
2977 set xt [xc $row [llength [lindex $rowidlist $row]]]
2978 if {$xt < $rmx} {
2979 set xt $rmx
2981 set rowtextx($row) $xt
2982 set idpos($id) [list $x $xt $y]
2983 if {[info exists idtags($id)] || [info exists idheads($id)]
2984 || [info exists idotherrefs($id)]} {
2985 set xt [drawtags $id $x $xt $y]
2987 set headline [lindex $commitinfo($id) 0]
2988 set name [lindex $commitinfo($id) 1]
2989 set date [lindex $commitinfo($id) 2]
2990 set date [formatdate $date]
2991 set font $mainfont
2992 set nfont $mainfont
2993 set isbold [ishighlighted $row]
2994 if {$isbold > 0} {
2995 lappend boldrows $row
2996 lappend font bold
2997 if {$isbold > 1} {
2998 lappend boldnamerows $row
2999 lappend nfont bold
3002 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3003 -text $headline -font $font -tags text]
3004 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3005 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3006 -text $name -font $nfont -tags text]
3007 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3008 -text $date -font $mainfont -tags text]
3009 set xr [expr {$xt + [font measure $mainfont $headline]}]
3010 if {$xr > $canvxmax} {
3011 set canvxmax $xr
3012 setcanvscroll
3016 proc drawcmitrow {row} {
3017 global displayorder rowidlist
3018 global idrangedrawn iddrawn
3019 global commitinfo parentlist numcommits
3020 global filehighlight fhighlights findstring nhighlights
3021 global hlview vhighlights
3022 global highlight_related rhighlights
3024 if {$row >= $numcommits} return
3025 foreach id [lindex $rowidlist $row] {
3026 if {$id eq {}} continue
3027 set i -1
3028 foreach {s e} [rowranges $id] {
3029 incr i
3030 if {$row < $s} continue
3031 if {$e eq {}} break
3032 if {$row <= $e} {
3033 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3034 drawlineseg $id $i
3035 set idrangedrawn($id,$i) 1
3037 break
3042 set id [lindex $displayorder $row]
3043 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3044 askvhighlight $row $id
3046 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3047 askfilehighlight $row $id
3049 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3050 askfindhighlight $row $id
3052 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3053 askrelhighlight $row $id
3055 if {[info exists iddrawn($id)]} return
3056 set col [lsearch -exact [lindex $rowidlist $row] $id]
3057 if {$col < 0} {
3058 puts "oops, row $row id $id not in list"
3059 return
3061 if {![info exists commitinfo($id)]} {
3062 getcommit $id
3064 assigncolor $id
3065 set olds [lindex $parentlist $row]
3066 if {$olds ne {}} {
3067 set rmx [drawparentlinks $id $row $col $olds]
3068 } else {
3069 set rmx 0
3071 drawcmittext $id $row $col $rmx
3072 set iddrawn($id) 1
3075 proc drawfrac {f0 f1} {
3076 global numcommits canv
3077 global linespc
3079 set ymax [lindex [$canv cget -scrollregion] 3]
3080 if {$ymax eq {} || $ymax == 0} return
3081 set y0 [expr {int($f0 * $ymax)}]
3082 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3083 if {$row < 0} {
3084 set row 0
3086 set y1 [expr {int($f1 * $ymax)}]
3087 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3088 if {$endrow >= $numcommits} {
3089 set endrow [expr {$numcommits - 1}]
3091 for {} {$row <= $endrow} {incr row} {
3092 drawcmitrow $row
3096 proc drawvisible {} {
3097 global canv
3098 eval drawfrac [$canv yview]
3101 proc clear_display {} {
3102 global iddrawn idrangedrawn
3103 global vhighlights fhighlights nhighlights rhighlights
3105 allcanvs delete all
3106 catch {unset iddrawn}
3107 catch {unset idrangedrawn}
3108 catch {unset vhighlights}
3109 catch {unset fhighlights}
3110 catch {unset nhighlights}
3111 catch {unset rhighlights}
3114 proc findcrossings {id} {
3115 global rowidlist parentlist numcommits rowoffsets displayorder
3117 set cross {}
3118 set ccross {}
3119 foreach {s e} [rowranges $id] {
3120 if {$e >= $numcommits} {
3121 set e [expr {$numcommits - 1}]
3123 if {$e <= $s} continue
3124 set x [lsearch -exact [lindex $rowidlist $e] $id]
3125 if {$x < 0} {
3126 puts "findcrossings: oops, no [shortids $id] in row $e"
3127 continue
3129 for {set row $e} {[incr row -1] >= $s} {} {
3130 set olds [lindex $parentlist $row]
3131 set kid [lindex $displayorder $row]
3132 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3133 if {$kidx < 0} continue
3134 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3135 foreach p $olds {
3136 set px [lsearch -exact $nextrow $p]
3137 if {$px < 0} continue
3138 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3139 if {[lsearch -exact $ccross $p] >= 0} continue
3140 if {$x == $px + ($kidx < $px? -1: 1)} {
3141 lappend ccross $p
3142 } elseif {[lsearch -exact $cross $p] < 0} {
3143 lappend cross $p
3147 set inc [lindex $rowoffsets $row $x]
3148 if {$inc eq {}} break
3149 incr x $inc
3152 return [concat $ccross {{}} $cross]
3155 proc assigncolor {id} {
3156 global colormap colors nextcolor
3157 global commitrow parentlist children children curview
3159 if {[info exists colormap($id)]} return
3160 set ncolors [llength $colors]
3161 if {[info exists children($curview,$id)]} {
3162 set kids $children($curview,$id)
3163 } else {
3164 set kids {}
3166 if {[llength $kids] == 1} {
3167 set child [lindex $kids 0]
3168 if {[info exists colormap($child)]
3169 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3170 set colormap($id) $colormap($child)
3171 return
3174 set badcolors {}
3175 set origbad {}
3176 foreach x [findcrossings $id] {
3177 if {$x eq {}} {
3178 # delimiter between corner crossings and other crossings
3179 if {[llength $badcolors] >= $ncolors - 1} break
3180 set origbad $badcolors
3182 if {[info exists colormap($x)]
3183 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3184 lappend badcolors $colormap($x)
3187 if {[llength $badcolors] >= $ncolors} {
3188 set badcolors $origbad
3190 set origbad $badcolors
3191 if {[llength $badcolors] < $ncolors - 1} {
3192 foreach child $kids {
3193 if {[info exists colormap($child)]
3194 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3195 lappend badcolors $colormap($child)
3197 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3198 if {[info exists colormap($p)]
3199 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3200 lappend badcolors $colormap($p)
3204 if {[llength $badcolors] >= $ncolors} {
3205 set badcolors $origbad
3208 for {set i 0} {$i <= $ncolors} {incr i} {
3209 set c [lindex $colors $nextcolor]
3210 if {[incr nextcolor] >= $ncolors} {
3211 set nextcolor 0
3213 if {[lsearch -exact $badcolors $c]} break
3215 set colormap($id) $c
3218 proc bindline {t id} {
3219 global canv
3221 $canv bind $t <Enter> "lineenter %x %y $id"
3222 $canv bind $t <Motion> "linemotion %x %y $id"
3223 $canv bind $t <Leave> "lineleave $id"
3224 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3227 proc drawtags {id x xt y1} {
3228 global idtags idheads idotherrefs mainhead
3229 global linespc lthickness
3230 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3232 set marks {}
3233 set ntags 0
3234 set nheads 0
3235 if {[info exists idtags($id)]} {
3236 set marks $idtags($id)
3237 set ntags [llength $marks]
3239 if {[info exists idheads($id)]} {
3240 set marks [concat $marks $idheads($id)]
3241 set nheads [llength $idheads($id)]
3243 if {[info exists idotherrefs($id)]} {
3244 set marks [concat $marks $idotherrefs($id)]
3246 if {$marks eq {}} {
3247 return $xt
3250 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3251 set yt [expr {$y1 - 0.5 * $linespc}]
3252 set yb [expr {$yt + $linespc - 1}]
3253 set xvals {}
3254 set wvals {}
3255 set i -1
3256 foreach tag $marks {
3257 incr i
3258 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3259 set wid [font measure [concat $mainfont bold] $tag]
3260 } else {
3261 set wid [font measure $mainfont $tag]
3263 lappend xvals $xt
3264 lappend wvals $wid
3265 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3267 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3268 -width $lthickness -fill black -tags tag.$id]
3269 $canv lower $t
3270 foreach tag $marks x $xvals wid $wvals {
3271 set xl [expr {$x + $delta}]
3272 set xr [expr {$x + $delta + $wid + $lthickness}]
3273 set font $mainfont
3274 if {[incr ntags -1] >= 0} {
3275 # draw a tag
3276 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3277 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3278 -width 1 -outline black -fill yellow -tags tag.$id]
3279 $canv bind $t <1> [list showtag $tag 1]
3280 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3281 } else {
3282 # draw a head or other ref
3283 if {[incr nheads -1] >= 0} {
3284 set col green
3285 if {$tag eq $mainhead} {
3286 lappend font bold
3288 } else {
3289 set col "#ddddff"
3291 set xl [expr {$xl - $delta/2}]
3292 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3293 -width 1 -outline black -fill $col -tags tag.$id
3294 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3295 set rwid [font measure $mainfont $remoteprefix]
3296 set xi [expr {$x + 1}]
3297 set yti [expr {$yt + 1}]
3298 set xri [expr {$x + $rwid}]
3299 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3300 -width 0 -fill "#ffddaa" -tags tag.$id
3303 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3304 -font $font -tags [list tag.$id text]]
3305 if {$ntags >= 0} {
3306 $canv bind $t <1> [list showtag $tag 1]
3307 } elseif {$nheads >= 0} {
3308 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3311 return $xt
3314 proc xcoord {i level ln} {
3315 global canvx0 xspc1 xspc2
3317 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3318 if {$i > 0 && $i == $level} {
3319 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3320 } elseif {$i > $level} {
3321 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3323 return $x
3326 proc show_status {msg} {
3327 global canv mainfont fgcolor
3329 clear_display
3330 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3331 -tags text -fill $fgcolor
3334 proc finishcommits {} {
3335 global commitidx phase curview
3336 global pending_select
3338 if {$commitidx($curview) > 0} {
3339 drawrest
3340 } else {
3341 show_status "No commits selected"
3343 set phase {}
3344 catch {unset pending_select}
3347 # Insert a new commit as the child of the commit on row $row.
3348 # The new commit will be displayed on row $row and the commits
3349 # on that row and below will move down one row.
3350 proc insertrow {row newcmit} {
3351 global displayorder parentlist childlist commitlisted
3352 global commitrow curview rowidlist rowoffsets numcommits
3353 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3354 global linesegends selectedline
3356 if {$row >= $numcommits} {
3357 puts "oops, inserting new row $row but only have $numcommits rows"
3358 return
3360 set p [lindex $displayorder $row]
3361 set displayorder [linsert $displayorder $row $newcmit]
3362 set parentlist [linsert $parentlist $row $p]
3363 set kids [lindex $childlist $row]
3364 lappend kids $newcmit
3365 lset childlist $row $kids
3366 set childlist [linsert $childlist $row {}]
3367 set commitlisted [linsert $commitlisted $row 1]
3368 set l [llength $displayorder]
3369 for {set r $row} {$r < $l} {incr r} {
3370 set id [lindex $displayorder $r]
3371 set commitrow($curview,$id) $r
3374 set idlist [lindex $rowidlist $row]
3375 set offs [lindex $rowoffsets $row]
3376 set newoffs {}
3377 foreach x $idlist {
3378 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3379 lappend newoffs {}
3380 } else {
3381 lappend newoffs 0
3384 if {[llength $kids] == 1} {
3385 set col [lsearch -exact $idlist $p]
3386 lset idlist $col $newcmit
3387 } else {
3388 set col [llength $idlist]
3389 lappend idlist $newcmit
3390 lappend offs {}
3391 lset rowoffsets $row $offs
3393 set rowidlist [linsert $rowidlist $row $idlist]
3394 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3396 set rowrangelist [linsert $rowrangelist $row {}]
3397 set l [llength $rowrangelist]
3398 for {set r 0} {$r < $l} {incr r} {
3399 set ranges [lindex $rowrangelist $r]
3400 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3401 set newranges {}
3402 foreach x $ranges {
3403 if {$x >= $row} {
3404 lappend newranges [expr {$x + 1}]
3405 } else {
3406 lappend newranges $x
3409 lset rowrangelist $r $newranges
3412 if {[llength $kids] > 1} {
3413 set rp1 [expr {$row + 1}]
3414 set ranges [lindex $rowrangelist $rp1]
3415 if {$ranges eq {}} {
3416 set ranges [list $row $rp1]
3417 } elseif {[lindex $ranges end-1] == $rp1} {
3418 lset ranges end-1 $row
3420 lset rowrangelist $rp1 $ranges
3422 foreach id [array names idrowranges] {
3423 set ranges $idrowranges($id)
3424 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3425 set newranges {}
3426 foreach x $ranges {
3427 if {$x >= $row} {
3428 lappend newranges [expr {$x + 1}]
3429 } else {
3430 lappend newranges $x
3433 set idrowranges($id) $newranges
3437 set linesegends [linsert $linesegends $row {}]
3439 incr rowlaidout
3440 incr rowoptim
3441 incr numcommits
3443 if {[info exists selectedline] && $selectedline >= $row} {
3444 incr selectedline
3446 redisplay
3449 # Don't change the text pane cursor if it is currently the hand cursor,
3450 # showing that we are over a sha1 ID link.
3451 proc settextcursor {c} {
3452 global ctext curtextcursor
3454 if {[$ctext cget -cursor] == $curtextcursor} {
3455 $ctext config -cursor $c
3457 set curtextcursor $c
3460 proc nowbusy {what} {
3461 global isbusy
3463 if {[array names isbusy] eq {}} {
3464 . config -cursor watch
3465 settextcursor watch
3467 set isbusy($what) 1
3470 proc notbusy {what} {
3471 global isbusy maincursor textcursor
3473 catch {unset isbusy($what)}
3474 if {[array names isbusy] eq {}} {
3475 . config -cursor $maincursor
3476 settextcursor $textcursor
3480 proc drawrest {} {
3481 global startmsecs
3482 global rowlaidout commitidx curview
3483 global pending_select
3485 set row $rowlaidout
3486 layoutrows $rowlaidout $commitidx($curview) 1
3487 layouttail
3488 optimize_rows $row 0 $commitidx($curview)
3489 showstuff $commitidx($curview)
3490 if {[info exists pending_select]} {
3491 selectline 0 1
3494 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3495 #global numcommits
3496 #puts "overall $drawmsecs ms for $numcommits commits"
3499 proc findmatches {f} {
3500 global findtype foundstring foundstrlen
3501 if {$findtype == "Regexp"} {
3502 set matches [regexp -indices -all -inline $foundstring $f]
3503 } else {
3504 if {$findtype == "IgnCase"} {
3505 set str [string tolower $f]
3506 } else {
3507 set str $f
3509 set matches {}
3510 set i 0
3511 while {[set j [string first $foundstring $str $i]] >= 0} {
3512 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3513 set i [expr {$j + $foundstrlen}]
3516 return $matches
3519 proc dofind {} {
3520 global findtype findloc findstring markedmatches commitinfo
3521 global numcommits displayorder linehtag linentag linedtag
3522 global mainfont canv canv2 canv3 selectedline
3523 global matchinglines foundstring foundstrlen matchstring
3524 global commitdata
3526 stopfindproc
3527 unmarkmatches
3528 cancel_next_highlight
3529 focus .
3530 set matchinglines {}
3531 if {$findtype == "IgnCase"} {
3532 set foundstring [string tolower $findstring]
3533 } else {
3534 set foundstring $findstring
3536 set foundstrlen [string length $findstring]
3537 if {$foundstrlen == 0} return
3538 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3539 set matchstring "*$matchstring*"
3540 if {![info exists selectedline]} {
3541 set oldsel -1
3542 } else {
3543 set oldsel $selectedline
3545 set didsel 0
3546 set fldtypes {Headline Author Date Committer CDate Comments}
3547 set l -1
3548 foreach id $displayorder {
3549 set d $commitdata($id)
3550 incr l
3551 if {$findtype == "Regexp"} {
3552 set doesmatch [regexp $foundstring $d]
3553 } elseif {$findtype == "IgnCase"} {
3554 set doesmatch [string match -nocase $matchstring $d]
3555 } else {
3556 set doesmatch [string match $matchstring $d]
3558 if {!$doesmatch} continue
3559 if {![info exists commitinfo($id)]} {
3560 getcommit $id
3562 set info $commitinfo($id)
3563 set doesmatch 0
3564 foreach f $info ty $fldtypes {
3565 if {$findloc != "All fields" && $findloc != $ty} {
3566 continue
3568 set matches [findmatches $f]
3569 if {$matches == {}} continue
3570 set doesmatch 1
3571 if {$ty == "Headline"} {
3572 drawcmitrow $l
3573 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3574 } elseif {$ty == "Author"} {
3575 drawcmitrow $l
3576 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3577 } elseif {$ty == "Date"} {
3578 drawcmitrow $l
3579 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3582 if {$doesmatch} {
3583 lappend matchinglines $l
3584 if {!$didsel && $l > $oldsel} {
3585 findselectline $l
3586 set didsel 1
3590 if {$matchinglines == {}} {
3591 bell
3592 } elseif {!$didsel} {
3593 findselectline [lindex $matchinglines 0]
3597 proc findselectline {l} {
3598 global findloc commentend ctext
3599 selectline $l 1
3600 if {$findloc == "All fields" || $findloc == "Comments"} {
3601 # highlight the matches in the comments
3602 set f [$ctext get 1.0 $commentend]
3603 set matches [findmatches $f]
3604 foreach match $matches {
3605 set start [lindex $match 0]
3606 set end [expr {[lindex $match 1] + 1}]
3607 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3612 proc findnext {restart} {
3613 global matchinglines selectedline
3614 if {![info exists matchinglines]} {
3615 if {$restart} {
3616 dofind
3618 return
3620 if {![info exists selectedline]} return
3621 foreach l $matchinglines {
3622 if {$l > $selectedline} {
3623 findselectline $l
3624 return
3627 bell
3630 proc findprev {} {
3631 global matchinglines selectedline
3632 if {![info exists matchinglines]} {
3633 dofind
3634 return
3636 if {![info exists selectedline]} return
3637 set prev {}
3638 foreach l $matchinglines {
3639 if {$l >= $selectedline} break
3640 set prev $l
3642 if {$prev != {}} {
3643 findselectline $prev
3644 } else {
3645 bell
3649 proc stopfindproc {{done 0}} {
3650 global findprocpid findprocfile findids
3651 global ctext findoldcursor phase maincursor textcursor
3652 global findinprogress
3654 catch {unset findids}
3655 if {[info exists findprocpid]} {
3656 if {!$done} {
3657 catch {exec kill $findprocpid}
3659 catch {close $findprocfile}
3660 unset findprocpid
3662 catch {unset findinprogress}
3663 notbusy find
3666 # mark a commit as matching by putting a yellow background
3667 # behind the headline
3668 proc markheadline {l id} {
3669 global canv mainfont linehtag
3671 drawcmitrow $l
3672 set bbox [$canv bbox $linehtag($l)]
3673 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3674 $canv lower $t
3677 # mark the bits of a headline, author or date that match a find string
3678 proc markmatches {canv l str tag matches font} {
3679 set bbox [$canv bbox $tag]
3680 set x0 [lindex $bbox 0]
3681 set y0 [lindex $bbox 1]
3682 set y1 [lindex $bbox 3]
3683 foreach match $matches {
3684 set start [lindex $match 0]
3685 set end [lindex $match 1]
3686 if {$start > $end} continue
3687 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3688 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3689 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3690 [expr {$x0+$xlen+2}] $y1 \
3691 -outline {} -tags matches -fill yellow]
3692 $canv lower $t
3696 proc unmarkmatches {} {
3697 global matchinglines findids
3698 allcanvs delete matches
3699 catch {unset matchinglines}
3700 catch {unset findids}
3703 proc selcanvline {w x y} {
3704 global canv canvy0 ctext linespc
3705 global rowtextx
3706 set ymax [lindex [$canv cget -scrollregion] 3]
3707 if {$ymax == {}} return
3708 set yfrac [lindex [$canv yview] 0]
3709 set y [expr {$y + $yfrac * $ymax}]
3710 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3711 if {$l < 0} {
3712 set l 0
3714 if {$w eq $canv} {
3715 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3717 unmarkmatches
3718 selectline $l 1
3721 proc commit_descriptor {p} {
3722 global commitinfo
3723 if {![info exists commitinfo($p)]} {
3724 getcommit $p
3726 set l "..."
3727 if {[llength $commitinfo($p)] > 1} {
3728 set l [lindex $commitinfo($p) 0]
3730 return "$p ($l)\n"
3733 # append some text to the ctext widget, and make any SHA1 ID
3734 # that we know about be a clickable link.
3735 proc appendwithlinks {text tags} {
3736 global ctext commitrow linknum curview
3738 set start [$ctext index "end - 1c"]
3739 $ctext insert end $text $tags
3740 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3741 foreach l $links {
3742 set s [lindex $l 0]
3743 set e [lindex $l 1]
3744 set linkid [string range $text $s $e]
3745 if {![info exists commitrow($curview,$linkid)]} continue
3746 incr e
3747 $ctext tag add link "$start + $s c" "$start + $e c"
3748 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3749 $ctext tag bind link$linknum <1> \
3750 [list selectline $commitrow($curview,$linkid) 1]
3751 incr linknum
3753 $ctext tag conf link -foreground blue -underline 1
3754 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3755 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3758 proc viewnextline {dir} {
3759 global canv linespc
3761 $canv delete hover
3762 set ymax [lindex [$canv cget -scrollregion] 3]
3763 set wnow [$canv yview]
3764 set wtop [expr {[lindex $wnow 0] * $ymax}]
3765 set newtop [expr {$wtop + $dir * $linespc}]
3766 if {$newtop < 0} {
3767 set newtop 0
3768 } elseif {$newtop > $ymax} {
3769 set newtop $ymax
3771 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3774 # add a list of tag or branch names at position pos
3775 # returns the number of names inserted
3776 proc appendrefs {pos tags var} {
3777 global ctext commitrow linknum curview $var
3779 if {[catch {$ctext index $pos}]} {
3780 return 0
3782 set tags [lsort $tags]
3783 set sep {}
3784 foreach tag $tags {
3785 set id [set $var\($tag\)]
3786 set lk link$linknum
3787 incr linknum
3788 $ctext insert $pos $sep
3789 $ctext insert $pos $tag $lk
3790 $ctext tag conf $lk -foreground blue
3791 if {[info exists commitrow($curview,$id)]} {
3792 $ctext tag bind $lk <1> \
3793 [list selectline $commitrow($curview,$id) 1]
3794 $ctext tag conf $lk -underline 1
3795 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3796 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3798 set sep ", "
3800 return [llength $tags]
3803 proc taglist {ids} {
3804 global idtags
3806 set tags {}
3807 foreach id $ids {
3808 foreach tag $idtags($id) {
3809 lappend tags $tag
3812 return $tags
3815 # called when we have finished computing the nearby tags
3816 proc dispneartags {} {
3817 global selectedline currentid ctext anc_tags desc_tags showneartags
3818 global desc_heads
3820 if {![info exists selectedline] || !$showneartags} return
3821 set id $currentid
3822 $ctext conf -state normal
3823 if {[info exists desc_heads($id)]} {
3824 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3825 $ctext insert "branch -2c" "es"
3828 if {[info exists anc_tags($id)]} {
3829 appendrefs follows [taglist $anc_tags($id)] tagids
3831 if {[info exists desc_tags($id)]} {
3832 appendrefs precedes [taglist $desc_tags($id)] tagids
3834 $ctext conf -state disabled
3837 proc selectline {l isnew} {
3838 global canv canv2 canv3 ctext commitinfo selectedline
3839 global displayorder linehtag linentag linedtag
3840 global canvy0 linespc parentlist childlist
3841 global currentid sha1entry
3842 global commentend idtags linknum
3843 global mergemax numcommits pending_select
3844 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3846 catch {unset pending_select}
3847 $canv delete hover
3848 normalline
3849 cancel_next_highlight
3850 if {$l < 0 || $l >= $numcommits} return
3851 set y [expr {$canvy0 + $l * $linespc}]
3852 set ymax [lindex [$canv cget -scrollregion] 3]
3853 set ytop [expr {$y - $linespc - 1}]
3854 set ybot [expr {$y + $linespc + 1}]
3855 set wnow [$canv yview]
3856 set wtop [expr {[lindex $wnow 0] * $ymax}]
3857 set wbot [expr {[lindex $wnow 1] * $ymax}]
3858 set wh [expr {$wbot - $wtop}]
3859 set newtop $wtop
3860 if {$ytop < $wtop} {
3861 if {$ybot < $wtop} {
3862 set newtop [expr {$y - $wh / 2.0}]
3863 } else {
3864 set newtop $ytop
3865 if {$newtop > $wtop - $linespc} {
3866 set newtop [expr {$wtop - $linespc}]
3869 } elseif {$ybot > $wbot} {
3870 if {$ytop > $wbot} {
3871 set newtop [expr {$y - $wh / 2.0}]
3872 } else {
3873 set newtop [expr {$ybot - $wh}]
3874 if {$newtop < $wtop + $linespc} {
3875 set newtop [expr {$wtop + $linespc}]
3879 if {$newtop != $wtop} {
3880 if {$newtop < 0} {
3881 set newtop 0
3883 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3884 drawvisible
3887 if {![info exists linehtag($l)]} return
3888 $canv delete secsel
3889 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3890 -tags secsel -fill [$canv cget -highlightbackground]]
3891 $canv lower $t
3892 $canv2 delete secsel
3893 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3894 -tags secsel -fill [$canv2 cget -highlightbackground]]
3895 $canv2 lower $t
3896 $canv3 delete secsel
3897 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3898 -tags secsel -fill [$canv3 cget -highlightbackground]]
3899 $canv3 lower $t
3901 if {$isnew} {
3902 addtohistory [list selectline $l 0]
3905 set selectedline $l
3907 set id [lindex $displayorder $l]
3908 set currentid $id
3909 $sha1entry delete 0 end
3910 $sha1entry insert 0 $id
3911 $sha1entry selection from 0
3912 $sha1entry selection to end
3913 rhighlight_sel $id
3915 $ctext conf -state normal
3916 clear_ctext
3917 set linknum 0
3918 set info $commitinfo($id)
3919 set date [formatdate [lindex $info 2]]
3920 $ctext insert end "Author: [lindex $info 1] $date\n"
3921 set date [formatdate [lindex $info 4]]
3922 $ctext insert end "Committer: [lindex $info 3] $date\n"
3923 if {[info exists idtags($id)]} {
3924 $ctext insert end "Tags:"
3925 foreach tag $idtags($id) {
3926 $ctext insert end " $tag"
3928 $ctext insert end "\n"
3931 set headers {}
3932 set olds [lindex $parentlist $l]
3933 if {[llength $olds] > 1} {
3934 set np 0
3935 foreach p $olds {
3936 if {$np >= $mergemax} {
3937 set tag mmax
3938 } else {
3939 set tag m$np
3941 $ctext insert end "Parent: " $tag
3942 appendwithlinks [commit_descriptor $p] {}
3943 incr np
3945 } else {
3946 foreach p $olds {
3947 append headers "Parent: [commit_descriptor $p]"
3951 foreach c [lindex $childlist $l] {
3952 append headers "Child: [commit_descriptor $c]"
3955 # make anything that looks like a SHA1 ID be a clickable link
3956 appendwithlinks $headers {}
3957 if {$showneartags} {
3958 if {![info exists allcommits]} {
3959 getallcommits
3961 $ctext insert end "Branch: "
3962 $ctext mark set branch "end -1c"
3963 $ctext mark gravity branch left
3964 if {[info exists desc_heads($id)]} {
3965 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3966 # turn "Branch" into "Branches"
3967 $ctext insert "branch -2c" "es"
3970 $ctext insert end "\nFollows: "
3971 $ctext mark set follows "end -1c"
3972 $ctext mark gravity follows left
3973 if {[info exists anc_tags($id)]} {
3974 appendrefs follows [taglist $anc_tags($id)] tagids
3976 $ctext insert end "\nPrecedes: "
3977 $ctext mark set precedes "end -1c"
3978 $ctext mark gravity precedes left
3979 if {[info exists desc_tags($id)]} {
3980 appendrefs precedes [taglist $desc_tags($id)] tagids
3982 $ctext insert end "\n"
3984 $ctext insert end "\n"
3985 appendwithlinks [lindex $info 5] {comment}
3987 $ctext tag delete Comments
3988 $ctext tag remove found 1.0 end
3989 $ctext conf -state disabled
3990 set commentend [$ctext index "end - 1c"]
3992 init_flist "Comments"
3993 if {$cmitmode eq "tree"} {
3994 gettree $id
3995 } elseif {[llength $olds] <= 1} {
3996 startdiff $id
3997 } else {
3998 mergediff $id $l
4002 proc selfirstline {} {
4003 unmarkmatches
4004 selectline 0 1
4007 proc sellastline {} {
4008 global numcommits
4009 unmarkmatches
4010 set l [expr {$numcommits - 1}]
4011 selectline $l 1
4014 proc selnextline {dir} {
4015 global selectedline
4016 if {![info exists selectedline]} return
4017 set l [expr {$selectedline + $dir}]
4018 unmarkmatches
4019 selectline $l 1
4022 proc selnextpage {dir} {
4023 global canv linespc selectedline numcommits
4025 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4026 if {$lpp < 1} {
4027 set lpp 1
4029 allcanvs yview scroll [expr {$dir * $lpp}] units
4030 drawvisible
4031 if {![info exists selectedline]} return
4032 set l [expr {$selectedline + $dir * $lpp}]
4033 if {$l < 0} {
4034 set l 0
4035 } elseif {$l >= $numcommits} {
4036 set l [expr $numcommits - 1]
4038 unmarkmatches
4039 selectline $l 1
4042 proc unselectline {} {
4043 global selectedline currentid
4045 catch {unset selectedline}
4046 catch {unset currentid}
4047 allcanvs delete secsel
4048 rhighlight_none
4049 cancel_next_highlight
4052 proc reselectline {} {
4053 global selectedline
4055 if {[info exists selectedline]} {
4056 selectline $selectedline 0
4060 proc addtohistory {cmd} {
4061 global history historyindex curview
4063 set elt [list $curview $cmd]
4064 if {$historyindex > 0
4065 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4066 return
4069 if {$historyindex < [llength $history]} {
4070 set history [lreplace $history $historyindex end $elt]
4071 } else {
4072 lappend history $elt
4074 incr historyindex
4075 if {$historyindex > 1} {
4076 .tf.bar.leftbut conf -state normal
4077 } else {
4078 .tf.bar.leftbut conf -state disabled
4080 .tf.bar.rightbut conf -state disabled
4083 proc godo {elt} {
4084 global curview
4086 set view [lindex $elt 0]
4087 set cmd [lindex $elt 1]
4088 if {$curview != $view} {
4089 showview $view
4091 eval $cmd
4094 proc goback {} {
4095 global history historyindex
4097 if {$historyindex > 1} {
4098 incr historyindex -1
4099 godo [lindex $history [expr {$historyindex - 1}]]
4100 .tf.bar.rightbut conf -state normal
4102 if {$historyindex <= 1} {
4103 .tf.bar.leftbut conf -state disabled
4107 proc goforw {} {
4108 global history historyindex
4110 if {$historyindex < [llength $history]} {
4111 set cmd [lindex $history $historyindex]
4112 incr historyindex
4113 godo $cmd
4114 .tf.bar.leftbut conf -state normal
4116 if {$historyindex >= [llength $history]} {
4117 .tf.bar.rightbut conf -state disabled
4121 proc gettree {id} {
4122 global treefilelist treeidlist diffids diffmergeid treepending
4124 set diffids $id
4125 catch {unset diffmergeid}
4126 if {![info exists treefilelist($id)]} {
4127 if {![info exists treepending]} {
4128 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4129 return
4131 set treepending $id
4132 set treefilelist($id) {}
4133 set treeidlist($id) {}
4134 fconfigure $gtf -blocking 0
4135 fileevent $gtf readable [list gettreeline $gtf $id]
4137 } else {
4138 setfilelist $id
4142 proc gettreeline {gtf id} {
4143 global treefilelist treeidlist treepending cmitmode diffids
4145 while {[gets $gtf line] >= 0} {
4146 if {[lindex $line 1] ne "blob"} continue
4147 set sha1 [lindex $line 2]
4148 set fname [lindex $line 3]
4149 lappend treefilelist($id) $fname
4150 lappend treeidlist($id) $sha1
4152 if {![eof $gtf]} return
4153 close $gtf
4154 unset treepending
4155 if {$cmitmode ne "tree"} {
4156 if {![info exists diffmergeid]} {
4157 gettreediffs $diffids
4159 } elseif {$id ne $diffids} {
4160 gettree $diffids
4161 } else {
4162 setfilelist $id
4166 proc showfile {f} {
4167 global treefilelist treeidlist diffids
4168 global ctext commentend
4170 set i [lsearch -exact $treefilelist($diffids) $f]
4171 if {$i < 0} {
4172 puts "oops, $f not in list for id $diffids"
4173 return
4175 set blob [lindex $treeidlist($diffids) $i]
4176 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4177 puts "oops, error reading blob $blob: $err"
4178 return
4180 fconfigure $bf -blocking 0
4181 fileevent $bf readable [list getblobline $bf $diffids]
4182 $ctext config -state normal
4183 clear_ctext $commentend
4184 $ctext insert end "\n"
4185 $ctext insert end "$f\n" filesep
4186 $ctext config -state disabled
4187 $ctext yview $commentend
4190 proc getblobline {bf id} {
4191 global diffids cmitmode ctext
4193 if {$id ne $diffids || $cmitmode ne "tree"} {
4194 catch {close $bf}
4195 return
4197 $ctext config -state normal
4198 while {[gets $bf line] >= 0} {
4199 $ctext insert end "$line\n"
4201 if {[eof $bf]} {
4202 # delete last newline
4203 $ctext delete "end - 2c" "end - 1c"
4204 close $bf
4206 $ctext config -state disabled
4209 proc mergediff {id l} {
4210 global diffmergeid diffopts mdifffd
4211 global diffids
4212 global parentlist
4214 set diffmergeid $id
4215 set diffids $id
4216 # this doesn't seem to actually affect anything...
4217 set env(GIT_DIFF_OPTS) $diffopts
4218 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4219 if {[catch {set mdf [open $cmd r]} err]} {
4220 error_popup "Error getting merge diffs: $err"
4221 return
4223 fconfigure $mdf -blocking 0
4224 set mdifffd($id) $mdf
4225 set np [llength [lindex $parentlist $l]]
4226 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4227 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4230 proc getmergediffline {mdf id np} {
4231 global diffmergeid ctext cflist nextupdate mergemax
4232 global difffilestart mdifffd
4234 set n [gets $mdf line]
4235 if {$n < 0} {
4236 if {[eof $mdf]} {
4237 close $mdf
4239 return
4241 if {![info exists diffmergeid] || $id != $diffmergeid
4242 || $mdf != $mdifffd($id)} {
4243 return
4245 $ctext conf -state normal
4246 if {[regexp {^diff --cc (.*)} $line match fname]} {
4247 # start of a new file
4248 $ctext insert end "\n"
4249 set here [$ctext index "end - 1c"]
4250 lappend difffilestart $here
4251 add_flist [list $fname]
4252 set l [expr {(78 - [string length $fname]) / 2}]
4253 set pad [string range "----------------------------------------" 1 $l]
4254 $ctext insert end "$pad $fname $pad\n" filesep
4255 } elseif {[regexp {^@@} $line]} {
4256 $ctext insert end "$line\n" hunksep
4257 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4258 # do nothing
4259 } else {
4260 # parse the prefix - one ' ', '-' or '+' for each parent
4261 set spaces {}
4262 set minuses {}
4263 set pluses {}
4264 set isbad 0
4265 for {set j 0} {$j < $np} {incr j} {
4266 set c [string range $line $j $j]
4267 if {$c == " "} {
4268 lappend spaces $j
4269 } elseif {$c == "-"} {
4270 lappend minuses $j
4271 } elseif {$c == "+"} {
4272 lappend pluses $j
4273 } else {
4274 set isbad 1
4275 break
4278 set tags {}
4279 set num {}
4280 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4281 # line doesn't appear in result, parents in $minuses have the line
4282 set num [lindex $minuses 0]
4283 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4284 # line appears in result, parents in $pluses don't have the line
4285 lappend tags mresult
4286 set num [lindex $spaces 0]
4288 if {$num ne {}} {
4289 if {$num >= $mergemax} {
4290 set num "max"
4292 lappend tags m$num
4294 $ctext insert end "$line\n" $tags
4296 $ctext conf -state disabled
4297 if {[clock clicks -milliseconds] >= $nextupdate} {
4298 incr nextupdate 100
4299 fileevent $mdf readable {}
4300 update
4301 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4305 proc startdiff {ids} {
4306 global treediffs diffids treepending diffmergeid
4308 set diffids $ids
4309 catch {unset diffmergeid}
4310 if {![info exists treediffs($ids)]} {
4311 if {![info exists treepending]} {
4312 gettreediffs $ids
4314 } else {
4315 addtocflist $ids
4319 proc addtocflist {ids} {
4320 global treediffs cflist
4321 add_flist $treediffs($ids)
4322 getblobdiffs $ids
4325 proc gettreediffs {ids} {
4326 global treediff treepending
4327 set treepending $ids
4328 set treediff {}
4329 if {[catch \
4330 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4331 ]} return
4332 fconfigure $gdtf -blocking 0
4333 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4336 proc gettreediffline {gdtf ids} {
4337 global treediff treediffs treepending diffids diffmergeid
4338 global cmitmode
4340 set n [gets $gdtf line]
4341 if {$n < 0} {
4342 if {![eof $gdtf]} return
4343 close $gdtf
4344 set treediffs($ids) $treediff
4345 unset treepending
4346 if {$cmitmode eq "tree"} {
4347 gettree $diffids
4348 } elseif {$ids != $diffids} {
4349 if {![info exists diffmergeid]} {
4350 gettreediffs $diffids
4352 } else {
4353 addtocflist $ids
4355 return
4357 set file [lindex $line 5]
4358 lappend treediff $file
4361 proc getblobdiffs {ids} {
4362 global diffopts blobdifffd diffids env curdifftag curtagstart
4363 global nextupdate diffinhdr treediffs
4365 set env(GIT_DIFF_OPTS) $diffopts
4366 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4367 if {[catch {set bdf [open $cmd r]} err]} {
4368 puts "error getting diffs: $err"
4369 return
4371 set diffinhdr 0
4372 fconfigure $bdf -blocking 0
4373 set blobdifffd($ids) $bdf
4374 set curdifftag Comments
4375 set curtagstart 0.0
4376 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4377 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4380 proc setinlist {var i val} {
4381 global $var
4383 while {[llength [set $var]] < $i} {
4384 lappend $var {}
4386 if {[llength [set $var]] == $i} {
4387 lappend $var $val
4388 } else {
4389 lset $var $i $val
4393 proc getblobdiffline {bdf ids} {
4394 global diffids blobdifffd ctext curdifftag curtagstart
4395 global diffnexthead diffnextnote difffilestart
4396 global nextupdate diffinhdr treediffs
4398 set n [gets $bdf line]
4399 if {$n < 0} {
4400 if {[eof $bdf]} {
4401 close $bdf
4402 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4403 $ctext tag add $curdifftag $curtagstart end
4406 return
4408 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4409 return
4411 $ctext conf -state normal
4412 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4413 # start of a new file
4414 $ctext insert end "\n"
4415 $ctext tag add $curdifftag $curtagstart end
4416 set here [$ctext index "end - 1c"]
4417 set curtagstart $here
4418 set header $newname
4419 set i [lsearch -exact $treediffs($ids) $fname]
4420 if {$i >= 0} {
4421 setinlist difffilestart $i $here
4423 if {$newname ne $fname} {
4424 set i [lsearch -exact $treediffs($ids) $newname]
4425 if {$i >= 0} {
4426 setinlist difffilestart $i $here
4429 set curdifftag "f:$fname"
4430 $ctext tag delete $curdifftag
4431 set l [expr {(78 - [string length $header]) / 2}]
4432 set pad [string range "----------------------------------------" 1 $l]
4433 $ctext insert end "$pad $header $pad\n" filesep
4434 set diffinhdr 1
4435 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4436 # do nothing
4437 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4438 set diffinhdr 0
4439 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4440 $line match f1l f1c f2l f2c rest]} {
4441 $ctext insert end "$line\n" hunksep
4442 set diffinhdr 0
4443 } else {
4444 set x [string range $line 0 0]
4445 if {$x == "-" || $x == "+"} {
4446 set tag [expr {$x == "+"}]
4447 $ctext insert end "$line\n" d$tag
4448 } elseif {$x == " "} {
4449 $ctext insert end "$line\n"
4450 } elseif {$diffinhdr || $x == "\\"} {
4451 # e.g. "\ No newline at end of file"
4452 $ctext insert end "$line\n" filesep
4453 } else {
4454 # Something else we don't recognize
4455 if {$curdifftag != "Comments"} {
4456 $ctext insert end "\n"
4457 $ctext tag add $curdifftag $curtagstart end
4458 set curtagstart [$ctext index "end - 1c"]
4459 set curdifftag Comments
4461 $ctext insert end "$line\n" filesep
4464 $ctext conf -state disabled
4465 if {[clock clicks -milliseconds] >= $nextupdate} {
4466 incr nextupdate 100
4467 fileevent $bdf readable {}
4468 update
4469 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4473 proc prevfile {} {
4474 global difffilestart ctext
4475 set prev [lindex $difffilestart 0]
4476 set here [$ctext index @0,0]
4477 foreach loc $difffilestart {
4478 if {[$ctext compare $loc >= $here]} {
4479 $ctext yview $prev
4480 return
4482 set prev $loc
4484 $ctext yview $prev
4487 proc nextfile {} {
4488 global difffilestart ctext
4489 set here [$ctext index @0,0]
4490 foreach loc $difffilestart {
4491 if {[$ctext compare $loc > $here]} {
4492 $ctext yview $loc
4493 return
4498 proc clear_ctext {{first 1.0}} {
4499 global ctext smarktop smarkbot
4501 set l [lindex [split $first .] 0]
4502 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4503 set smarktop $l
4505 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4506 set smarkbot $l
4508 $ctext delete $first end
4511 proc incrsearch {name ix op} {
4512 global ctext searchstring searchdirn
4514 $ctext tag remove found 1.0 end
4515 if {[catch {$ctext index anchor}]} {
4516 # no anchor set, use start of selection, or of visible area
4517 set sel [$ctext tag ranges sel]
4518 if {$sel ne {}} {
4519 $ctext mark set anchor [lindex $sel 0]
4520 } elseif {$searchdirn eq "-forwards"} {
4521 $ctext mark set anchor @0,0
4522 } else {
4523 $ctext mark set anchor @0,[winfo height $ctext]
4526 if {$searchstring ne {}} {
4527 set here [$ctext search $searchdirn -- $searchstring anchor]
4528 if {$here ne {}} {
4529 $ctext see $here
4531 searchmarkvisible 1
4535 proc dosearch {} {
4536 global sstring ctext searchstring searchdirn
4538 focus $sstring
4539 $sstring icursor end
4540 set searchdirn -forwards
4541 if {$searchstring ne {}} {
4542 set sel [$ctext tag ranges sel]
4543 if {$sel ne {}} {
4544 set start "[lindex $sel 0] + 1c"
4545 } elseif {[catch {set start [$ctext index anchor]}]} {
4546 set start "@0,0"
4548 set match [$ctext search -count mlen -- $searchstring $start]
4549 $ctext tag remove sel 1.0 end
4550 if {$match eq {}} {
4551 bell
4552 return
4554 $ctext see $match
4555 set mend "$match + $mlen c"
4556 $ctext tag add sel $match $mend
4557 $ctext mark unset anchor
4561 proc dosearchback {} {
4562 global sstring ctext searchstring searchdirn
4564 focus $sstring
4565 $sstring icursor end
4566 set searchdirn -backwards
4567 if {$searchstring ne {}} {
4568 set sel [$ctext tag ranges sel]
4569 if {$sel ne {}} {
4570 set start [lindex $sel 0]
4571 } elseif {[catch {set start [$ctext index anchor]}]} {
4572 set start @0,[winfo height $ctext]
4574 set match [$ctext search -backwards -count ml -- $searchstring $start]
4575 $ctext tag remove sel 1.0 end
4576 if {$match eq {}} {
4577 bell
4578 return
4580 $ctext see $match
4581 set mend "$match + $ml c"
4582 $ctext tag add sel $match $mend
4583 $ctext mark unset anchor
4587 proc searchmark {first last} {
4588 global ctext searchstring
4590 set mend $first.0
4591 while {1} {
4592 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4593 if {$match eq {}} break
4594 set mend "$match + $mlen c"
4595 $ctext tag add found $match $mend
4599 proc searchmarkvisible {doall} {
4600 global ctext smarktop smarkbot
4602 set topline [lindex [split [$ctext index @0,0] .] 0]
4603 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4604 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4605 # no overlap with previous
4606 searchmark $topline $botline
4607 set smarktop $topline
4608 set smarkbot $botline
4609 } else {
4610 if {$topline < $smarktop} {
4611 searchmark $topline [expr {$smarktop-1}]
4612 set smarktop $topline
4614 if {$botline > $smarkbot} {
4615 searchmark [expr {$smarkbot+1}] $botline
4616 set smarkbot $botline
4621 proc scrolltext {f0 f1} {
4622 global searchstring
4624 .bleft.sb set $f0 $f1
4625 if {$searchstring ne {}} {
4626 searchmarkvisible 0
4630 proc setcoords {} {
4631 global linespc charspc canvx0 canvy0 mainfont
4632 global xspc1 xspc2 lthickness
4634 set linespc [font metrics $mainfont -linespace]
4635 set charspc [font measure $mainfont "m"]
4636 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4637 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4638 set lthickness [expr {int($linespc / 9) + 1}]
4639 set xspc1(0) $linespc
4640 set xspc2 $linespc
4643 proc redisplay {} {
4644 global canv
4645 global selectedline
4647 set ymax [lindex [$canv cget -scrollregion] 3]
4648 if {$ymax eq {} || $ymax == 0} return
4649 set span [$canv yview]
4650 clear_display
4651 setcanvscroll
4652 allcanvs yview moveto [lindex $span 0]
4653 drawvisible
4654 if {[info exists selectedline]} {
4655 selectline $selectedline 0
4656 allcanvs yview moveto [lindex $span 0]
4660 proc incrfont {inc} {
4661 global mainfont textfont ctext canv phase
4662 global stopped entries
4663 unmarkmatches
4664 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4665 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4666 setcoords
4667 $ctext conf -font $textfont
4668 $ctext tag conf filesep -font [concat $textfont bold]
4669 foreach e $entries {
4670 $e conf -font $mainfont
4672 if {$phase eq "getcommits"} {
4673 $canv itemconf textitems -font $mainfont
4675 redisplay
4678 proc clearsha1 {} {
4679 global sha1entry sha1string
4680 if {[string length $sha1string] == 40} {
4681 $sha1entry delete 0 end
4685 proc sha1change {n1 n2 op} {
4686 global sha1string currentid sha1but
4687 if {$sha1string == {}
4688 || ([info exists currentid] && $sha1string == $currentid)} {
4689 set state disabled
4690 } else {
4691 set state normal
4693 if {[$sha1but cget -state] == $state} return
4694 if {$state == "normal"} {
4695 $sha1but conf -state normal -relief raised -text "Goto: "
4696 } else {
4697 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4701 proc gotocommit {} {
4702 global sha1string currentid commitrow tagids headids
4703 global displayorder numcommits curview
4705 if {$sha1string == {}
4706 || ([info exists currentid] && $sha1string == $currentid)} return
4707 if {[info exists tagids($sha1string)]} {
4708 set id $tagids($sha1string)
4709 } elseif {[info exists headids($sha1string)]} {
4710 set id $headids($sha1string)
4711 } else {
4712 set id [string tolower $sha1string]
4713 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4714 set matches {}
4715 foreach i $displayorder {
4716 if {[string match $id* $i]} {
4717 lappend matches $i
4720 if {$matches ne {}} {
4721 if {[llength $matches] > 1} {
4722 error_popup "Short SHA1 id $id is ambiguous"
4723 return
4725 set id [lindex $matches 0]
4729 if {[info exists commitrow($curview,$id)]} {
4730 selectline $commitrow($curview,$id) 1
4731 return
4733 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4734 set type "SHA1 id"
4735 } else {
4736 set type "Tag/Head"
4738 error_popup "$type $sha1string is not known"
4741 proc lineenter {x y id} {
4742 global hoverx hovery hoverid hovertimer
4743 global commitinfo canv
4745 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4746 set hoverx $x
4747 set hovery $y
4748 set hoverid $id
4749 if {[info exists hovertimer]} {
4750 after cancel $hovertimer
4752 set hovertimer [after 500 linehover]
4753 $canv delete hover
4756 proc linemotion {x y id} {
4757 global hoverx hovery hoverid hovertimer
4759 if {[info exists hoverid] && $id == $hoverid} {
4760 set hoverx $x
4761 set hovery $y
4762 if {[info exists hovertimer]} {
4763 after cancel $hovertimer
4765 set hovertimer [after 500 linehover]
4769 proc lineleave {id} {
4770 global hoverid hovertimer canv
4772 if {[info exists hoverid] && $id == $hoverid} {
4773 $canv delete hover
4774 if {[info exists hovertimer]} {
4775 after cancel $hovertimer
4776 unset hovertimer
4778 unset hoverid
4782 proc linehover {} {
4783 global hoverx hovery hoverid hovertimer
4784 global canv linespc lthickness
4785 global commitinfo mainfont
4787 set text [lindex $commitinfo($hoverid) 0]
4788 set ymax [lindex [$canv cget -scrollregion] 3]
4789 if {$ymax == {}} return
4790 set yfrac [lindex [$canv yview] 0]
4791 set x [expr {$hoverx + 2 * $linespc}]
4792 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4793 set x0 [expr {$x - 2 * $lthickness}]
4794 set y0 [expr {$y - 2 * $lthickness}]
4795 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4796 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4797 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4798 -fill \#ffff80 -outline black -width 1 -tags hover]
4799 $canv raise $t
4800 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4801 -font $mainfont]
4802 $canv raise $t
4805 proc clickisonarrow {id y} {
4806 global lthickness
4808 set ranges [rowranges $id]
4809 set thresh [expr {2 * $lthickness + 6}]
4810 set n [expr {[llength $ranges] - 1}]
4811 for {set i 1} {$i < $n} {incr i} {
4812 set row [lindex $ranges $i]
4813 if {abs([yc $row] - $y) < $thresh} {
4814 return $i
4817 return {}
4820 proc arrowjump {id n y} {
4821 global canv
4823 # 1 <-> 2, 3 <-> 4, etc...
4824 set n [expr {(($n - 1) ^ 1) + 1}]
4825 set row [lindex [rowranges $id] $n]
4826 set yt [yc $row]
4827 set ymax [lindex [$canv cget -scrollregion] 3]
4828 if {$ymax eq {} || $ymax <= 0} return
4829 set view [$canv yview]
4830 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4831 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4832 if {$yfrac < 0} {
4833 set yfrac 0
4835 allcanvs yview moveto $yfrac
4838 proc lineclick {x y id isnew} {
4839 global ctext commitinfo children canv thickerline curview
4841 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4842 unmarkmatches
4843 unselectline
4844 normalline
4845 $canv delete hover
4846 # draw this line thicker than normal
4847 set thickerline $id
4848 drawlines $id
4849 if {$isnew} {
4850 set ymax [lindex [$canv cget -scrollregion] 3]
4851 if {$ymax eq {}} return
4852 set yfrac [lindex [$canv yview] 0]
4853 set y [expr {$y + $yfrac * $ymax}]
4855 set dirn [clickisonarrow $id $y]
4856 if {$dirn ne {}} {
4857 arrowjump $id $dirn $y
4858 return
4861 if {$isnew} {
4862 addtohistory [list lineclick $x $y $id 0]
4864 # fill the details pane with info about this line
4865 $ctext conf -state normal
4866 clear_ctext
4867 $ctext tag conf link -foreground blue -underline 1
4868 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4869 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4870 $ctext insert end "Parent:\t"
4871 $ctext insert end $id [list link link0]
4872 $ctext tag bind link0 <1> [list selbyid $id]
4873 set info $commitinfo($id)
4874 $ctext insert end "\n\t[lindex $info 0]\n"
4875 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4876 set date [formatdate [lindex $info 2]]
4877 $ctext insert end "\tDate:\t$date\n"
4878 set kids $children($curview,$id)
4879 if {$kids ne {}} {
4880 $ctext insert end "\nChildren:"
4881 set i 0
4882 foreach child $kids {
4883 incr i
4884 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4885 set info $commitinfo($child)
4886 $ctext insert end "\n\t"
4887 $ctext insert end $child [list link link$i]
4888 $ctext tag bind link$i <1> [list selbyid $child]
4889 $ctext insert end "\n\t[lindex $info 0]"
4890 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4891 set date [formatdate [lindex $info 2]]
4892 $ctext insert end "\n\tDate:\t$date\n"
4895 $ctext conf -state disabled
4896 init_flist {}
4899 proc normalline {} {
4900 global thickerline
4901 if {[info exists thickerline]} {
4902 set id $thickerline
4903 unset thickerline
4904 drawlines $id
4908 proc selbyid {id} {
4909 global commitrow curview
4910 if {[info exists commitrow($curview,$id)]} {
4911 selectline $commitrow($curview,$id) 1
4915 proc mstime {} {
4916 global startmstime
4917 if {![info exists startmstime]} {
4918 set startmstime [clock clicks -milliseconds]
4920 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4923 proc rowmenu {x y id} {
4924 global rowctxmenu commitrow selectedline rowmenuid curview
4926 if {![info exists selectedline]
4927 || $commitrow($curview,$id) eq $selectedline} {
4928 set state disabled
4929 } else {
4930 set state normal
4932 $rowctxmenu entryconfigure "Diff this*" -state $state
4933 $rowctxmenu entryconfigure "Diff selected*" -state $state
4934 $rowctxmenu entryconfigure "Make patch" -state $state
4935 set rowmenuid $id
4936 tk_popup $rowctxmenu $x $y
4939 proc diffvssel {dirn} {
4940 global rowmenuid selectedline displayorder
4942 if {![info exists selectedline]} return
4943 if {$dirn} {
4944 set oldid [lindex $displayorder $selectedline]
4945 set newid $rowmenuid
4946 } else {
4947 set oldid $rowmenuid
4948 set newid [lindex $displayorder $selectedline]
4950 addtohistory [list doseldiff $oldid $newid]
4951 doseldiff $oldid $newid
4954 proc doseldiff {oldid newid} {
4955 global ctext
4956 global commitinfo
4958 $ctext conf -state normal
4959 clear_ctext
4960 init_flist "Top"
4961 $ctext insert end "From "
4962 $ctext tag conf link -foreground blue -underline 1
4963 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4964 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4965 $ctext tag bind link0 <1> [list selbyid $oldid]
4966 $ctext insert end $oldid [list link link0]
4967 $ctext insert end "\n "
4968 $ctext insert end [lindex $commitinfo($oldid) 0]
4969 $ctext insert end "\n\nTo "
4970 $ctext tag bind link1 <1> [list selbyid $newid]
4971 $ctext insert end $newid [list link link1]
4972 $ctext insert end "\n "
4973 $ctext insert end [lindex $commitinfo($newid) 0]
4974 $ctext insert end "\n"
4975 $ctext conf -state disabled
4976 $ctext tag delete Comments
4977 $ctext tag remove found 1.0 end
4978 startdiff [list $oldid $newid]
4981 proc mkpatch {} {
4982 global rowmenuid currentid commitinfo patchtop patchnum
4984 if {![info exists currentid]} return
4985 set oldid $currentid
4986 set oldhead [lindex $commitinfo($oldid) 0]
4987 set newid $rowmenuid
4988 set newhead [lindex $commitinfo($newid) 0]
4989 set top .patch
4990 set patchtop $top
4991 catch {destroy $top}
4992 toplevel $top
4993 label $top.title -text "Generate patch"
4994 grid $top.title - -pady 10
4995 label $top.from -text "From:"
4996 entry $top.fromsha1 -width 40 -relief flat
4997 $top.fromsha1 insert 0 $oldid
4998 $top.fromsha1 conf -state readonly
4999 grid $top.from $top.fromsha1 -sticky w
5000 entry $top.fromhead -width 60 -relief flat
5001 $top.fromhead insert 0 $oldhead
5002 $top.fromhead conf -state readonly
5003 grid x $top.fromhead -sticky w
5004 label $top.to -text "To:"
5005 entry $top.tosha1 -width 40 -relief flat
5006 $top.tosha1 insert 0 $newid
5007 $top.tosha1 conf -state readonly
5008 grid $top.to $top.tosha1 -sticky w
5009 entry $top.tohead -width 60 -relief flat
5010 $top.tohead insert 0 $newhead
5011 $top.tohead conf -state readonly
5012 grid x $top.tohead -sticky w
5013 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5014 grid $top.rev x -pady 10
5015 label $top.flab -text "Output file:"
5016 entry $top.fname -width 60
5017 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5018 incr patchnum
5019 grid $top.flab $top.fname -sticky w
5020 frame $top.buts
5021 button $top.buts.gen -text "Generate" -command mkpatchgo
5022 button $top.buts.can -text "Cancel" -command mkpatchcan
5023 grid $top.buts.gen $top.buts.can
5024 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5025 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5026 grid $top.buts - -pady 10 -sticky ew
5027 focus $top.fname
5030 proc mkpatchrev {} {
5031 global patchtop
5033 set oldid [$patchtop.fromsha1 get]
5034 set oldhead [$patchtop.fromhead get]
5035 set newid [$patchtop.tosha1 get]
5036 set newhead [$patchtop.tohead get]
5037 foreach e [list fromsha1 fromhead tosha1 tohead] \
5038 v [list $newid $newhead $oldid $oldhead] {
5039 $patchtop.$e conf -state normal
5040 $patchtop.$e delete 0 end
5041 $patchtop.$e insert 0 $v
5042 $patchtop.$e conf -state readonly
5046 proc mkpatchgo {} {
5047 global patchtop
5049 set oldid [$patchtop.fromsha1 get]
5050 set newid [$patchtop.tosha1 get]
5051 set fname [$patchtop.fname get]
5052 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5053 error_popup "Error creating patch: $err"
5055 catch {destroy $patchtop}
5056 unset patchtop
5059 proc mkpatchcan {} {
5060 global patchtop
5062 catch {destroy $patchtop}
5063 unset patchtop
5066 proc mktag {} {
5067 global rowmenuid mktagtop commitinfo
5069 set top .maketag
5070 set mktagtop $top
5071 catch {destroy $top}
5072 toplevel $top
5073 label $top.title -text "Create tag"
5074 grid $top.title - -pady 10
5075 label $top.id -text "ID:"
5076 entry $top.sha1 -width 40 -relief flat
5077 $top.sha1 insert 0 $rowmenuid
5078 $top.sha1 conf -state readonly
5079 grid $top.id $top.sha1 -sticky w
5080 entry $top.head -width 60 -relief flat
5081 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5082 $top.head conf -state readonly
5083 grid x $top.head -sticky w
5084 label $top.tlab -text "Tag name:"
5085 entry $top.tag -width 60
5086 grid $top.tlab $top.tag -sticky w
5087 frame $top.buts
5088 button $top.buts.gen -text "Create" -command mktaggo
5089 button $top.buts.can -text "Cancel" -command mktagcan
5090 grid $top.buts.gen $top.buts.can
5091 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5092 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5093 grid $top.buts - -pady 10 -sticky ew
5094 focus $top.tag
5097 proc domktag {} {
5098 global mktagtop env tagids idtags
5100 set id [$mktagtop.sha1 get]
5101 set tag [$mktagtop.tag get]
5102 if {$tag == {}} {
5103 error_popup "No tag name specified"
5104 return
5106 if {[info exists tagids($tag)]} {
5107 error_popup "Tag \"$tag\" already exists"
5108 return
5110 if {[catch {
5111 set dir [gitdir]
5112 set fname [file join $dir "refs/tags" $tag]
5113 set f [open $fname w]
5114 puts $f $id
5115 close $f
5116 } err]} {
5117 error_popup "Error creating tag: $err"
5118 return
5121 set tagids($tag) $id
5122 lappend idtags($id) $tag
5123 redrawtags $id
5124 addedtag $id
5127 proc redrawtags {id} {
5128 global canv linehtag commitrow idpos selectedline curview
5129 global mainfont canvxmax
5131 if {![info exists commitrow($curview,$id)]} return
5132 drawcmitrow $commitrow($curview,$id)
5133 $canv delete tag.$id
5134 set xt [eval drawtags $id $idpos($id)]
5135 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5136 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5137 set xr [expr {$xt + [font measure $mainfont $text]}]
5138 if {$xr > $canvxmax} {
5139 set canvxmax $xr
5140 setcanvscroll
5142 if {[info exists selectedline]
5143 && $selectedline == $commitrow($curview,$id)} {
5144 selectline $selectedline 0
5148 proc mktagcan {} {
5149 global mktagtop
5151 catch {destroy $mktagtop}
5152 unset mktagtop
5155 proc mktaggo {} {
5156 domktag
5157 mktagcan
5160 proc writecommit {} {
5161 global rowmenuid wrcomtop commitinfo wrcomcmd
5163 set top .writecommit
5164 set wrcomtop $top
5165 catch {destroy $top}
5166 toplevel $top
5167 label $top.title -text "Write commit to file"
5168 grid $top.title - -pady 10
5169 label $top.id -text "ID:"
5170 entry $top.sha1 -width 40 -relief flat
5171 $top.sha1 insert 0 $rowmenuid
5172 $top.sha1 conf -state readonly
5173 grid $top.id $top.sha1 -sticky w
5174 entry $top.head -width 60 -relief flat
5175 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5176 $top.head conf -state readonly
5177 grid x $top.head -sticky w
5178 label $top.clab -text "Command:"
5179 entry $top.cmd -width 60 -textvariable wrcomcmd
5180 grid $top.clab $top.cmd -sticky w -pady 10
5181 label $top.flab -text "Output file:"
5182 entry $top.fname -width 60
5183 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5184 grid $top.flab $top.fname -sticky w
5185 frame $top.buts
5186 button $top.buts.gen -text "Write" -command wrcomgo
5187 button $top.buts.can -text "Cancel" -command wrcomcan
5188 grid $top.buts.gen $top.buts.can
5189 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5190 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5191 grid $top.buts - -pady 10 -sticky ew
5192 focus $top.fname
5195 proc wrcomgo {} {
5196 global wrcomtop
5198 set id [$wrcomtop.sha1 get]
5199 set cmd "echo $id | [$wrcomtop.cmd get]"
5200 set fname [$wrcomtop.fname get]
5201 if {[catch {exec sh -c $cmd >$fname &} err]} {
5202 error_popup "Error writing commit: $err"
5204 catch {destroy $wrcomtop}
5205 unset wrcomtop
5208 proc wrcomcan {} {
5209 global wrcomtop
5211 catch {destroy $wrcomtop}
5212 unset wrcomtop
5215 proc mkbranch {} {
5216 global rowmenuid mkbrtop
5218 set top .makebranch
5219 catch {destroy $top}
5220 toplevel $top
5221 label $top.title -text "Create new branch"
5222 grid $top.title - -pady 10
5223 label $top.id -text "ID:"
5224 entry $top.sha1 -width 40 -relief flat
5225 $top.sha1 insert 0 $rowmenuid
5226 $top.sha1 conf -state readonly
5227 grid $top.id $top.sha1 -sticky w
5228 label $top.nlab -text "Name:"
5229 entry $top.name -width 40
5230 grid $top.nlab $top.name -sticky w
5231 frame $top.buts
5232 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5233 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5234 grid $top.buts.go $top.buts.can
5235 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5236 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5237 grid $top.buts - -pady 10 -sticky ew
5238 focus $top.name
5241 proc mkbrgo {top} {
5242 global headids idheads
5244 set name [$top.name get]
5245 set id [$top.sha1 get]
5246 if {$name eq {}} {
5247 error_popup "Please specify a name for the new branch"
5248 return
5250 catch {destroy $top}
5251 nowbusy newbranch
5252 update
5253 if {[catch {
5254 exec git branch $name $id
5255 } err]} {
5256 notbusy newbranch
5257 error_popup $err
5258 } else {
5259 addedhead $id $name
5260 # XXX should update list of heads displayed for selected commit
5261 notbusy newbranch
5262 redrawtags $id
5266 proc cherrypick {} {
5267 global rowmenuid curview commitrow
5268 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5270 if {[info exists desc_heads($rowmenuid)]
5271 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5272 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5273 included in branch $mainhead -- really re-apply it?"]
5274 if {!$ok} return
5276 nowbusy cherrypick
5277 update
5278 set oldhead [exec git rev-parse HEAD]
5279 # Unfortunately git-cherry-pick writes stuff to stderr even when
5280 # no error occurs, and exec takes that as an indication of error...
5281 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5282 notbusy cherrypick
5283 error_popup $err
5284 return
5286 set newhead [exec git rev-parse HEAD]
5287 if {$newhead eq $oldhead} {
5288 notbusy cherrypick
5289 error_popup "No changes committed"
5290 return
5292 set allparents($newhead) $oldhead
5293 lappend allchildren($oldhead) $newhead
5294 set desc_heads($newhead) $mainhead
5295 if {[info exists anc_tags($oldhead)]} {
5296 set anc_tags($newhead) $anc_tags($oldhead)
5298 set desc_tags($newhead) {}
5299 if {[info exists commitrow($curview,$oldhead)]} {
5300 insertrow $commitrow($curview,$oldhead) $newhead
5301 if {$mainhead ne {}} {
5302 movedhead $newhead $mainhead
5304 redrawtags $oldhead
5305 redrawtags $newhead
5307 notbusy cherrypick
5310 # context menu for a head
5311 proc headmenu {x y id head} {
5312 global headmenuid headmenuhead headctxmenu
5314 set headmenuid $id
5315 set headmenuhead $head
5316 tk_popup $headctxmenu $x $y
5319 proc cobranch {} {
5320 global headmenuid headmenuhead mainhead headids
5322 # check the tree is clean first??
5323 set oldmainhead $mainhead
5324 nowbusy checkout
5325 update
5326 if {[catch {
5327 exec git checkout $headmenuhead
5328 } err]} {
5329 notbusy checkout
5330 error_popup $err
5331 } else {
5332 notbusy checkout
5333 set mainhead $headmenuhead
5334 if {[info exists headids($oldmainhead)]} {
5335 redrawtags $headids($oldmainhead)
5337 redrawtags $headmenuid
5341 proc rmbranch {} {
5342 global desc_heads headmenuid headmenuhead mainhead
5343 global headids idheads
5345 set head $headmenuhead
5346 set id $headmenuid
5347 if {$head eq $mainhead} {
5348 error_popup "Cannot delete the currently checked-out branch"
5349 return
5351 if {$desc_heads($id) eq $head} {
5352 # the stuff on this branch isn't on any other branch
5353 if {![confirm_popup "The commits on branch $head aren't on any other\
5354 branch.\nReally delete branch $head?"]} return
5356 nowbusy rmbranch
5357 update
5358 if {[catch {exec git branch -D $head} err]} {
5359 notbusy rmbranch
5360 error_popup $err
5361 return
5363 removedhead $id $head
5364 redrawtags $id
5365 notbusy rmbranch
5368 # Stuff for finding nearby tags
5369 proc getallcommits {} {
5370 global allcstart allcommits allcfd allids
5372 set allids {}
5373 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5374 set allcfd $fd
5375 fconfigure $fd -blocking 0
5376 set allcommits "reading"
5377 nowbusy allcommits
5378 restartgetall $fd
5381 proc discardallcommits {} {
5382 global allparents allchildren allcommits allcfd
5383 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5385 if {![info exists allcommits]} return
5386 if {$allcommits eq "reading"} {
5387 catch {close $allcfd}
5389 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5390 alldtags tagisdesc desc_heads} {
5391 catch {unset $v}
5395 proc restartgetall {fd} {
5396 global allcstart
5398 fileevent $fd readable [list getallclines $fd]
5399 set allcstart [clock clicks -milliseconds]
5402 proc combine_dtags {l1 l2} {
5403 global tagisdesc notfirstd
5405 set res [lsort -unique [concat $l1 $l2]]
5406 for {set i 0} {$i < [llength $res]} {incr i} {
5407 set x [lindex $res $i]
5408 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5409 set y [lindex $res $j]
5410 if {[info exists tagisdesc($x,$y)]} {
5411 if {$tagisdesc($x,$y) > 0} {
5412 # x is a descendent of y, exclude x
5413 set res [lreplace $res $i $i]
5414 incr i -1
5415 break
5416 } else {
5417 # y is a descendent of x, exclude y
5418 set res [lreplace $res $j $j]
5420 } else {
5421 # no relation, keep going
5422 incr j
5426 return $res
5429 proc combine_atags {l1 l2} {
5430 global tagisdesc
5432 set res [lsort -unique [concat $l1 $l2]]
5433 for {set i 0} {$i < [llength $res]} {incr i} {
5434 set x [lindex $res $i]
5435 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5436 set y [lindex $res $j]
5437 if {[info exists tagisdesc($x,$y)]} {
5438 if {$tagisdesc($x,$y) < 0} {
5439 # x is an ancestor of y, exclude x
5440 set res [lreplace $res $i $i]
5441 incr i -1
5442 break
5443 } else {
5444 # y is an ancestor of x, exclude y
5445 set res [lreplace $res $j $j]
5447 } else {
5448 # no relation, keep going
5449 incr j
5453 return $res
5456 proc forward_pass {id children} {
5457 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5459 set dtags {}
5460 set dheads {}
5461 foreach child $children {
5462 if {[info exists idtags($child)]} {
5463 set ctags [list $child]
5464 } else {
5465 set ctags $desc_tags($child)
5467 if {$dtags eq {}} {
5468 set dtags $ctags
5469 } elseif {$ctags ne $dtags} {
5470 set dtags [combine_dtags $dtags $ctags]
5472 set cheads $desc_heads($child)
5473 if {$dheads eq {}} {
5474 set dheads $cheads
5475 } elseif {$cheads ne $dheads} {
5476 set dheads [lsort -unique [concat $dheads $cheads]]
5479 set desc_tags($id) $dtags
5480 if {[info exists idtags($id)]} {
5481 set adt $dtags
5482 foreach tag $dtags {
5483 set adt [concat $adt $alldtags($tag)]
5485 set adt [lsort -unique $adt]
5486 set alldtags($id) $adt
5487 foreach tag $adt {
5488 set tagisdesc($id,$tag) -1
5489 set tagisdesc($tag,$id) 1
5492 if {[info exists idheads($id)]} {
5493 set dheads [concat $dheads $idheads($id)]
5495 set desc_heads($id) $dheads
5498 proc getallclines {fd} {
5499 global allparents allchildren allcommits allcstart
5500 global desc_tags anc_tags idtags tagisdesc allids
5501 global idheads travindex
5503 while {[gets $fd line] >= 0} {
5504 set id [lindex $line 0]
5505 lappend allids $id
5506 set olds [lrange $line 1 end]
5507 set allparents($id) $olds
5508 if {![info exists allchildren($id)]} {
5509 set allchildren($id) {}
5511 foreach p $olds {
5512 lappend allchildren($p) $id
5514 # compute nearest tagged descendents as we go
5515 # also compute descendent heads
5516 forward_pass $id $allchildren($id)
5517 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5518 fileevent $fd readable {}
5519 after idle restartgetall $fd
5520 return
5523 if {[eof $fd]} {
5524 set travindex [llength $allids]
5525 set allcommits "traversing"
5526 after idle restartatags
5527 if {[catch {close $fd} err]} {
5528 error_popup "Error reading full commit graph: $err.\n\
5529 Results may be incomplete."
5534 # walk backward through the tree and compute nearest tagged ancestors
5535 proc restartatags {} {
5536 global allids allparents idtags anc_tags travindex
5538 set t0 [clock clicks -milliseconds]
5539 set i $travindex
5540 while {[incr i -1] >= 0} {
5541 set id [lindex $allids $i]
5542 set atags {}
5543 foreach p $allparents($id) {
5544 if {[info exists idtags($p)]} {
5545 set ptags [list $p]
5546 } else {
5547 set ptags $anc_tags($p)
5549 if {$atags eq {}} {
5550 set atags $ptags
5551 } elseif {$ptags ne $atags} {
5552 set atags [combine_atags $atags $ptags]
5555 set anc_tags($id) $atags
5556 if {[clock clicks -milliseconds] - $t0 >= 50} {
5557 set travindex $i
5558 after idle restartatags
5559 return
5562 set allcommits "done"
5563 set travindex 0
5564 notbusy allcommits
5565 dispneartags
5568 # update the desc_tags and anc_tags arrays for a new tag just added
5569 proc addedtag {id} {
5570 global desc_tags anc_tags allparents allchildren allcommits
5571 global idtags tagisdesc alldtags
5573 if {![info exists desc_tags($id)]} return
5574 set adt $desc_tags($id)
5575 foreach t $desc_tags($id) {
5576 set adt [concat $adt $alldtags($t)]
5578 set adt [lsort -unique $adt]
5579 set alldtags($id) $adt
5580 foreach t $adt {
5581 set tagisdesc($id,$t) -1
5582 set tagisdesc($t,$id) 1
5584 if {[info exists anc_tags($id)]} {
5585 set todo $anc_tags($id)
5586 while {$todo ne {}} {
5587 set do [lindex $todo 0]
5588 set todo [lrange $todo 1 end]
5589 if {[info exists tagisdesc($id,$do)]} continue
5590 set tagisdesc($do,$id) -1
5591 set tagisdesc($id,$do) 1
5592 if {[info exists anc_tags($do)]} {
5593 set todo [concat $todo $anc_tags($do)]
5598 set lastold $desc_tags($id)
5599 set lastnew [list $id]
5600 set nup 0
5601 set nch 0
5602 set todo $allparents($id)
5603 while {$todo ne {}} {
5604 set do [lindex $todo 0]
5605 set todo [lrange $todo 1 end]
5606 if {![info exists desc_tags($do)]} continue
5607 if {$desc_tags($do) ne $lastold} {
5608 set lastold $desc_tags($do)
5609 set lastnew [combine_dtags $lastold [list $id]]
5610 incr nch
5612 if {$lastold eq $lastnew} continue
5613 set desc_tags($do) $lastnew
5614 incr nup
5615 if {![info exists idtags($do)]} {
5616 set todo [concat $todo $allparents($do)]
5620 if {![info exists anc_tags($id)]} return
5621 set lastold $anc_tags($id)
5622 set lastnew [list $id]
5623 set nup 0
5624 set nch 0
5625 set todo $allchildren($id)
5626 while {$todo ne {}} {
5627 set do [lindex $todo 0]
5628 set todo [lrange $todo 1 end]
5629 if {![info exists anc_tags($do)]} continue
5630 if {$anc_tags($do) ne $lastold} {
5631 set lastold $anc_tags($do)
5632 set lastnew [combine_atags $lastold [list $id]]
5633 incr nch
5635 if {$lastold eq $lastnew} continue
5636 set anc_tags($do) $lastnew
5637 incr nup
5638 if {![info exists idtags($do)]} {
5639 set todo [concat $todo $allchildren($do)]
5644 # update the desc_heads array for a new head just added
5645 proc addedhead {hid head} {
5646 global desc_heads allparents headids idheads
5648 set headids($head) $hid
5649 lappend idheads($hid) $head
5651 set todo [list $hid]
5652 while {$todo ne {}} {
5653 set do [lindex $todo 0]
5654 set todo [lrange $todo 1 end]
5655 if {![info exists desc_heads($do)] ||
5656 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5657 set oldheads $desc_heads($do)
5658 lappend desc_heads($do) $head
5659 set heads $desc_heads($do)
5660 while {1} {
5661 set p $allparents($do)
5662 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5663 $desc_heads($p) ne $oldheads} break
5664 set do $p
5665 set desc_heads($do) $heads
5667 set todo [concat $todo $p]
5671 # update the desc_heads array for a head just removed
5672 proc removedhead {hid head} {
5673 global desc_heads allparents headids idheads
5675 unset headids($head)
5676 if {$idheads($hid) eq $head} {
5677 unset idheads($hid)
5678 } else {
5679 set i [lsearch -exact $idheads($hid) $head]
5680 if {$i >= 0} {
5681 set idheads($hid) [lreplace $idheads($hid) $i $i]
5685 set todo [list $hid]
5686 while {$todo ne {}} {
5687 set do [lindex $todo 0]
5688 set todo [lrange $todo 1 end]
5689 if {![info exists desc_heads($do)]} continue
5690 set i [lsearch -exact $desc_heads($do) $head]
5691 if {$i < 0} continue
5692 set oldheads $desc_heads($do)
5693 set heads [lreplace $desc_heads($do) $i $i]
5694 while {1} {
5695 set desc_heads($do) $heads
5696 set p $allparents($do)
5697 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5698 $desc_heads($p) ne $oldheads} break
5699 set do $p
5701 set todo [concat $todo $p]
5705 # update things for a head moved to a child of its previous location
5706 proc movedhead {id name} {
5707 global headids idheads
5709 set oldid $headids($name)
5710 set headids($name) $id
5711 if {$idheads($oldid) eq $name} {
5712 unset idheads($oldid)
5713 } else {
5714 set i [lsearch -exact $idheads($oldid) $name]
5715 if {$i >= 0} {
5716 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5719 lappend idheads($id) $name
5722 proc changedrefs {} {
5723 global desc_heads desc_tags anc_tags allcommits allids
5724 global allchildren allparents idtags travindex
5726 if {![info exists allcommits]} return
5727 catch {unset desc_heads}
5728 catch {unset desc_tags}
5729 catch {unset anc_tags}
5730 catch {unset alldtags}
5731 catch {unset tagisdesc}
5732 foreach id $allids {
5733 forward_pass $id $allchildren($id)
5735 if {$allcommits ne "reading"} {
5736 set travindex [llength $allids]
5737 if {$allcommits ne "traversing"} {
5738 set allcommits "traversing"
5739 after idle restartatags
5744 proc rereadrefs {} {
5745 global idtags idheads idotherrefs mainhead
5747 set refids [concat [array names idtags] \
5748 [array names idheads] [array names idotherrefs]]
5749 foreach id $refids {
5750 if {![info exists ref($id)]} {
5751 set ref($id) [listrefs $id]
5754 set oldmainhead $mainhead
5755 readrefs
5756 changedrefs
5757 set refids [lsort -unique [concat $refids [array names idtags] \
5758 [array names idheads] [array names idotherrefs]]]
5759 foreach id $refids {
5760 set v [listrefs $id]
5761 if {![info exists ref($id)] || $ref($id) != $v ||
5762 ($id eq $oldmainhead && $id ne $mainhead) ||
5763 ($id eq $mainhead && $id ne $oldmainhead)} {
5764 redrawtags $id
5769 proc listrefs {id} {
5770 global idtags idheads idotherrefs
5772 set x {}
5773 if {[info exists idtags($id)]} {
5774 set x $idtags($id)
5776 set y {}
5777 if {[info exists idheads($id)]} {
5778 set y $idheads($id)
5780 set z {}
5781 if {[info exists idotherrefs($id)]} {
5782 set z $idotherrefs($id)
5784 return [list $x $y $z]
5787 proc showtag {tag isnew} {
5788 global ctext tagcontents tagids linknum
5790 if {$isnew} {
5791 addtohistory [list showtag $tag 0]
5793 $ctext conf -state normal
5794 clear_ctext
5795 set linknum 0
5796 if {[info exists tagcontents($tag)]} {
5797 set text $tagcontents($tag)
5798 } else {
5799 set text "Tag: $tag\nId: $tagids($tag)"
5801 appendwithlinks $text {}
5802 $ctext conf -state disabled
5803 init_flist {}
5806 proc doquit {} {
5807 global stopped
5808 set stopped 100
5809 savestuff .
5810 destroy .
5813 proc doprefs {} {
5814 global maxwidth maxgraphpct diffopts
5815 global oldprefs prefstop showneartags
5816 global bgcolor fgcolor ctext diffcolors
5818 set top .gitkprefs
5819 set prefstop $top
5820 if {[winfo exists $top]} {
5821 raise $top
5822 return
5824 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5825 set oldprefs($v) [set $v]
5827 toplevel $top
5828 wm title $top "Gitk preferences"
5829 label $top.ldisp -text "Commit list display options"
5830 grid $top.ldisp - -sticky w -pady 10
5831 label $top.spacer -text " "
5832 label $top.maxwidthl -text "Maximum graph width (lines)" \
5833 -font optionfont
5834 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5835 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5836 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5837 -font optionfont
5838 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5839 grid x $top.maxpctl $top.maxpct -sticky w
5841 label $top.ddisp -text "Diff display options"
5842 grid $top.ddisp - -sticky w -pady 10
5843 label $top.diffoptl -text "Options for diff program" \
5844 -font optionfont
5845 entry $top.diffopt -width 20 -textvariable diffopts
5846 grid x $top.diffoptl $top.diffopt -sticky w
5847 frame $top.ntag
5848 label $top.ntag.l -text "Display nearby tags" -font optionfont
5849 checkbutton $top.ntag.b -variable showneartags
5850 pack $top.ntag.b $top.ntag.l -side left
5851 grid x $top.ntag -sticky w
5853 label $top.cdisp -text "Colors: press to choose"
5854 grid $top.cdisp - -sticky w -pady 10
5855 label $top.bg -padx 40 -relief sunk -background $bgcolor
5856 button $top.bgbut -text "Background" -font optionfont \
5857 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5858 grid x $top.bgbut $top.bg -sticky w
5859 label $top.fg -padx 40 -relief sunk -background $fgcolor
5860 button $top.fgbut -text "Foreground" -font optionfont \
5861 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5862 grid x $top.fgbut $top.fg -sticky w
5863 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5864 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5865 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5866 [list $ctext tag conf d0 -foreground]]
5867 grid x $top.diffoldbut $top.diffold -sticky w
5868 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5869 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5870 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5871 [list $ctext tag conf d1 -foreground]]
5872 grid x $top.diffnewbut $top.diffnew -sticky w
5873 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5874 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5875 -command [list choosecolor diffcolors 2 $top.hunksep \
5876 "diff hunk header" \
5877 [list $ctext tag conf hunksep -foreground]]
5878 grid x $top.hunksepbut $top.hunksep -sticky w
5880 frame $top.buts
5881 button $top.buts.ok -text "OK" -command prefsok
5882 button $top.buts.can -text "Cancel" -command prefscan
5883 grid $top.buts.ok $top.buts.can
5884 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5885 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5886 grid $top.buts - - -pady 10 -sticky ew
5889 proc choosecolor {v vi w x cmd} {
5890 global $v
5892 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5893 -title "Gitk: choose color for $x"]
5894 if {$c eq {}} return
5895 $w conf -background $c
5896 lset $v $vi $c
5897 eval $cmd $c
5900 proc setbg {c} {
5901 global bglist
5903 foreach w $bglist {
5904 $w conf -background $c
5908 proc setfg {c} {
5909 global fglist canv
5911 foreach w $fglist {
5912 $w conf -foreground $c
5914 allcanvs itemconf text -fill $c
5915 $canv itemconf circle -outline $c
5918 proc prefscan {} {
5919 global maxwidth maxgraphpct diffopts
5920 global oldprefs prefstop showneartags
5922 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5923 set $v $oldprefs($v)
5925 catch {destroy $prefstop}
5926 unset prefstop
5929 proc prefsok {} {
5930 global maxwidth maxgraphpct
5931 global oldprefs prefstop showneartags
5933 catch {destroy $prefstop}
5934 unset prefstop
5935 if {$maxwidth != $oldprefs(maxwidth)
5936 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5937 redisplay
5938 } elseif {$showneartags != $oldprefs(showneartags)} {
5939 reselectline
5943 proc formatdate {d} {
5944 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5947 # This list of encoding names and aliases is distilled from
5948 # http://www.iana.org/assignments/character-sets.
5949 # Not all of them are supported by Tcl.
5950 set encoding_aliases {
5951 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5952 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5953 { ISO-10646-UTF-1 csISO10646UTF1 }
5954 { ISO_646.basic:1983 ref csISO646basic1983 }
5955 { INVARIANT csINVARIANT }
5956 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5957 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5958 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5959 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5960 { NATS-DANO iso-ir-9-1 csNATSDANO }
5961 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5962 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5963 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5964 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5965 { ISO-2022-KR csISO2022KR }
5966 { EUC-KR csEUCKR }
5967 { ISO-2022-JP csISO2022JP }
5968 { ISO-2022-JP-2 csISO2022JP2 }
5969 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5970 csISO13JISC6220jp }
5971 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5972 { IT iso-ir-15 ISO646-IT csISO15Italian }
5973 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5974 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5975 { greek7-old iso-ir-18 csISO18Greek7Old }
5976 { latin-greek iso-ir-19 csISO19LatinGreek }
5977 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5978 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5979 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5980 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5981 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5982 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5983 { INIS iso-ir-49 csISO49INIS }
5984 { INIS-8 iso-ir-50 csISO50INIS8 }
5985 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5986 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5987 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5988 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5989 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5990 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5991 csISO60Norwegian1 }
5992 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5993 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5994 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5995 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5996 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5997 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5998 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5999 { greek7 iso-ir-88 csISO88Greek7 }
6000 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6001 { iso-ir-90 csISO90 }
6002 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6003 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6004 csISO92JISC62991984b }
6005 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6006 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6007 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6008 csISO95JIS62291984handadd }
6009 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6010 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6011 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6012 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6013 CP819 csISOLatin1 }
6014 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6015 { T.61-7bit iso-ir-102 csISO102T617bit }
6016 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6017 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6018 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6019 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6020 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6021 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6022 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6023 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6024 arabic csISOLatinArabic }
6025 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6026 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6027 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6028 greek greek8 csISOLatinGreek }
6029 { T.101-G2 iso-ir-128 csISO128T101G2 }
6030 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6031 csISOLatinHebrew }
6032 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6033 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6034 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6035 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6036 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6037 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6038 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6039 csISOLatinCyrillic }
6040 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6041 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6042 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6043 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6044 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6045 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6046 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6047 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6048 { ISO_10367-box iso-ir-155 csISO10367Box }
6049 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6050 { latin-lap lap iso-ir-158 csISO158Lap }
6051 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6052 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6053 { us-dk csUSDK }
6054 { dk-us csDKUS }
6055 { JIS_X0201 X0201 csHalfWidthKatakana }
6056 { KSC5636 ISO646-KR csKSC5636 }
6057 { ISO-10646-UCS-2 csUnicode }
6058 { ISO-10646-UCS-4 csUCS4 }
6059 { DEC-MCS dec csDECMCS }
6060 { hp-roman8 roman8 r8 csHPRoman8 }
6061 { macintosh mac csMacintosh }
6062 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6063 csIBM037 }
6064 { IBM038 EBCDIC-INT cp038 csIBM038 }
6065 { IBM273 CP273 csIBM273 }
6066 { IBM274 EBCDIC-BE CP274 csIBM274 }
6067 { IBM275 EBCDIC-BR cp275 csIBM275 }
6068 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6069 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6070 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6071 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6072 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6073 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6074 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6075 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6076 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6077 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6078 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6079 { IBM437 cp437 437 csPC8CodePage437 }
6080 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6081 { IBM775 cp775 csPC775Baltic }
6082 { IBM850 cp850 850 csPC850Multilingual }
6083 { IBM851 cp851 851 csIBM851 }
6084 { IBM852 cp852 852 csPCp852 }
6085 { IBM855 cp855 855 csIBM855 }
6086 { IBM857 cp857 857 csIBM857 }
6087 { IBM860 cp860 860 csIBM860 }
6088 { IBM861 cp861 861 cp-is csIBM861 }
6089 { IBM862 cp862 862 csPC862LatinHebrew }
6090 { IBM863 cp863 863 csIBM863 }
6091 { IBM864 cp864 csIBM864 }
6092 { IBM865 cp865 865 csIBM865 }
6093 { IBM866 cp866 866 csIBM866 }
6094 { IBM868 CP868 cp-ar csIBM868 }
6095 { IBM869 cp869 869 cp-gr csIBM869 }
6096 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6097 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6098 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6099 { IBM891 cp891 csIBM891 }
6100 { IBM903 cp903 csIBM903 }
6101 { IBM904 cp904 904 csIBBM904 }
6102 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6103 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6104 { IBM1026 CP1026 csIBM1026 }
6105 { EBCDIC-AT-DE csIBMEBCDICATDE }
6106 { EBCDIC-AT-DE-A csEBCDICATDEA }
6107 { EBCDIC-CA-FR csEBCDICCAFR }
6108 { EBCDIC-DK-NO csEBCDICDKNO }
6109 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6110 { EBCDIC-FI-SE csEBCDICFISE }
6111 { EBCDIC-FI-SE-A csEBCDICFISEA }
6112 { EBCDIC-FR csEBCDICFR }
6113 { EBCDIC-IT csEBCDICIT }
6114 { EBCDIC-PT csEBCDICPT }
6115 { EBCDIC-ES csEBCDICES }
6116 { EBCDIC-ES-A csEBCDICESA }
6117 { EBCDIC-ES-S csEBCDICESS }
6118 { EBCDIC-UK csEBCDICUK }
6119 { EBCDIC-US csEBCDICUS }
6120 { UNKNOWN-8BIT csUnknown8BiT }
6121 { MNEMONIC csMnemonic }
6122 { MNEM csMnem }
6123 { VISCII csVISCII }
6124 { VIQR csVIQR }
6125 { KOI8-R csKOI8R }
6126 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6127 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6128 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6129 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6130 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6131 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6132 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6133 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6134 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6135 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6136 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6137 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6138 { IBM1047 IBM-1047 }
6139 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6140 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6141 { UNICODE-1-1 csUnicode11 }
6142 { CESU-8 csCESU-8 }
6143 { BOCU-1 csBOCU-1 }
6144 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6145 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6146 l8 }
6147 { ISO-8859-15 ISO_8859-15 Latin-9 }
6148 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6149 { GBK CP936 MS936 windows-936 }
6150 { JIS_Encoding csJISEncoding }
6151 { Shift_JIS MS_Kanji csShiftJIS }
6152 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6153 EUC-JP }
6154 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6155 { ISO-10646-UCS-Basic csUnicodeASCII }
6156 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6157 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6158 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6159 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6160 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6161 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6162 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6163 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6164 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6165 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6166 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6167 { Ventura-US csVenturaUS }
6168 { Ventura-International csVenturaInternational }
6169 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6170 { PC8-Turkish csPC8Turkish }
6171 { IBM-Symbols csIBMSymbols }
6172 { IBM-Thai csIBMThai }
6173 { HP-Legal csHPLegal }
6174 { HP-Pi-font csHPPiFont }
6175 { HP-Math8 csHPMath8 }
6176 { Adobe-Symbol-Encoding csHPPSMath }
6177 { HP-DeskTop csHPDesktop }
6178 { Ventura-Math csVenturaMath }
6179 { Microsoft-Publishing csMicrosoftPublishing }
6180 { Windows-31J csWindows31J }
6181 { GB2312 csGB2312 }
6182 { Big5 csBig5 }
6185 proc tcl_encoding {enc} {
6186 global encoding_aliases
6187 set names [encoding names]
6188 set lcnames [string tolower $names]
6189 set enc [string tolower $enc]
6190 set i [lsearch -exact $lcnames $enc]
6191 if {$i < 0} {
6192 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6193 if {[regsub {^iso[-_]} $enc iso encx]} {
6194 set i [lsearch -exact $lcnames $encx]
6197 if {$i < 0} {
6198 foreach l $encoding_aliases {
6199 set ll [string tolower $l]
6200 if {[lsearch -exact $ll $enc] < 0} continue
6201 # look through the aliases for one that tcl knows about
6202 foreach e $ll {
6203 set i [lsearch -exact $lcnames $e]
6204 if {$i < 0} {
6205 if {[regsub {^iso[-_]} $e iso ex]} {
6206 set i [lsearch -exact $lcnames $ex]
6209 if {$i >= 0} break
6211 break
6214 if {$i >= 0} {
6215 return [lindex $names $i]
6217 return {}
6220 # defaults...
6221 set datemode 0
6222 set diffopts "-U 5 -p"
6223 set wrcomcmd "git diff-tree --stdin -p --pretty"
6225 set gitencoding {}
6226 catch {
6227 set gitencoding [exec git config --get i18n.commitencoding]
6229 if {$gitencoding == ""} {
6230 set gitencoding "utf-8"
6232 set tclencoding [tcl_encoding $gitencoding]
6233 if {$tclencoding == {}} {
6234 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6237 set mainfont {Helvetica 9}
6238 set textfont {Courier 9}
6239 set uifont {Helvetica 9 bold}
6240 set findmergefiles 0
6241 set maxgraphpct 50
6242 set maxwidth 16
6243 set revlistorder 0
6244 set fastdate 0
6245 set uparrowlen 7
6246 set downarrowlen 7
6247 set mingaplen 30
6248 set cmitmode "patch"
6249 set wrapcomment "none"
6250 set showneartags 1
6252 set colors {green red blue magenta darkgrey brown orange}
6253 set bgcolor white
6254 set fgcolor black
6255 set diffcolors {red "#00a000" blue}
6257 catch {source ~/.gitk}
6259 font create optionfont -family sans-serif -size -12
6261 set revtreeargs {}
6262 foreach arg $argv {
6263 switch -regexp -- $arg {
6264 "^$" { }
6265 "^-d" { set datemode 1 }
6266 default {
6267 lappend revtreeargs $arg
6272 # check that we can find a .git directory somewhere...
6273 set gitdir [gitdir]
6274 if {![file isdirectory $gitdir]} {
6275 show_error {} . "Cannot find the git directory \"$gitdir\"."
6276 exit 1
6279 set cmdline_files {}
6280 set i [lsearch -exact $revtreeargs "--"]
6281 if {$i >= 0} {
6282 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6283 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6284 } elseif {$revtreeargs ne {}} {
6285 if {[catch {
6286 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6287 set cmdline_files [split $f "\n"]
6288 set n [llength $cmdline_files]
6289 set revtreeargs [lrange $revtreeargs 0 end-$n]
6290 } err]} {
6291 # unfortunately we get both stdout and stderr in $err,
6292 # so look for "fatal:".
6293 set i [string first "fatal:" $err]
6294 if {$i > 0} {
6295 set err [string range $err [expr {$i + 6}] end]
6297 show_error {} . "Bad arguments to gitk:\n$err"
6298 exit 1
6302 set history {}
6303 set historyindex 0
6304 set fh_serial 0
6305 set nhl_names {}
6306 set highlight_paths {}
6307 set searchdirn -forwards
6308 set boldrows {}
6309 set boldnamerows {}
6311 set optim_delay 16
6313 set nextviewnum 1
6314 set curview 0
6315 set selectedview 0
6316 set selectedhlview None
6317 set viewfiles(0) {}
6318 set viewperm(0) 0
6319 set viewargs(0) {}
6321 set cmdlineok 0
6322 set stopped 0
6323 set stuffsaved 0
6324 set patchnum 0
6325 setcoords
6326 makewindow
6327 wm title . "[file tail $argv0]: [file tail [pwd]]"
6328 readrefs
6330 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6331 # create a view for the files/dirs specified on the command line
6332 set curview 1
6333 set selectedview 1
6334 set nextviewnum 2
6335 set viewname(1) "Command line"
6336 set viewfiles(1) $cmdline_files
6337 set viewargs(1) $revtreeargs
6338 set viewperm(1) 0
6339 addviewmenu 1
6340 .bar.view entryconf Edit* -state normal
6341 .bar.view entryconf Delete* -state normal
6344 if {[info exists permviews]} {
6345 foreach v $permviews {
6346 set n $nextviewnum
6347 incr nextviewnum
6348 set viewname($n) [lindex $v 0]
6349 set viewfiles($n) [lindex $v 1]
6350 set viewargs($n) [lindex $v 2]
6351 set viewperm($n) 1
6352 addviewmenu $n
6355 getcommits