Update README.MinGW.
[git/mingw.git] / gitk
blob8ffc10a9e5440621e023c6c88c38d50f4be64a49
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 -selectbackground]
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 bind . <Control-q> doquit
724 bind . <Control-f> dofind
725 bind . <Control-g> {findnext 0}
726 bind . <Control-r> dosearchback
727 bind . <Control-s> dosearch
728 bind . <Control-equal> {incrfont 1}
729 bind . <Control-KP_Add> {incrfont 1}
730 bind . <Control-minus> {incrfont -1}
731 bind . <Control-KP_Subtract> {incrfont -1}
732 wm protocol . WM_DELETE_WINDOW doquit
733 bind . <Button-1> "click %W"
734 bind $fstring <Key-Return> dofind
735 bind $sha1entry <Key-Return> gotocommit
736 bind $sha1entry <<PasteSelection>> clearsha1
737 bind $cflist <1> {sel_flist %W %x %y; break}
738 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
739 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
741 set maincursor [. cget -cursor]
742 set textcursor [$ctext cget -cursor]
743 set curtextcursor $textcursor
745 set rowctxmenu .rowctxmenu
746 menu $rowctxmenu -tearoff 0
747 $rowctxmenu add command -label "Diff this -> selected" \
748 -command {diffvssel 0}
749 $rowctxmenu add command -label "Diff selected -> this" \
750 -command {diffvssel 1}
751 $rowctxmenu add command -label "Make patch" -command mkpatch
752 $rowctxmenu add command -label "Create tag" -command mktag
753 $rowctxmenu add command -label "Write commit to file" -command writecommit
754 $rowctxmenu add command -label "Create new branch" -command mkbranch
755 $rowctxmenu add command -label "Cherry-pick this commit" \
756 -command cherrypick
758 set headctxmenu .headctxmenu
759 menu $headctxmenu -tearoff 0
760 $headctxmenu add command -label "Check out this branch" \
761 -command cobranch
762 $headctxmenu add command -label "Remove this branch" \
763 -command rmbranch
766 # mouse-2 makes all windows scan vertically, but only the one
767 # the cursor is in scans horizontally
768 proc canvscan {op w x y} {
769 global canv canv2 canv3
770 foreach c [list $canv $canv2 $canv3] {
771 if {$c == $w} {
772 $c scan $op $x $y
773 } else {
774 $c scan $op 0 $y
779 proc scrollcanv {cscroll f0 f1} {
780 $cscroll set $f0 $f1
781 drawfrac $f0 $f1
782 flushhighlights
785 # when we make a key binding for the toplevel, make sure
786 # it doesn't get triggered when that key is pressed in the
787 # find string entry widget.
788 proc bindkey {ev script} {
789 global entries
790 bind . $ev $script
791 set escript [bind Entry $ev]
792 if {$escript == {}} {
793 set escript [bind Entry <Key>]
795 foreach e $entries {
796 bind $e $ev "$escript; break"
800 # set the focus back to the toplevel for any click outside
801 # the entry widgets
802 proc click {w} {
803 global entries
804 foreach e $entries {
805 if {$w == $e} return
807 focus .
810 proc savestuff {w} {
811 global canv canv2 canv3 ctext cflist mainfont textfont uifont
812 global stuffsaved findmergefiles maxgraphpct
813 global maxwidth showneartags
814 global viewname viewfiles viewargs viewperm nextviewnum
815 global cmitmode wrapcomment
816 global colors bgcolor fgcolor diffcolors
818 if {$stuffsaved} return
819 if {![winfo viewable .]} return
820 catch {
821 set f [open "~/.gitk-new" w]
822 puts $f [list set mainfont $mainfont]
823 puts $f [list set textfont $textfont]
824 puts $f [list set uifont $uifont]
825 puts $f [list set findmergefiles $findmergefiles]
826 puts $f [list set maxgraphpct $maxgraphpct]
827 puts $f [list set maxwidth $maxwidth]
828 puts $f [list set cmitmode $cmitmode]
829 puts $f [list set wrapcomment $wrapcomment]
830 puts $f [list set showneartags $showneartags]
831 puts $f [list set bgcolor $bgcolor]
832 puts $f [list set fgcolor $fgcolor]
833 puts $f [list set colors $colors]
834 puts $f [list set diffcolors $diffcolors]
836 puts $f "set geometry(main) [wm geometry .]"
837 puts $f "set geometry(topwidth) [winfo width .tf]"
838 puts $f "set geometry(topheight) [winfo height .tf]"
839 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
840 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
841 puts $f "set geometry(botwidth) [winfo width .bleft]"
842 puts $f "set geometry(botheight) [winfo height .bleft]"
844 puts -nonewline $f "set permviews {"
845 for {set v 0} {$v < $nextviewnum} {incr v} {
846 if {$viewperm($v)} {
847 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
850 puts $f "}"
851 close $f
852 catch {file delete "~/.gitk"}
853 file rename -force "~/.gitk-new" "~/.gitk"
855 set stuffsaved 1
858 proc resizeclistpanes {win w} {
859 global oldwidth
860 if {[info exists oldwidth($win)]} {
861 set s0 [$win sash coord 0]
862 set s1 [$win sash coord 1]
863 if {$w < 60} {
864 set sash0 [expr {int($w/2 - 2)}]
865 set sash1 [expr {int($w*5/6 - 2)}]
866 } else {
867 set factor [expr {1.0 * $w / $oldwidth($win)}]
868 set sash0 [expr {int($factor * [lindex $s0 0])}]
869 set sash1 [expr {int($factor * [lindex $s1 0])}]
870 if {$sash0 < 30} {
871 set sash0 30
873 if {$sash1 < $sash0 + 20} {
874 set sash1 [expr {$sash0 + 20}]
876 if {$sash1 > $w - 10} {
877 set sash1 [expr {$w - 10}]
878 if {$sash0 > $sash1 - 20} {
879 set sash0 [expr {$sash1 - 20}]
883 $win sash place 0 $sash0 [lindex $s0 1]
884 $win sash place 1 $sash1 [lindex $s1 1]
886 set oldwidth($win) $w
889 proc resizecdetpanes {win w} {
890 global oldwidth
891 if {[info exists oldwidth($win)]} {
892 set s0 [$win sash coord 0]
893 if {$w < 60} {
894 set sash0 [expr {int($w*3/4 - 2)}]
895 } else {
896 set factor [expr {1.0 * $w / $oldwidth($win)}]
897 set sash0 [expr {int($factor * [lindex $s0 0])}]
898 if {$sash0 < 45} {
899 set sash0 45
901 if {$sash0 > $w - 15} {
902 set sash0 [expr {$w - 15}]
905 $win sash place 0 $sash0 [lindex $s0 1]
907 set oldwidth($win) $w
910 proc allcanvs args {
911 global canv canv2 canv3
912 eval $canv $args
913 eval $canv2 $args
914 eval $canv3 $args
917 proc bindall {event action} {
918 global canv canv2 canv3
919 bind $canv $event $action
920 bind $canv2 $event $action
921 bind $canv3 $event $action
924 proc about {} {
925 set w .about
926 if {[winfo exists $w]} {
927 raise $w
928 return
930 toplevel $w
931 wm title $w "About gitk"
932 message $w.m -text {
933 Gitk - a commit viewer for git
935 Copyright © 2005-2006 Paul Mackerras
937 Use and redistribute under the terms of the GNU General Public License} \
938 -justify center -aspect 400
939 pack $w.m -side top -fill x -padx 20 -pady 20
940 button $w.ok -text Close -command "destroy $w"
941 pack $w.ok -side bottom
944 proc keys {} {
945 set w .keys
946 if {[winfo exists $w]} {
947 raise $w
948 return
950 toplevel $w
951 wm title $w "Gitk key bindings"
952 message $w.m -text {
953 Gitk key bindings:
955 <Ctrl-Q> Quit
956 <Home> Move to first commit
957 <End> Move to last commit
958 <Up>, p, i Move up one commit
959 <Down>, n, k Move down one commit
960 <Left>, z, j Go back in history list
961 <Right>, x, l Go forward in history list
962 <PageUp> Move up one page in commit list
963 <PageDown> Move down one page in commit list
964 <Ctrl-Home> Scroll to top of commit list
965 <Ctrl-End> Scroll to bottom of commit list
966 <Ctrl-Up> Scroll commit list up one line
967 <Ctrl-Down> Scroll commit list down one line
968 <Ctrl-PageUp> Scroll commit list up one page
969 <Ctrl-PageDown> Scroll commit list down one page
970 <Shift-Up> Move to previous highlighted line
971 <Shift-Down> Move to next highlighted line
972 <Delete>, b Scroll diff view up one page
973 <Backspace> Scroll diff view up one page
974 <Space> Scroll diff view down one page
975 u Scroll diff view up 18 lines
976 d Scroll diff view down 18 lines
977 <Ctrl-F> Find
978 <Ctrl-G> Move to next find hit
979 <Return> Move to next find hit
980 / Move to next find hit, or redo find
981 ? Move to previous find hit
982 f Scroll diff view to next file
983 <Ctrl-S> Search for next hit in diff view
984 <Ctrl-R> Search for previous hit in diff view
985 <Ctrl-KP+> Increase font size
986 <Ctrl-plus> Increase font size
987 <Ctrl-KP-> Decrease font size
988 <Ctrl-minus> Decrease font size
990 -justify left -bg white -border 2 -relief sunken
991 pack $w.m -side top -fill both
992 button $w.ok -text Close -command "destroy $w"
993 pack $w.ok -side bottom
996 # Procedures for manipulating the file list window at the
997 # bottom right of the overall window.
999 proc treeview {w l openlevs} {
1000 global treecontents treediropen treeheight treeparent treeindex
1002 set ix 0
1003 set treeindex() 0
1004 set lev 0
1005 set prefix {}
1006 set prefixend -1
1007 set prefendstack {}
1008 set htstack {}
1009 set ht 0
1010 set treecontents() {}
1011 $w conf -state normal
1012 foreach f $l {
1013 while {[string range $f 0 $prefixend] ne $prefix} {
1014 if {$lev <= $openlevs} {
1015 $w mark set e:$treeindex($prefix) "end -1c"
1016 $w mark gravity e:$treeindex($prefix) left
1018 set treeheight($prefix) $ht
1019 incr ht [lindex $htstack end]
1020 set htstack [lreplace $htstack end end]
1021 set prefixend [lindex $prefendstack end]
1022 set prefendstack [lreplace $prefendstack end end]
1023 set prefix [string range $prefix 0 $prefixend]
1024 incr lev -1
1026 set tail [string range $f [expr {$prefixend+1}] end]
1027 while {[set slash [string first "/" $tail]] >= 0} {
1028 lappend htstack $ht
1029 set ht 0
1030 lappend prefendstack $prefixend
1031 incr prefixend [expr {$slash + 1}]
1032 set d [string range $tail 0 $slash]
1033 lappend treecontents($prefix) $d
1034 set oldprefix $prefix
1035 append prefix $d
1036 set treecontents($prefix) {}
1037 set treeindex($prefix) [incr ix]
1038 set treeparent($prefix) $oldprefix
1039 set tail [string range $tail [expr {$slash+1}] end]
1040 if {$lev <= $openlevs} {
1041 set ht 1
1042 set treediropen($prefix) [expr {$lev < $openlevs}]
1043 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1044 $w mark set d:$ix "end -1c"
1045 $w mark gravity d:$ix left
1046 set str "\n"
1047 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1048 $w insert end $str
1049 $w image create end -align center -image $bm -padx 1 \
1050 -name a:$ix
1051 $w insert end $d [highlight_tag $prefix]
1052 $w mark set s:$ix "end -1c"
1053 $w mark gravity s:$ix left
1055 incr lev
1057 if {$tail ne {}} {
1058 if {$lev <= $openlevs} {
1059 incr ht
1060 set str "\n"
1061 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1062 $w insert end $str
1063 $w insert end $tail [highlight_tag $f]
1065 lappend treecontents($prefix) $tail
1068 while {$htstack ne {}} {
1069 set treeheight($prefix) $ht
1070 incr ht [lindex $htstack end]
1071 set htstack [lreplace $htstack end end]
1073 $w conf -state disabled
1076 proc linetoelt {l} {
1077 global treeheight treecontents
1079 set y 2
1080 set prefix {}
1081 while {1} {
1082 foreach e $treecontents($prefix) {
1083 if {$y == $l} {
1084 return "$prefix$e"
1086 set n 1
1087 if {[string index $e end] eq "/"} {
1088 set n $treeheight($prefix$e)
1089 if {$y + $n > $l} {
1090 append prefix $e
1091 incr y
1092 break
1095 incr y $n
1100 proc highlight_tree {y prefix} {
1101 global treeheight treecontents cflist
1103 foreach e $treecontents($prefix) {
1104 set path $prefix$e
1105 if {[highlight_tag $path] ne {}} {
1106 $cflist tag add bold $y.0 "$y.0 lineend"
1108 incr y
1109 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1110 set y [highlight_tree $y $path]
1113 return $y
1116 proc treeclosedir {w dir} {
1117 global treediropen treeheight treeparent treeindex
1119 set ix $treeindex($dir)
1120 $w conf -state normal
1121 $w delete s:$ix e:$ix
1122 set treediropen($dir) 0
1123 $w image configure a:$ix -image tri-rt
1124 $w conf -state disabled
1125 set n [expr {1 - $treeheight($dir)}]
1126 while {$dir ne {}} {
1127 incr treeheight($dir) $n
1128 set dir $treeparent($dir)
1132 proc treeopendir {w dir} {
1133 global treediropen treeheight treeparent treecontents treeindex
1135 set ix $treeindex($dir)
1136 $w conf -state normal
1137 $w image configure a:$ix -image tri-dn
1138 $w mark set e:$ix s:$ix
1139 $w mark gravity e:$ix right
1140 set lev 0
1141 set str "\n"
1142 set n [llength $treecontents($dir)]
1143 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1144 incr lev
1145 append str "\t"
1146 incr treeheight($x) $n
1148 foreach e $treecontents($dir) {
1149 set de $dir$e
1150 if {[string index $e end] eq "/"} {
1151 set iy $treeindex($de)
1152 $w mark set d:$iy e:$ix
1153 $w mark gravity d:$iy left
1154 $w insert e:$ix $str
1155 set treediropen($de) 0
1156 $w image create e:$ix -align center -image tri-rt -padx 1 \
1157 -name a:$iy
1158 $w insert e:$ix $e [highlight_tag $de]
1159 $w mark set s:$iy e:$ix
1160 $w mark gravity s:$iy left
1161 set treeheight($de) 1
1162 } else {
1163 $w insert e:$ix $str
1164 $w insert e:$ix $e [highlight_tag $de]
1167 $w mark gravity e:$ix left
1168 $w conf -state disabled
1169 set treediropen($dir) 1
1170 set top [lindex [split [$w index @0,0] .] 0]
1171 set ht [$w cget -height]
1172 set l [lindex [split [$w index s:$ix] .] 0]
1173 if {$l < $top} {
1174 $w yview $l.0
1175 } elseif {$l + $n + 1 > $top + $ht} {
1176 set top [expr {$l + $n + 2 - $ht}]
1177 if {$l < $top} {
1178 set top $l
1180 $w yview $top.0
1184 proc treeclick {w x y} {
1185 global treediropen cmitmode ctext cflist cflist_top
1187 if {$cmitmode ne "tree"} return
1188 if {![info exists cflist_top]} return
1189 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1190 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1191 $cflist tag add highlight $l.0 "$l.0 lineend"
1192 set cflist_top $l
1193 if {$l == 1} {
1194 $ctext yview 1.0
1195 return
1197 set e [linetoelt $l]
1198 if {[string index $e end] ne "/"} {
1199 showfile $e
1200 } elseif {$treediropen($e)} {
1201 treeclosedir $w $e
1202 } else {
1203 treeopendir $w $e
1207 proc setfilelist {id} {
1208 global treefilelist cflist
1210 treeview $cflist $treefilelist($id) 0
1213 image create bitmap tri-rt -background black -foreground blue -data {
1214 #define tri-rt_width 13
1215 #define tri-rt_height 13
1216 static unsigned char tri-rt_bits[] = {
1217 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1218 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1219 0x00, 0x00};
1220 } -maskdata {
1221 #define tri-rt-mask_width 13
1222 #define tri-rt-mask_height 13
1223 static unsigned char tri-rt-mask_bits[] = {
1224 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1225 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1226 0x08, 0x00};
1228 image create bitmap tri-dn -background black -foreground blue -data {
1229 #define tri-dn_width 13
1230 #define tri-dn_height 13
1231 static unsigned char tri-dn_bits[] = {
1232 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1233 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1234 0x00, 0x00};
1235 } -maskdata {
1236 #define tri-dn-mask_width 13
1237 #define tri-dn-mask_height 13
1238 static unsigned char tri-dn-mask_bits[] = {
1239 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1240 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1241 0x00, 0x00};
1244 proc init_flist {first} {
1245 global cflist cflist_top selectedline difffilestart
1247 $cflist conf -state normal
1248 $cflist delete 0.0 end
1249 if {$first ne {}} {
1250 $cflist insert end $first
1251 set cflist_top 1
1252 $cflist tag add highlight 1.0 "1.0 lineend"
1253 } else {
1254 catch {unset cflist_top}
1256 $cflist conf -state disabled
1257 set difffilestart {}
1260 proc highlight_tag {f} {
1261 global highlight_paths
1263 foreach p $highlight_paths {
1264 if {[string match $p $f]} {
1265 return "bold"
1268 return {}
1271 proc highlight_filelist {} {
1272 global cmitmode cflist
1274 $cflist conf -state normal
1275 if {$cmitmode ne "tree"} {
1276 set end [lindex [split [$cflist index end] .] 0]
1277 for {set l 2} {$l < $end} {incr l} {
1278 set line [$cflist get $l.0 "$l.0 lineend"]
1279 if {[highlight_tag $line] ne {}} {
1280 $cflist tag add bold $l.0 "$l.0 lineend"
1283 } else {
1284 highlight_tree 2 {}
1286 $cflist conf -state disabled
1289 proc unhighlight_filelist {} {
1290 global cflist
1292 $cflist conf -state normal
1293 $cflist tag remove bold 1.0 end
1294 $cflist conf -state disabled
1297 proc add_flist {fl} {
1298 global cflist
1300 $cflist conf -state normal
1301 foreach f $fl {
1302 $cflist insert end "\n"
1303 $cflist insert end $f [highlight_tag $f]
1305 $cflist conf -state disabled
1308 proc sel_flist {w x y} {
1309 global ctext difffilestart cflist cflist_top cmitmode
1311 if {$cmitmode eq "tree"} return
1312 if {![info exists cflist_top]} return
1313 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1314 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1315 $cflist tag add highlight $l.0 "$l.0 lineend"
1316 set cflist_top $l
1317 if {$l == 1} {
1318 $ctext yview 1.0
1319 } else {
1320 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1324 # Functions for adding and removing shell-type quoting
1326 proc shellquote {str} {
1327 if {![string match "*\['\"\\ \t]*" $str]} {
1328 return $str
1330 if {![string match "*\['\"\\]*" $str]} {
1331 return "\"$str\""
1333 if {![string match "*'*" $str]} {
1334 return "'$str'"
1336 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1339 proc shellarglist {l} {
1340 set str {}
1341 foreach a $l {
1342 if {$str ne {}} {
1343 append str " "
1345 append str [shellquote $a]
1347 return $str
1350 proc shelldequote {str} {
1351 set ret {}
1352 set used -1
1353 while {1} {
1354 incr used
1355 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1356 append ret [string range $str $used end]
1357 set used [string length $str]
1358 break
1360 set first [lindex $first 0]
1361 set ch [string index $str $first]
1362 if {$first > $used} {
1363 append ret [string range $str $used [expr {$first - 1}]]
1364 set used $first
1366 if {$ch eq " " || $ch eq "\t"} break
1367 incr used
1368 if {$ch eq "'"} {
1369 set first [string first "'" $str $used]
1370 if {$first < 0} {
1371 error "unmatched single-quote"
1373 append ret [string range $str $used [expr {$first - 1}]]
1374 set used $first
1375 continue
1377 if {$ch eq "\\"} {
1378 if {$used >= [string length $str]} {
1379 error "trailing backslash"
1381 append ret [string index $str $used]
1382 continue
1384 # here ch == "\""
1385 while {1} {
1386 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1387 error "unmatched double-quote"
1389 set first [lindex $first 0]
1390 set ch [string index $str $first]
1391 if {$first > $used} {
1392 append ret [string range $str $used [expr {$first - 1}]]
1393 set used $first
1395 if {$ch eq "\""} break
1396 incr used
1397 append ret [string index $str $used]
1398 incr used
1401 return [list $used $ret]
1404 proc shellsplit {str} {
1405 set l {}
1406 while {1} {
1407 set str [string trimleft $str]
1408 if {$str eq {}} break
1409 set dq [shelldequote $str]
1410 set n [lindex $dq 0]
1411 set word [lindex $dq 1]
1412 set str [string range $str $n end]
1413 lappend l $word
1415 return $l
1418 # Code to implement multiple views
1420 proc newview {ishighlight} {
1421 global nextviewnum newviewname newviewperm uifont newishighlight
1422 global newviewargs revtreeargs
1424 set newishighlight $ishighlight
1425 set top .gitkview
1426 if {[winfo exists $top]} {
1427 raise $top
1428 return
1430 set newviewname($nextviewnum) "View $nextviewnum"
1431 set newviewperm($nextviewnum) 0
1432 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1433 vieweditor $top $nextviewnum "Gitk view definition"
1436 proc editview {} {
1437 global curview
1438 global viewname viewperm newviewname newviewperm
1439 global viewargs newviewargs
1441 set top .gitkvedit-$curview
1442 if {[winfo exists $top]} {
1443 raise $top
1444 return
1446 set newviewname($curview) $viewname($curview)
1447 set newviewperm($curview) $viewperm($curview)
1448 set newviewargs($curview) [shellarglist $viewargs($curview)]
1449 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1452 proc vieweditor {top n title} {
1453 global newviewname newviewperm viewfiles
1454 global uifont
1456 toplevel $top
1457 wm title $top $title
1458 label $top.nl -text "Name" -font $uifont
1459 entry $top.name -width 20 -textvariable newviewname($n)
1460 grid $top.nl $top.name -sticky w -pady 5
1461 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1462 grid $top.perm - -pady 5 -sticky w
1463 message $top.al -aspect 1000 -font $uifont \
1464 -text "Commits to include (arguments to git rev-list):"
1465 grid $top.al - -sticky w -pady 5
1466 entry $top.args -width 50 -textvariable newviewargs($n) \
1467 -background white
1468 grid $top.args - -sticky ew -padx 5
1469 message $top.l -aspect 1000 -font $uifont \
1470 -text "Enter files and directories to include, one per line:"
1471 grid $top.l - -sticky w
1472 text $top.t -width 40 -height 10 -background white
1473 if {[info exists viewfiles($n)]} {
1474 foreach f $viewfiles($n) {
1475 $top.t insert end $f
1476 $top.t insert end "\n"
1478 $top.t delete {end - 1c} end
1479 $top.t mark set insert 0.0
1481 grid $top.t - -sticky ew -padx 5
1482 frame $top.buts
1483 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1484 button $top.buts.can -text "Cancel" -command [list destroy $top]
1485 grid $top.buts.ok $top.buts.can
1486 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1487 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1488 grid $top.buts - -pady 10 -sticky ew
1489 focus $top.t
1492 proc doviewmenu {m first cmd op argv} {
1493 set nmenu [$m index end]
1494 for {set i $first} {$i <= $nmenu} {incr i} {
1495 if {[$m entrycget $i -command] eq $cmd} {
1496 eval $m $op $i $argv
1497 break
1502 proc allviewmenus {n op args} {
1503 global viewhlmenu
1505 doviewmenu .bar.view 5 [list showview $n] $op $args
1506 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1509 proc newviewok {top n} {
1510 global nextviewnum newviewperm newviewname newishighlight
1511 global viewname viewfiles viewperm selectedview curview
1512 global viewargs newviewargs viewhlmenu
1514 if {[catch {
1515 set newargs [shellsplit $newviewargs($n)]
1516 } err]} {
1517 error_popup "Error in commit selection arguments: $err"
1518 wm raise $top
1519 focus $top
1520 return
1522 set files {}
1523 foreach f [split [$top.t get 0.0 end] "\n"] {
1524 set ft [string trim $f]
1525 if {$ft ne {}} {
1526 lappend files $ft
1529 if {![info exists viewfiles($n)]} {
1530 # creating a new view
1531 incr nextviewnum
1532 set viewname($n) $newviewname($n)
1533 set viewperm($n) $newviewperm($n)
1534 set viewfiles($n) $files
1535 set viewargs($n) $newargs
1536 addviewmenu $n
1537 if {!$newishighlight} {
1538 after idle showview $n
1539 } else {
1540 after idle addvhighlight $n
1542 } else {
1543 # editing an existing view
1544 set viewperm($n) $newviewperm($n)
1545 if {$newviewname($n) ne $viewname($n)} {
1546 set viewname($n) $newviewname($n)
1547 doviewmenu .bar.view 5 [list showview $n] \
1548 entryconf [list -label $viewname($n)]
1549 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1550 entryconf [list -label $viewname($n) -value $viewname($n)]
1552 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1553 set viewfiles($n) $files
1554 set viewargs($n) $newargs
1555 if {$curview == $n} {
1556 after idle updatecommits
1560 catch {destroy $top}
1563 proc delview {} {
1564 global curview viewdata viewperm hlview selectedhlview
1566 if {$curview == 0} return
1567 if {[info exists hlview] && $hlview == $curview} {
1568 set selectedhlview None
1569 unset hlview
1571 allviewmenus $curview delete
1572 set viewdata($curview) {}
1573 set viewperm($curview) 0
1574 showview 0
1577 proc addviewmenu {n} {
1578 global viewname viewhlmenu
1580 .bar.view add radiobutton -label $viewname($n) \
1581 -command [list showview $n] -variable selectedview -value $n
1582 $viewhlmenu add radiobutton -label $viewname($n) \
1583 -command [list addvhighlight $n] -variable selectedhlview
1586 proc flatten {var} {
1587 global $var
1589 set ret {}
1590 foreach i [array names $var] {
1591 lappend ret $i [set $var\($i\)]
1593 return $ret
1596 proc unflatten {var l} {
1597 global $var
1599 catch {unset $var}
1600 foreach {i v} $l {
1601 set $var\($i\) $v
1605 proc showview {n} {
1606 global curview viewdata viewfiles
1607 global displayorder parentlist childlist rowidlist rowoffsets
1608 global colormap rowtextx commitrow nextcolor canvxmax
1609 global numcommits rowrangelist commitlisted idrowranges
1610 global selectedline currentid canv canvy0
1611 global matchinglines treediffs
1612 global pending_select phase
1613 global commitidx rowlaidout rowoptim linesegends
1614 global commfd nextupdate
1615 global selectedview
1616 global vparentlist vchildlist vdisporder vcmitlisted
1617 global hlview selectedhlview
1619 if {$n == $curview} return
1620 set selid {}
1621 if {[info exists selectedline]} {
1622 set selid $currentid
1623 set y [yc $selectedline]
1624 set ymax [lindex [$canv cget -scrollregion] 3]
1625 set span [$canv yview]
1626 set ytop [expr {[lindex $span 0] * $ymax}]
1627 set ybot [expr {[lindex $span 1] * $ymax}]
1628 if {$ytop < $y && $y < $ybot} {
1629 set yscreen [expr {$y - $ytop}]
1630 } else {
1631 set yscreen [expr {($ybot - $ytop) / 2}]
1634 unselectline
1635 normalline
1636 stopfindproc
1637 if {$curview >= 0} {
1638 set vparentlist($curview) $parentlist
1639 set vchildlist($curview) $childlist
1640 set vdisporder($curview) $displayorder
1641 set vcmitlisted($curview) $commitlisted
1642 if {$phase ne {}} {
1643 set viewdata($curview) \
1644 [list $phase $rowidlist $rowoffsets $rowrangelist \
1645 [flatten idrowranges] [flatten idinlist] \
1646 $rowlaidout $rowoptim $numcommits $linesegends]
1647 } elseif {![info exists viewdata($curview)]
1648 || [lindex $viewdata($curview) 0] ne {}} {
1649 set viewdata($curview) \
1650 [list {} $rowidlist $rowoffsets $rowrangelist]
1653 catch {unset matchinglines}
1654 catch {unset treediffs}
1655 clear_display
1656 if {[info exists hlview] && $hlview == $n} {
1657 unset hlview
1658 set selectedhlview None
1661 set curview $n
1662 set selectedview $n
1663 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1664 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1666 if {![info exists viewdata($n)]} {
1667 set pending_select $selid
1668 getcommits
1669 return
1672 set v $viewdata($n)
1673 set phase [lindex $v 0]
1674 set displayorder $vdisporder($n)
1675 set parentlist $vparentlist($n)
1676 set childlist $vchildlist($n)
1677 set commitlisted $vcmitlisted($n)
1678 set rowidlist [lindex $v 1]
1679 set rowoffsets [lindex $v 2]
1680 set rowrangelist [lindex $v 3]
1681 if {$phase eq {}} {
1682 set numcommits [llength $displayorder]
1683 catch {unset idrowranges}
1684 } else {
1685 unflatten idrowranges [lindex $v 4]
1686 unflatten idinlist [lindex $v 5]
1687 set rowlaidout [lindex $v 6]
1688 set rowoptim [lindex $v 7]
1689 set numcommits [lindex $v 8]
1690 set linesegends [lindex $v 9]
1693 catch {unset colormap}
1694 catch {unset rowtextx}
1695 set nextcolor 0
1696 set canvxmax [$canv cget -width]
1697 set curview $n
1698 set row 0
1699 setcanvscroll
1700 set yf 0
1701 set row 0
1702 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1703 set row $commitrow($n,$selid)
1704 # try to get the selected row in the same position on the screen
1705 set ymax [lindex [$canv cget -scrollregion] 3]
1706 set ytop [expr {[yc $row] - $yscreen}]
1707 if {$ytop < 0} {
1708 set ytop 0
1710 set yf [expr {$ytop * 1.0 / $ymax}]
1712 allcanvs yview moveto $yf
1713 drawvisible
1714 selectline $row 0
1715 if {$phase ne {}} {
1716 if {$phase eq "getcommits"} {
1717 show_status "Reading commits..."
1719 if {[info exists commfd($n)]} {
1720 layoutmore {}
1721 } else {
1722 finishcommits
1724 } elseif {$numcommits == 0} {
1725 show_status "No commits selected"
1729 # Stuff relating to the highlighting facility
1731 proc ishighlighted {row} {
1732 global vhighlights fhighlights nhighlights rhighlights
1734 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1735 return $nhighlights($row)
1737 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1738 return $vhighlights($row)
1740 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1741 return $fhighlights($row)
1743 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1744 return $rhighlights($row)
1746 return 0
1749 proc bolden {row font} {
1750 global canv linehtag selectedline boldrows
1752 lappend boldrows $row
1753 $canv itemconf $linehtag($row) -font $font
1754 if {[info exists selectedline] && $row == $selectedline} {
1755 $canv delete secsel
1756 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1757 -outline {{}} -tags secsel \
1758 -fill [$canv cget -selectbackground]]
1759 $canv lower $t
1763 proc bolden_name {row font} {
1764 global canv2 linentag selectedline boldnamerows
1766 lappend boldnamerows $row
1767 $canv2 itemconf $linentag($row) -font $font
1768 if {[info exists selectedline] && $row == $selectedline} {
1769 $canv2 delete secsel
1770 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1771 -outline {{}} -tags secsel \
1772 -fill [$canv2 cget -selectbackground]]
1773 $canv2 lower $t
1777 proc unbolden {} {
1778 global mainfont boldrows
1780 set stillbold {}
1781 foreach row $boldrows {
1782 if {![ishighlighted $row]} {
1783 bolden $row $mainfont
1784 } else {
1785 lappend stillbold $row
1788 set boldrows $stillbold
1791 proc addvhighlight {n} {
1792 global hlview curview viewdata vhl_done vhighlights commitidx
1794 if {[info exists hlview]} {
1795 delvhighlight
1797 set hlview $n
1798 if {$n != $curview && ![info exists viewdata($n)]} {
1799 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1800 set vparentlist($n) {}
1801 set vchildlist($n) {}
1802 set vdisporder($n) {}
1803 set vcmitlisted($n) {}
1804 start_rev_list $n
1806 set vhl_done $commitidx($hlview)
1807 if {$vhl_done > 0} {
1808 drawvisible
1812 proc delvhighlight {} {
1813 global hlview vhighlights
1815 if {![info exists hlview]} return
1816 unset hlview
1817 catch {unset vhighlights}
1818 unbolden
1821 proc vhighlightmore {} {
1822 global hlview vhl_done commitidx vhighlights
1823 global displayorder vdisporder curview mainfont
1825 set font [concat $mainfont bold]
1826 set max $commitidx($hlview)
1827 if {$hlview == $curview} {
1828 set disp $displayorder
1829 } else {
1830 set disp $vdisporder($hlview)
1832 set vr [visiblerows]
1833 set r0 [lindex $vr 0]
1834 set r1 [lindex $vr 1]
1835 for {set i $vhl_done} {$i < $max} {incr i} {
1836 set id [lindex $disp $i]
1837 if {[info exists commitrow($curview,$id)]} {
1838 set row $commitrow($curview,$id)
1839 if {$r0 <= $row && $row <= $r1} {
1840 if {![highlighted $row]} {
1841 bolden $row $font
1843 set vhighlights($row) 1
1847 set vhl_done $max
1850 proc askvhighlight {row id} {
1851 global hlview vhighlights commitrow iddrawn mainfont
1853 if {[info exists commitrow($hlview,$id)]} {
1854 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1855 bolden $row [concat $mainfont bold]
1857 set vhighlights($row) 1
1858 } else {
1859 set vhighlights($row) 0
1863 proc hfiles_change {name ix op} {
1864 global highlight_files filehighlight fhighlights fh_serial
1865 global mainfont highlight_paths
1867 if {[info exists filehighlight]} {
1868 # delete previous highlights
1869 catch {close $filehighlight}
1870 unset filehighlight
1871 catch {unset fhighlights}
1872 unbolden
1873 unhighlight_filelist
1875 set highlight_paths {}
1876 after cancel do_file_hl $fh_serial
1877 incr fh_serial
1878 if {$highlight_files ne {}} {
1879 after 300 do_file_hl $fh_serial
1883 proc makepatterns {l} {
1884 set ret {}
1885 foreach e $l {
1886 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1887 if {[string index $ee end] eq "/"} {
1888 lappend ret "$ee*"
1889 } else {
1890 lappend ret $ee
1891 lappend ret "$ee/*"
1894 return $ret
1897 proc do_file_hl {serial} {
1898 global highlight_files filehighlight highlight_paths gdttype fhl_list
1900 if {$gdttype eq "touching paths:"} {
1901 if {[catch {set paths [shellsplit $highlight_files]}]} return
1902 set highlight_paths [makepatterns $paths]
1903 highlight_filelist
1904 set gdtargs [concat -- $paths]
1905 } else {
1906 set gdtargs [list "-S$highlight_files"]
1908 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1909 set filehighlight [open $cmd r+]
1910 fconfigure $filehighlight -blocking 0
1911 fileevent $filehighlight readable readfhighlight
1912 set fhl_list {}
1913 drawvisible
1914 flushhighlights
1917 proc flushhighlights {} {
1918 global filehighlight fhl_list
1920 if {[info exists filehighlight]} {
1921 lappend fhl_list {}
1922 puts $filehighlight ""
1923 flush $filehighlight
1927 proc askfilehighlight {row id} {
1928 global filehighlight fhighlights fhl_list
1930 lappend fhl_list $id
1931 set fhighlights($row) -1
1932 puts $filehighlight $id
1935 proc readfhighlight {} {
1936 global filehighlight fhighlights commitrow curview mainfont iddrawn
1937 global fhl_list
1939 while {[gets $filehighlight line] >= 0} {
1940 set line [string trim $line]
1941 set i [lsearch -exact $fhl_list $line]
1942 if {$i < 0} continue
1943 for {set j 0} {$j < $i} {incr j} {
1944 set id [lindex $fhl_list $j]
1945 if {[info exists commitrow($curview,$id)]} {
1946 set fhighlights($commitrow($curview,$id)) 0
1949 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1950 if {$line eq {}} continue
1951 if {![info exists commitrow($curview,$line)]} continue
1952 set row $commitrow($curview,$line)
1953 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1954 bolden $row [concat $mainfont bold]
1956 set fhighlights($row) 1
1958 if {[eof $filehighlight]} {
1959 # strange...
1960 puts "oops, git-diff-tree died"
1961 catch {close $filehighlight}
1962 unset filehighlight
1964 next_hlcont
1967 proc find_change {name ix op} {
1968 global nhighlights mainfont boldnamerows
1969 global findstring findpattern findtype
1971 # delete previous highlights, if any
1972 foreach row $boldnamerows {
1973 bolden_name $row $mainfont
1975 set boldnamerows {}
1976 catch {unset nhighlights}
1977 unbolden
1978 if {$findtype ne "Regexp"} {
1979 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1980 $findstring]
1981 set findpattern "*$e*"
1983 drawvisible
1986 proc askfindhighlight {row id} {
1987 global nhighlights commitinfo iddrawn mainfont
1988 global findstring findtype findloc findpattern
1990 if {![info exists commitinfo($id)]} {
1991 getcommit $id
1993 set info $commitinfo($id)
1994 set isbold 0
1995 set fldtypes {Headline Author Date Committer CDate Comments}
1996 foreach f $info ty $fldtypes {
1997 if {$findloc ne "All fields" && $findloc ne $ty} {
1998 continue
2000 if {$findtype eq "Regexp"} {
2001 set doesmatch [regexp $findstring $f]
2002 } elseif {$findtype eq "IgnCase"} {
2003 set doesmatch [string match -nocase $findpattern $f]
2004 } else {
2005 set doesmatch [string match $findpattern $f]
2007 if {$doesmatch} {
2008 if {$ty eq "Author"} {
2009 set isbold 2
2010 } else {
2011 set isbold 1
2015 if {[info exists iddrawn($id)]} {
2016 if {$isbold && ![ishighlighted $row]} {
2017 bolden $row [concat $mainfont bold]
2019 if {$isbold >= 2} {
2020 bolden_name $row [concat $mainfont bold]
2023 set nhighlights($row) $isbold
2026 proc vrel_change {name ix op} {
2027 global highlight_related
2029 rhighlight_none
2030 if {$highlight_related ne "None"} {
2031 after idle drawvisible
2035 # prepare for testing whether commits are descendents or ancestors of a
2036 proc rhighlight_sel {a} {
2037 global descendent desc_todo ancestor anc_todo
2038 global highlight_related rhighlights
2040 catch {unset descendent}
2041 set desc_todo [list $a]
2042 catch {unset ancestor}
2043 set anc_todo [list $a]
2044 if {$highlight_related ne "None"} {
2045 rhighlight_none
2046 after idle drawvisible
2050 proc rhighlight_none {} {
2051 global rhighlights
2053 catch {unset rhighlights}
2054 unbolden
2057 proc is_descendent {a} {
2058 global curview children commitrow descendent desc_todo
2060 set v $curview
2061 set la $commitrow($v,$a)
2062 set todo $desc_todo
2063 set leftover {}
2064 set done 0
2065 for {set i 0} {$i < [llength $todo]} {incr i} {
2066 set do [lindex $todo $i]
2067 if {$commitrow($v,$do) < $la} {
2068 lappend leftover $do
2069 continue
2071 foreach nk $children($v,$do) {
2072 if {![info exists descendent($nk)]} {
2073 set descendent($nk) 1
2074 lappend todo $nk
2075 if {$nk eq $a} {
2076 set done 1
2080 if {$done} {
2081 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2082 return
2085 set descendent($a) 0
2086 set desc_todo $leftover
2089 proc is_ancestor {a} {
2090 global curview parentlist commitrow ancestor anc_todo
2092 set v $curview
2093 set la $commitrow($v,$a)
2094 set todo $anc_todo
2095 set leftover {}
2096 set done 0
2097 for {set i 0} {$i < [llength $todo]} {incr i} {
2098 set do [lindex $todo $i]
2099 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2100 lappend leftover $do
2101 continue
2103 foreach np [lindex $parentlist $commitrow($v,$do)] {
2104 if {![info exists ancestor($np)]} {
2105 set ancestor($np) 1
2106 lappend todo $np
2107 if {$np eq $a} {
2108 set done 1
2112 if {$done} {
2113 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2114 return
2117 set ancestor($a) 0
2118 set anc_todo $leftover
2121 proc askrelhighlight {row id} {
2122 global descendent highlight_related iddrawn mainfont rhighlights
2123 global selectedline ancestor
2125 if {![info exists selectedline]} return
2126 set isbold 0
2127 if {$highlight_related eq "Descendent" ||
2128 $highlight_related eq "Not descendent"} {
2129 if {![info exists descendent($id)]} {
2130 is_descendent $id
2132 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2133 set isbold 1
2135 } elseif {$highlight_related eq "Ancestor" ||
2136 $highlight_related eq "Not ancestor"} {
2137 if {![info exists ancestor($id)]} {
2138 is_ancestor $id
2140 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2141 set isbold 1
2144 if {[info exists iddrawn($id)]} {
2145 if {$isbold && ![ishighlighted $row]} {
2146 bolden $row [concat $mainfont bold]
2149 set rhighlights($row) $isbold
2152 proc next_hlcont {} {
2153 global fhl_row fhl_dirn displayorder numcommits
2154 global vhighlights fhighlights nhighlights rhighlights
2155 global hlview filehighlight findstring highlight_related
2157 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2158 set row $fhl_row
2159 while {1} {
2160 if {$row < 0 || $row >= $numcommits} {
2161 bell
2162 set fhl_dirn 0
2163 return
2165 set id [lindex $displayorder $row]
2166 if {[info exists hlview]} {
2167 if {![info exists vhighlights($row)]} {
2168 askvhighlight $row $id
2170 if {$vhighlights($row) > 0} break
2172 if {$findstring ne {}} {
2173 if {![info exists nhighlights($row)]} {
2174 askfindhighlight $row $id
2176 if {$nhighlights($row) > 0} break
2178 if {$highlight_related ne "None"} {
2179 if {![info exists rhighlights($row)]} {
2180 askrelhighlight $row $id
2182 if {$rhighlights($row) > 0} break
2184 if {[info exists filehighlight]} {
2185 if {![info exists fhighlights($row)]} {
2186 # ask for a few more while we're at it...
2187 set r $row
2188 for {set n 0} {$n < 100} {incr n} {
2189 if {![info exists fhighlights($r)]} {
2190 askfilehighlight $r [lindex $displayorder $r]
2192 incr r $fhl_dirn
2193 if {$r < 0 || $r >= $numcommits} break
2195 flushhighlights
2197 if {$fhighlights($row) < 0} {
2198 set fhl_row $row
2199 return
2201 if {$fhighlights($row) > 0} break
2203 incr row $fhl_dirn
2205 set fhl_dirn 0
2206 selectline $row 1
2209 proc next_highlight {dirn} {
2210 global selectedline fhl_row fhl_dirn
2211 global hlview filehighlight findstring highlight_related
2213 if {![info exists selectedline]} return
2214 if {!([info exists hlview] || $findstring ne {} ||
2215 $highlight_related ne "None" || [info exists filehighlight])} return
2216 set fhl_row [expr {$selectedline + $dirn}]
2217 set fhl_dirn $dirn
2218 next_hlcont
2221 proc cancel_next_highlight {} {
2222 global fhl_dirn
2224 set fhl_dirn 0
2227 # Graph layout functions
2229 proc shortids {ids} {
2230 set res {}
2231 foreach id $ids {
2232 if {[llength $id] > 1} {
2233 lappend res [shortids $id]
2234 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2235 lappend res [string range $id 0 7]
2236 } else {
2237 lappend res $id
2240 return $res
2243 proc incrange {l x o} {
2244 set n [llength $l]
2245 while {$x < $n} {
2246 set e [lindex $l $x]
2247 if {$e ne {}} {
2248 lset l $x [expr {$e + $o}]
2250 incr x
2252 return $l
2255 proc ntimes {n o} {
2256 set ret {}
2257 for {} {$n > 0} {incr n -1} {
2258 lappend ret $o
2260 return $ret
2263 proc usedinrange {id l1 l2} {
2264 global children commitrow childlist curview
2266 if {[info exists commitrow($curview,$id)]} {
2267 set r $commitrow($curview,$id)
2268 if {$l1 <= $r && $r <= $l2} {
2269 return [expr {$r - $l1 + 1}]
2271 set kids [lindex $childlist $r]
2272 } else {
2273 set kids $children($curview,$id)
2275 foreach c $kids {
2276 set r $commitrow($curview,$c)
2277 if {$l1 <= $r && $r <= $l2} {
2278 return [expr {$r - $l1 + 1}]
2281 return 0
2284 proc sanity {row {full 0}} {
2285 global rowidlist rowoffsets
2287 set col -1
2288 set ids [lindex $rowidlist $row]
2289 foreach id $ids {
2290 incr col
2291 if {$id eq {}} continue
2292 if {$col < [llength $ids] - 1 &&
2293 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2294 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2296 set o [lindex $rowoffsets $row $col]
2297 set y $row
2298 set x $col
2299 while {$o ne {}} {
2300 incr y -1
2301 incr x $o
2302 if {[lindex $rowidlist $y $x] != $id} {
2303 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2304 puts " id=[shortids $id] check started at row $row"
2305 for {set i $row} {$i >= $y} {incr i -1} {
2306 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2308 break
2310 if {!$full} break
2311 set o [lindex $rowoffsets $y $x]
2316 proc makeuparrow {oid x y z} {
2317 global rowidlist rowoffsets uparrowlen idrowranges
2319 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2320 incr y -1
2321 incr x $z
2322 set off0 [lindex $rowoffsets $y]
2323 for {set x0 $x} {1} {incr x0} {
2324 if {$x0 >= [llength $off0]} {
2325 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2326 break
2328 set z [lindex $off0 $x0]
2329 if {$z ne {}} {
2330 incr x0 $z
2331 break
2334 set z [expr {$x0 - $x}]
2335 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2336 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2338 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2339 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2340 lappend idrowranges($oid) $y
2343 proc initlayout {} {
2344 global rowidlist rowoffsets displayorder commitlisted
2345 global rowlaidout rowoptim
2346 global idinlist rowchk rowrangelist idrowranges
2347 global numcommits canvxmax canv
2348 global nextcolor
2349 global parentlist childlist children
2350 global colormap rowtextx
2351 global linesegends
2353 set numcommits 0
2354 set displayorder {}
2355 set commitlisted {}
2356 set parentlist {}
2357 set childlist {}
2358 set rowrangelist {}
2359 set nextcolor 0
2360 set rowidlist {{}}
2361 set rowoffsets {{}}
2362 catch {unset idinlist}
2363 catch {unset rowchk}
2364 set rowlaidout 0
2365 set rowoptim 0
2366 set canvxmax [$canv cget -width]
2367 catch {unset colormap}
2368 catch {unset rowtextx}
2369 catch {unset idrowranges}
2370 set linesegends {}
2373 proc setcanvscroll {} {
2374 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2376 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2377 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2378 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2379 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2382 proc visiblerows {} {
2383 global canv numcommits linespc
2385 set ymax [lindex [$canv cget -scrollregion] 3]
2386 if {$ymax eq {} || $ymax == 0} return
2387 set f [$canv yview]
2388 set y0 [expr {int([lindex $f 0] * $ymax)}]
2389 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2390 if {$r0 < 0} {
2391 set r0 0
2393 set y1 [expr {int([lindex $f 1] * $ymax)}]
2394 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2395 if {$r1 >= $numcommits} {
2396 set r1 [expr {$numcommits - 1}]
2398 return [list $r0 $r1]
2401 proc layoutmore {tmax} {
2402 global rowlaidout rowoptim commitidx numcommits optim_delay
2403 global uparrowlen curview
2405 while {1} {
2406 if {$rowoptim - $optim_delay > $numcommits} {
2407 showstuff [expr {$rowoptim - $optim_delay}]
2408 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2409 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2410 if {$nr > 100} {
2411 set nr 100
2413 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2414 incr rowoptim $nr
2415 } elseif {$commitidx($curview) > $rowlaidout} {
2416 set nr [expr {$commitidx($curview) - $rowlaidout}]
2417 # may need to increase this threshold if uparrowlen or
2418 # mingaplen are increased...
2419 if {$nr > 150} {
2420 set nr 150
2422 set row $rowlaidout
2423 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2424 if {$rowlaidout == $row} {
2425 return 0
2427 } else {
2428 return 0
2430 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2431 return 1
2436 proc showstuff {canshow} {
2437 global numcommits commitrow pending_select selectedline
2438 global linesegends idrowranges idrangedrawn curview
2440 if {$numcommits == 0} {
2441 global phase
2442 set phase "incrdraw"
2443 allcanvs delete all
2445 set row $numcommits
2446 set numcommits $canshow
2447 setcanvscroll
2448 set rows [visiblerows]
2449 set r0 [lindex $rows 0]
2450 set r1 [lindex $rows 1]
2451 set selrow -1
2452 for {set r $row} {$r < $canshow} {incr r} {
2453 foreach id [lindex $linesegends [expr {$r+1}]] {
2454 set i -1
2455 foreach {s e} [rowranges $id] {
2456 incr i
2457 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2458 && ![info exists idrangedrawn($id,$i)]} {
2459 drawlineseg $id $i
2460 set idrangedrawn($id,$i) 1
2465 if {$canshow > $r1} {
2466 set canshow $r1
2468 while {$row < $canshow} {
2469 drawcmitrow $row
2470 incr row
2472 if {[info exists pending_select] &&
2473 [info exists commitrow($curview,$pending_select)] &&
2474 $commitrow($curview,$pending_select) < $numcommits} {
2475 selectline $commitrow($curview,$pending_select) 1
2477 if {![info exists selectedline] && ![info exists pending_select]} {
2478 selectline 0 1
2482 proc layoutrows {row endrow last} {
2483 global rowidlist rowoffsets displayorder
2484 global uparrowlen downarrowlen maxwidth mingaplen
2485 global childlist parentlist
2486 global idrowranges linesegends
2487 global commitidx curview
2488 global idinlist rowchk rowrangelist
2490 set idlist [lindex $rowidlist $row]
2491 set offs [lindex $rowoffsets $row]
2492 while {$row < $endrow} {
2493 set id [lindex $displayorder $row]
2494 set oldolds {}
2495 set newolds {}
2496 foreach p [lindex $parentlist $row] {
2497 if {![info exists idinlist($p)]} {
2498 lappend newolds $p
2499 } elseif {!$idinlist($p)} {
2500 lappend oldolds $p
2503 set lse {}
2504 set nev [expr {[llength $idlist] + [llength $newolds]
2505 + [llength $oldolds] - $maxwidth + 1}]
2506 if {$nev > 0} {
2507 if {!$last &&
2508 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2509 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2510 set i [lindex $idlist $x]
2511 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2512 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2513 [expr {$row + $uparrowlen + $mingaplen}]]
2514 if {$r == 0} {
2515 set idlist [lreplace $idlist $x $x]
2516 set offs [lreplace $offs $x $x]
2517 set offs [incrange $offs $x 1]
2518 set idinlist($i) 0
2519 set rm1 [expr {$row - 1}]
2520 lappend lse $i
2521 lappend idrowranges($i) $rm1
2522 if {[incr nev -1] <= 0} break
2523 continue
2525 set rowchk($id) [expr {$row + $r}]
2528 lset rowidlist $row $idlist
2529 lset rowoffsets $row $offs
2531 lappend linesegends $lse
2532 set col [lsearch -exact $idlist $id]
2533 if {$col < 0} {
2534 set col [llength $idlist]
2535 lappend idlist $id
2536 lset rowidlist $row $idlist
2537 set z {}
2538 if {[lindex $childlist $row] ne {}} {
2539 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2540 unset idinlist($id)
2542 lappend offs $z
2543 lset rowoffsets $row $offs
2544 if {$z ne {}} {
2545 makeuparrow $id $col $row $z
2547 } else {
2548 unset idinlist($id)
2550 set ranges {}
2551 if {[info exists idrowranges($id)]} {
2552 set ranges $idrowranges($id)
2553 lappend ranges $row
2554 unset idrowranges($id)
2556 lappend rowrangelist $ranges
2557 incr row
2558 set offs [ntimes [llength $idlist] 0]
2559 set l [llength $newolds]
2560 set idlist [eval lreplace \$idlist $col $col $newolds]
2561 set o 0
2562 if {$l != 1} {
2563 set offs [lrange $offs 0 [expr {$col - 1}]]
2564 foreach x $newolds {
2565 lappend offs {}
2566 incr o -1
2568 incr o
2569 set tmp [expr {[llength $idlist] - [llength $offs]}]
2570 if {$tmp > 0} {
2571 set offs [concat $offs [ntimes $tmp $o]]
2573 } else {
2574 lset offs $col {}
2576 foreach i $newolds {
2577 set idinlist($i) 1
2578 set idrowranges($i) $row
2580 incr col $l
2581 foreach oid $oldolds {
2582 set idinlist($oid) 1
2583 set idlist [linsert $idlist $col $oid]
2584 set offs [linsert $offs $col $o]
2585 makeuparrow $oid $col $row $o
2586 incr col
2588 lappend rowidlist $idlist
2589 lappend rowoffsets $offs
2591 return $row
2594 proc addextraid {id row} {
2595 global displayorder commitrow commitinfo
2596 global commitidx commitlisted
2597 global parentlist childlist children curview
2599 incr commitidx($curview)
2600 lappend displayorder $id
2601 lappend commitlisted 0
2602 lappend parentlist {}
2603 set commitrow($curview,$id) $row
2604 readcommit $id
2605 if {![info exists commitinfo($id)]} {
2606 set commitinfo($id) {"No commit information available"}
2608 if {![info exists children($curview,$id)]} {
2609 set children($curview,$id) {}
2611 lappend childlist $children($curview,$id)
2614 proc layouttail {} {
2615 global rowidlist rowoffsets idinlist commitidx curview
2616 global idrowranges rowrangelist
2618 set row $commitidx($curview)
2619 set idlist [lindex $rowidlist $row]
2620 while {$idlist ne {}} {
2621 set col [expr {[llength $idlist] - 1}]
2622 set id [lindex $idlist $col]
2623 addextraid $id $row
2624 unset idinlist($id)
2625 lappend idrowranges($id) $row
2626 lappend rowrangelist $idrowranges($id)
2627 unset idrowranges($id)
2628 incr row
2629 set offs [ntimes $col 0]
2630 set idlist [lreplace $idlist $col $col]
2631 lappend rowidlist $idlist
2632 lappend rowoffsets $offs
2635 foreach id [array names idinlist] {
2636 addextraid $id $row
2637 lset rowidlist $row [list $id]
2638 lset rowoffsets $row 0
2639 makeuparrow $id 0 $row 0
2640 lappend idrowranges($id) $row
2641 lappend rowrangelist $idrowranges($id)
2642 unset idrowranges($id)
2643 incr row
2644 lappend rowidlist {}
2645 lappend rowoffsets {}
2649 proc insert_pad {row col npad} {
2650 global rowidlist rowoffsets
2652 set pad [ntimes $npad {}]
2653 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2654 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2655 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2658 proc optimize_rows {row col endrow} {
2659 global rowidlist rowoffsets idrowranges displayorder
2661 for {} {$row < $endrow} {incr row} {
2662 set idlist [lindex $rowidlist $row]
2663 set offs [lindex $rowoffsets $row]
2664 set haspad 0
2665 for {} {$col < [llength $offs]} {incr col} {
2666 if {[lindex $idlist $col] eq {}} {
2667 set haspad 1
2668 continue
2670 set z [lindex $offs $col]
2671 if {$z eq {}} continue
2672 set isarrow 0
2673 set x0 [expr {$col + $z}]
2674 set y0 [expr {$row - 1}]
2675 set z0 [lindex $rowoffsets $y0 $x0]
2676 if {$z0 eq {}} {
2677 set id [lindex $idlist $col]
2678 set ranges [rowranges $id]
2679 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2680 set isarrow 1
2683 if {$z < -1 || ($z < 0 && $isarrow)} {
2684 set npad [expr {-1 - $z + $isarrow}]
2685 set offs [incrange $offs $col $npad]
2686 insert_pad $y0 $x0 $npad
2687 if {$y0 > 0} {
2688 optimize_rows $y0 $x0 $row
2690 set z [lindex $offs $col]
2691 set x0 [expr {$col + $z}]
2692 set z0 [lindex $rowoffsets $y0 $x0]
2693 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2694 set npad [expr {$z - 1 + $isarrow}]
2695 set y1 [expr {$row + 1}]
2696 set offs2 [lindex $rowoffsets $y1]
2697 set x1 -1
2698 foreach z $offs2 {
2699 incr x1
2700 if {$z eq {} || $x1 + $z < $col} continue
2701 if {$x1 + $z > $col} {
2702 incr npad
2704 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2705 break
2707 set pad [ntimes $npad {}]
2708 set idlist [eval linsert \$idlist $col $pad]
2709 set tmp [eval linsert \$offs $col $pad]
2710 incr col $npad
2711 set offs [incrange $tmp $col [expr {-$npad}]]
2712 set z [lindex $offs $col]
2713 set haspad 1
2715 if {$z0 eq {} && !$isarrow} {
2716 # this line links to its first child on row $row-2
2717 set rm2 [expr {$row - 2}]
2718 set id [lindex $displayorder $rm2]
2719 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2720 if {$xc >= 0} {
2721 set z0 [expr {$xc - $x0}]
2724 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2725 insert_pad $y0 $x0 1
2726 set offs [incrange $offs $col 1]
2727 optimize_rows $y0 [expr {$x0 + 1}] $row
2730 if {!$haspad} {
2731 set o {}
2732 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2733 set o [lindex $offs $col]
2734 if {$o eq {}} {
2735 # check if this is the link to the first child
2736 set id [lindex $idlist $col]
2737 set ranges [rowranges $id]
2738 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2739 # it is, work out offset to child
2740 set y0 [expr {$row - 1}]
2741 set id [lindex $displayorder $y0]
2742 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2743 if {$x0 >= 0} {
2744 set o [expr {$x0 - $col}]
2748 if {$o eq {} || $o <= 0} break
2750 if {$o ne {} && [incr col] < [llength $idlist]} {
2751 set y1 [expr {$row + 1}]
2752 set offs2 [lindex $rowoffsets $y1]
2753 set x1 -1
2754 foreach z $offs2 {
2755 incr x1
2756 if {$z eq {} || $x1 + $z < $col} continue
2757 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2758 break
2760 set idlist [linsert $idlist $col {}]
2761 set tmp [linsert $offs $col {}]
2762 incr col
2763 set offs [incrange $tmp $col -1]
2766 lset rowidlist $row $idlist
2767 lset rowoffsets $row $offs
2768 set col 0
2772 proc xc {row col} {
2773 global canvx0 linespc
2774 return [expr {$canvx0 + $col * $linespc}]
2777 proc yc {row} {
2778 global canvy0 linespc
2779 return [expr {$canvy0 + $row * $linespc}]
2782 proc linewidth {id} {
2783 global thickerline lthickness
2785 set wid $lthickness
2786 if {[info exists thickerline] && $id eq $thickerline} {
2787 set wid [expr {2 * $lthickness}]
2789 return $wid
2792 proc rowranges {id} {
2793 global phase idrowranges commitrow rowlaidout rowrangelist curview
2795 set ranges {}
2796 if {$phase eq {} ||
2797 ([info exists commitrow($curview,$id)]
2798 && $commitrow($curview,$id) < $rowlaidout)} {
2799 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2800 } elseif {[info exists idrowranges($id)]} {
2801 set ranges $idrowranges($id)
2803 return $ranges
2806 proc drawlineseg {id i} {
2807 global rowoffsets rowidlist
2808 global displayorder
2809 global canv colormap linespc
2810 global numcommits commitrow curview
2812 set ranges [rowranges $id]
2813 set downarrow 1
2814 if {[info exists commitrow($curview,$id)]
2815 && $commitrow($curview,$id) < $numcommits} {
2816 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2817 } else {
2818 set downarrow 1
2820 set startrow [lindex $ranges [expr {2 * $i}]]
2821 set row [lindex $ranges [expr {2 * $i + 1}]]
2822 if {$startrow == $row} return
2823 assigncolor $id
2824 set coords {}
2825 set col [lsearch -exact [lindex $rowidlist $row] $id]
2826 if {$col < 0} {
2827 puts "oops: drawline: id $id not on row $row"
2828 return
2830 set lasto {}
2831 set ns 0
2832 while {1} {
2833 set o [lindex $rowoffsets $row $col]
2834 if {$o eq {}} break
2835 if {$o ne $lasto} {
2836 # changing direction
2837 set x [xc $row $col]
2838 set y [yc $row]
2839 lappend coords $x $y
2840 set lasto $o
2842 incr col $o
2843 incr row -1
2845 set x [xc $row $col]
2846 set y [yc $row]
2847 lappend coords $x $y
2848 if {$i == 0} {
2849 # draw the link to the first child as part of this line
2850 incr row -1
2851 set child [lindex $displayorder $row]
2852 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2853 if {$ccol >= 0} {
2854 set x [xc $row $ccol]
2855 set y [yc $row]
2856 if {$ccol < $col - 1} {
2857 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2858 } elseif {$ccol > $col + 1} {
2859 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2861 lappend coords $x $y
2864 if {[llength $coords] < 4} return
2865 if {$downarrow} {
2866 # This line has an arrow at the lower end: check if the arrow is
2867 # on a diagonal segment, and if so, work around the Tk 8.4
2868 # refusal to draw arrows on diagonal lines.
2869 set x0 [lindex $coords 0]
2870 set x1 [lindex $coords 2]
2871 if {$x0 != $x1} {
2872 set y0 [lindex $coords 1]
2873 set y1 [lindex $coords 3]
2874 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2875 # we have a nearby vertical segment, just trim off the diag bit
2876 set coords [lrange $coords 2 end]
2877 } else {
2878 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2879 set xi [expr {$x0 - $slope * $linespc / 2}]
2880 set yi [expr {$y0 - $linespc / 2}]
2881 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2885 set arrow [expr {2 * ($i > 0) + $downarrow}]
2886 set arrow [lindex {none first last both} $arrow]
2887 set t [$canv create line $coords -width [linewidth $id] \
2888 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2889 $canv lower $t
2890 bindline $t $id
2893 proc drawparentlinks {id row col olds} {
2894 global rowidlist canv colormap
2896 set row2 [expr {$row + 1}]
2897 set x [xc $row $col]
2898 set y [yc $row]
2899 set y2 [yc $row2]
2900 set ids [lindex $rowidlist $row2]
2901 # rmx = right-most X coord used
2902 set rmx 0
2903 foreach p $olds {
2904 set i [lsearch -exact $ids $p]
2905 if {$i < 0} {
2906 puts "oops, parent $p of $id not in list"
2907 continue
2909 set x2 [xc $row2 $i]
2910 if {$x2 > $rmx} {
2911 set rmx $x2
2913 set ranges [rowranges $p]
2914 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2915 && $row2 < [lindex $ranges 1]} {
2916 # drawlineseg will do this one for us
2917 continue
2919 assigncolor $p
2920 # should handle duplicated parents here...
2921 set coords [list $x $y]
2922 if {$i < $col - 1} {
2923 lappend coords [xc $row [expr {$i + 1}]] $y
2924 } elseif {$i > $col + 1} {
2925 lappend coords [xc $row [expr {$i - 1}]] $y
2927 lappend coords $x2 $y2
2928 set t [$canv create line $coords -width [linewidth $p] \
2929 -fill $colormap($p) -tags lines.$p]
2930 $canv lower $t
2931 bindline $t $p
2933 return $rmx
2936 proc drawlines {id} {
2937 global colormap canv
2938 global idrangedrawn
2939 global children iddrawn commitrow rowidlist curview
2941 $canv delete lines.$id
2942 set nr [expr {[llength [rowranges $id]] / 2}]
2943 for {set i 0} {$i < $nr} {incr i} {
2944 if {[info exists idrangedrawn($id,$i)]} {
2945 drawlineseg $id $i
2948 foreach child $children($curview,$id) {
2949 if {[info exists iddrawn($child)]} {
2950 set row $commitrow($curview,$child)
2951 set col [lsearch -exact [lindex $rowidlist $row] $child]
2952 if {$col >= 0} {
2953 drawparentlinks $child $row $col [list $id]
2959 proc drawcmittext {id row col rmx} {
2960 global linespc canv canv2 canv3 canvy0 fgcolor
2961 global commitlisted commitinfo rowidlist
2962 global rowtextx idpos idtags idheads idotherrefs
2963 global linehtag linentag linedtag
2964 global mainfont canvxmax boldrows boldnamerows fgcolor
2966 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2967 set x [xc $row $col]
2968 set y [yc $row]
2969 set orad [expr {$linespc / 3}]
2970 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2971 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2972 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2973 $canv raise $t
2974 $canv bind $t <1> {selcanvline {} %x %y}
2975 set xt [xc $row [llength [lindex $rowidlist $row]]]
2976 if {$xt < $rmx} {
2977 set xt $rmx
2979 set rowtextx($row) $xt
2980 set idpos($id) [list $x $xt $y]
2981 if {[info exists idtags($id)] || [info exists idheads($id)]
2982 || [info exists idotherrefs($id)]} {
2983 set xt [drawtags $id $x $xt $y]
2985 set headline [lindex $commitinfo($id) 0]
2986 set name [lindex $commitinfo($id) 1]
2987 set date [lindex $commitinfo($id) 2]
2988 set date [formatdate $date]
2989 set font $mainfont
2990 set nfont $mainfont
2991 set isbold [ishighlighted $row]
2992 if {$isbold > 0} {
2993 lappend boldrows $row
2994 lappend font bold
2995 if {$isbold > 1} {
2996 lappend boldnamerows $row
2997 lappend nfont bold
3000 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3001 -text $headline -font $font -tags text]
3002 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3003 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3004 -text $name -font $nfont -tags text]
3005 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3006 -text $date -font $mainfont -tags text]
3007 set xr [expr {$xt + [font measure $mainfont $headline]}]
3008 if {$xr > $canvxmax} {
3009 set canvxmax $xr
3010 setcanvscroll
3014 proc drawcmitrow {row} {
3015 global displayorder rowidlist
3016 global idrangedrawn iddrawn
3017 global commitinfo parentlist numcommits
3018 global filehighlight fhighlights findstring nhighlights
3019 global hlview vhighlights
3020 global highlight_related rhighlights
3022 if {$row >= $numcommits} return
3023 foreach id [lindex $rowidlist $row] {
3024 if {$id eq {}} continue
3025 set i -1
3026 foreach {s e} [rowranges $id] {
3027 incr i
3028 if {$row < $s} continue
3029 if {$e eq {}} break
3030 if {$row <= $e} {
3031 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3032 drawlineseg $id $i
3033 set idrangedrawn($id,$i) 1
3035 break
3040 set id [lindex $displayorder $row]
3041 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3042 askvhighlight $row $id
3044 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3045 askfilehighlight $row $id
3047 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3048 askfindhighlight $row $id
3050 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3051 askrelhighlight $row $id
3053 if {[info exists iddrawn($id)]} return
3054 set col [lsearch -exact [lindex $rowidlist $row] $id]
3055 if {$col < 0} {
3056 puts "oops, row $row id $id not in list"
3057 return
3059 if {![info exists commitinfo($id)]} {
3060 getcommit $id
3062 assigncolor $id
3063 set olds [lindex $parentlist $row]
3064 if {$olds ne {}} {
3065 set rmx [drawparentlinks $id $row $col $olds]
3066 } else {
3067 set rmx 0
3069 drawcmittext $id $row $col $rmx
3070 set iddrawn($id) 1
3073 proc drawfrac {f0 f1} {
3074 global numcommits canv
3075 global linespc
3077 set ymax [lindex [$canv cget -scrollregion] 3]
3078 if {$ymax eq {} || $ymax == 0} return
3079 set y0 [expr {int($f0 * $ymax)}]
3080 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3081 if {$row < 0} {
3082 set row 0
3084 set y1 [expr {int($f1 * $ymax)}]
3085 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3086 if {$endrow >= $numcommits} {
3087 set endrow [expr {$numcommits - 1}]
3089 for {} {$row <= $endrow} {incr row} {
3090 drawcmitrow $row
3094 proc drawvisible {} {
3095 global canv
3096 eval drawfrac [$canv yview]
3099 proc clear_display {} {
3100 global iddrawn idrangedrawn
3101 global vhighlights fhighlights nhighlights rhighlights
3103 allcanvs delete all
3104 catch {unset iddrawn}
3105 catch {unset idrangedrawn}
3106 catch {unset vhighlights}
3107 catch {unset fhighlights}
3108 catch {unset nhighlights}
3109 catch {unset rhighlights}
3112 proc findcrossings {id} {
3113 global rowidlist parentlist numcommits rowoffsets displayorder
3115 set cross {}
3116 set ccross {}
3117 foreach {s e} [rowranges $id] {
3118 if {$e >= $numcommits} {
3119 set e [expr {$numcommits - 1}]
3121 if {$e <= $s} continue
3122 set x [lsearch -exact [lindex $rowidlist $e] $id]
3123 if {$x < 0} {
3124 puts "findcrossings: oops, no [shortids $id] in row $e"
3125 continue
3127 for {set row $e} {[incr row -1] >= $s} {} {
3128 set olds [lindex $parentlist $row]
3129 set kid [lindex $displayorder $row]
3130 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3131 if {$kidx < 0} continue
3132 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3133 foreach p $olds {
3134 set px [lsearch -exact $nextrow $p]
3135 if {$px < 0} continue
3136 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3137 if {[lsearch -exact $ccross $p] >= 0} continue
3138 if {$x == $px + ($kidx < $px? -1: 1)} {
3139 lappend ccross $p
3140 } elseif {[lsearch -exact $cross $p] < 0} {
3141 lappend cross $p
3145 set inc [lindex $rowoffsets $row $x]
3146 if {$inc eq {}} break
3147 incr x $inc
3150 return [concat $ccross {{}} $cross]
3153 proc assigncolor {id} {
3154 global colormap colors nextcolor
3155 global commitrow parentlist children children curview
3157 if {[info exists colormap($id)]} return
3158 set ncolors [llength $colors]
3159 if {[info exists children($curview,$id)]} {
3160 set kids $children($curview,$id)
3161 } else {
3162 set kids {}
3164 if {[llength $kids] == 1} {
3165 set child [lindex $kids 0]
3166 if {[info exists colormap($child)]
3167 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3168 set colormap($id) $colormap($child)
3169 return
3172 set badcolors {}
3173 set origbad {}
3174 foreach x [findcrossings $id] {
3175 if {$x eq {}} {
3176 # delimiter between corner crossings and other crossings
3177 if {[llength $badcolors] >= $ncolors - 1} break
3178 set origbad $badcolors
3180 if {[info exists colormap($x)]
3181 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3182 lappend badcolors $colormap($x)
3185 if {[llength $badcolors] >= $ncolors} {
3186 set badcolors $origbad
3188 set origbad $badcolors
3189 if {[llength $badcolors] < $ncolors - 1} {
3190 foreach child $kids {
3191 if {[info exists colormap($child)]
3192 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3193 lappend badcolors $colormap($child)
3195 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3196 if {[info exists colormap($p)]
3197 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3198 lappend badcolors $colormap($p)
3202 if {[llength $badcolors] >= $ncolors} {
3203 set badcolors $origbad
3206 for {set i 0} {$i <= $ncolors} {incr i} {
3207 set c [lindex $colors $nextcolor]
3208 if {[incr nextcolor] >= $ncolors} {
3209 set nextcolor 0
3211 if {[lsearch -exact $badcolors $c]} break
3213 set colormap($id) $c
3216 proc bindline {t id} {
3217 global canv
3219 $canv bind $t <Enter> "lineenter %x %y $id"
3220 $canv bind $t <Motion> "linemotion %x %y $id"
3221 $canv bind $t <Leave> "lineleave $id"
3222 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3225 proc drawtags {id x xt y1} {
3226 global idtags idheads idotherrefs mainhead
3227 global linespc lthickness
3228 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3230 set marks {}
3231 set ntags 0
3232 set nheads 0
3233 if {[info exists idtags($id)]} {
3234 set marks $idtags($id)
3235 set ntags [llength $marks]
3237 if {[info exists idheads($id)]} {
3238 set marks [concat $marks $idheads($id)]
3239 set nheads [llength $idheads($id)]
3241 if {[info exists idotherrefs($id)]} {
3242 set marks [concat $marks $idotherrefs($id)]
3244 if {$marks eq {}} {
3245 return $xt
3248 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3249 set yt [expr {$y1 - 0.5 * $linespc}]
3250 set yb [expr {$yt + $linespc - 1}]
3251 set xvals {}
3252 set wvals {}
3253 set i -1
3254 foreach tag $marks {
3255 incr i
3256 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3257 set wid [font measure [concat $mainfont bold] $tag]
3258 } else {
3259 set wid [font measure $mainfont $tag]
3261 lappend xvals $xt
3262 lappend wvals $wid
3263 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3265 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3266 -width $lthickness -fill black -tags tag.$id]
3267 $canv lower $t
3268 foreach tag $marks x $xvals wid $wvals {
3269 set xl [expr {$x + $delta}]
3270 set xr [expr {$x + $delta + $wid + $lthickness}]
3271 set font $mainfont
3272 if {[incr ntags -1] >= 0} {
3273 # draw a tag
3274 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3275 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3276 -width 1 -outline black -fill yellow -tags tag.$id]
3277 $canv bind $t <1> [list showtag $tag 1]
3278 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3279 } else {
3280 # draw a head or other ref
3281 if {[incr nheads -1] >= 0} {
3282 set col green
3283 if {$tag eq $mainhead} {
3284 lappend font bold
3286 } else {
3287 set col "#ddddff"
3289 set xl [expr {$xl - $delta/2}]
3290 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3291 -width 1 -outline black -fill $col -tags tag.$id
3292 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3293 set rwid [font measure $mainfont $remoteprefix]
3294 set xi [expr {$x + 1}]
3295 set yti [expr {$yt + 1}]
3296 set xri [expr {$x + $rwid}]
3297 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3298 -width 0 -fill "#ffddaa" -tags tag.$id
3301 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3302 -font $font -tags [list tag.$id text]]
3303 if {$ntags >= 0} {
3304 $canv bind $t <1> [list showtag $tag 1]
3305 } elseif {$nheads >= 0} {
3306 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3309 return $xt
3312 proc xcoord {i level ln} {
3313 global canvx0 xspc1 xspc2
3315 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3316 if {$i > 0 && $i == $level} {
3317 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3318 } elseif {$i > $level} {
3319 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3321 return $x
3324 proc show_status {msg} {
3325 global canv mainfont fgcolor
3327 clear_display
3328 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3329 -tags text -fill $fgcolor
3332 proc finishcommits {} {
3333 global commitidx phase curview
3334 global pending_select
3336 if {$commitidx($curview) > 0} {
3337 drawrest
3338 } else {
3339 show_status "No commits selected"
3341 set phase {}
3342 catch {unset pending_select}
3345 # Insert a new commit as the child of the commit on row $row.
3346 # The new commit will be displayed on row $row and the commits
3347 # on that row and below will move down one row.
3348 proc insertrow {row newcmit} {
3349 global displayorder parentlist childlist commitlisted
3350 global commitrow curview rowidlist rowoffsets numcommits
3351 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3352 global linesegends selectedline
3354 if {$row >= $numcommits} {
3355 puts "oops, inserting new row $row but only have $numcommits rows"
3356 return
3358 set p [lindex $displayorder $row]
3359 set displayorder [linsert $displayorder $row $newcmit]
3360 set parentlist [linsert $parentlist $row $p]
3361 set kids [lindex $childlist $row]
3362 lappend kids $newcmit
3363 lset childlist $row $kids
3364 set childlist [linsert $childlist $row {}]
3365 set commitlisted [linsert $commitlisted $row 1]
3366 set l [llength $displayorder]
3367 for {set r $row} {$r < $l} {incr r} {
3368 set id [lindex $displayorder $r]
3369 set commitrow($curview,$id) $r
3372 set idlist [lindex $rowidlist $row]
3373 set offs [lindex $rowoffsets $row]
3374 set newoffs {}
3375 foreach x $idlist {
3376 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3377 lappend newoffs {}
3378 } else {
3379 lappend newoffs 0
3382 if {[llength $kids] == 1} {
3383 set col [lsearch -exact $idlist $p]
3384 lset idlist $col $newcmit
3385 } else {
3386 set col [llength $idlist]
3387 lappend idlist $newcmit
3388 lappend offs {}
3389 lset rowoffsets $row $offs
3391 set rowidlist [linsert $rowidlist $row $idlist]
3392 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3394 set rowrangelist [linsert $rowrangelist $row {}]
3395 set l [llength $rowrangelist]
3396 for {set r 0} {$r < $l} {incr r} {
3397 set ranges [lindex $rowrangelist $r]
3398 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3399 set newranges {}
3400 foreach x $ranges {
3401 if {$x >= $row} {
3402 lappend newranges [expr {$x + 1}]
3403 } else {
3404 lappend newranges $x
3407 lset rowrangelist $r $newranges
3410 if {[llength $kids] > 1} {
3411 set rp1 [expr {$row + 1}]
3412 set ranges [lindex $rowrangelist $rp1]
3413 if {$ranges eq {}} {
3414 set ranges [list $row $rp1]
3415 } elseif {[lindex $ranges end-1] == $rp1} {
3416 lset ranges end-1 $row
3418 lset rowrangelist $rp1 $ranges
3420 foreach id [array names idrowranges] {
3421 set ranges $idrowranges($id)
3422 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3423 set newranges {}
3424 foreach x $ranges {
3425 if {$x >= $row} {
3426 lappend newranges [expr {$x + 1}]
3427 } else {
3428 lappend newranges $x
3431 set idrowranges($id) $newranges
3435 set linesegends [linsert $linesegends $row {}]
3437 incr rowlaidout
3438 incr rowoptim
3439 incr numcommits
3441 if {[info exists selectedline] && $selectedline >= $row} {
3442 incr selectedline
3444 redisplay
3447 # Don't change the text pane cursor if it is currently the hand cursor,
3448 # showing that we are over a sha1 ID link.
3449 proc settextcursor {c} {
3450 global ctext curtextcursor
3452 if {[$ctext cget -cursor] == $curtextcursor} {
3453 $ctext config -cursor $c
3455 set curtextcursor $c
3458 proc nowbusy {what} {
3459 global isbusy
3461 if {[array names isbusy] eq {}} {
3462 . config -cursor watch
3463 settextcursor watch
3465 set isbusy($what) 1
3468 proc notbusy {what} {
3469 global isbusy maincursor textcursor
3471 catch {unset isbusy($what)}
3472 if {[array names isbusy] eq {}} {
3473 . config -cursor $maincursor
3474 settextcursor $textcursor
3478 proc drawrest {} {
3479 global startmsecs
3480 global rowlaidout commitidx curview
3481 global pending_select
3483 set row $rowlaidout
3484 layoutrows $rowlaidout $commitidx($curview) 1
3485 layouttail
3486 optimize_rows $row 0 $commitidx($curview)
3487 showstuff $commitidx($curview)
3488 if {[info exists pending_select]} {
3489 selectline 0 1
3492 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3493 #global numcommits
3494 #puts "overall $drawmsecs ms for $numcommits commits"
3497 proc findmatches {f} {
3498 global findtype foundstring foundstrlen
3499 if {$findtype == "Regexp"} {
3500 set matches [regexp -indices -all -inline $foundstring $f]
3501 } else {
3502 if {$findtype == "IgnCase"} {
3503 set str [string tolower $f]
3504 } else {
3505 set str $f
3507 set matches {}
3508 set i 0
3509 while {[set j [string first $foundstring $str $i]] >= 0} {
3510 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3511 set i [expr {$j + $foundstrlen}]
3514 return $matches
3517 proc dofind {} {
3518 global findtype findloc findstring markedmatches commitinfo
3519 global numcommits displayorder linehtag linentag linedtag
3520 global mainfont canv canv2 canv3 selectedline
3521 global matchinglines foundstring foundstrlen matchstring
3522 global commitdata
3524 stopfindproc
3525 unmarkmatches
3526 cancel_next_highlight
3527 focus .
3528 set matchinglines {}
3529 if {$findtype == "IgnCase"} {
3530 set foundstring [string tolower $findstring]
3531 } else {
3532 set foundstring $findstring
3534 set foundstrlen [string length $findstring]
3535 if {$foundstrlen == 0} return
3536 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3537 set matchstring "*$matchstring*"
3538 if {![info exists selectedline]} {
3539 set oldsel -1
3540 } else {
3541 set oldsel $selectedline
3543 set didsel 0
3544 set fldtypes {Headline Author Date Committer CDate Comments}
3545 set l -1
3546 foreach id $displayorder {
3547 set d $commitdata($id)
3548 incr l
3549 if {$findtype == "Regexp"} {
3550 set doesmatch [regexp $foundstring $d]
3551 } elseif {$findtype == "IgnCase"} {
3552 set doesmatch [string match -nocase $matchstring $d]
3553 } else {
3554 set doesmatch [string match $matchstring $d]
3556 if {!$doesmatch} continue
3557 if {![info exists commitinfo($id)]} {
3558 getcommit $id
3560 set info $commitinfo($id)
3561 set doesmatch 0
3562 foreach f $info ty $fldtypes {
3563 if {$findloc != "All fields" && $findloc != $ty} {
3564 continue
3566 set matches [findmatches $f]
3567 if {$matches == {}} continue
3568 set doesmatch 1
3569 if {$ty == "Headline"} {
3570 drawcmitrow $l
3571 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3572 } elseif {$ty == "Author"} {
3573 drawcmitrow $l
3574 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3575 } elseif {$ty == "Date"} {
3576 drawcmitrow $l
3577 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3580 if {$doesmatch} {
3581 lappend matchinglines $l
3582 if {!$didsel && $l > $oldsel} {
3583 findselectline $l
3584 set didsel 1
3588 if {$matchinglines == {}} {
3589 bell
3590 } elseif {!$didsel} {
3591 findselectline [lindex $matchinglines 0]
3595 proc findselectline {l} {
3596 global findloc commentend ctext
3597 selectline $l 1
3598 if {$findloc == "All fields" || $findloc == "Comments"} {
3599 # highlight the matches in the comments
3600 set f [$ctext get 1.0 $commentend]
3601 set matches [findmatches $f]
3602 foreach match $matches {
3603 set start [lindex $match 0]
3604 set end [expr {[lindex $match 1] + 1}]
3605 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3610 proc findnext {restart} {
3611 global matchinglines selectedline
3612 if {![info exists matchinglines]} {
3613 if {$restart} {
3614 dofind
3616 return
3618 if {![info exists selectedline]} return
3619 foreach l $matchinglines {
3620 if {$l > $selectedline} {
3621 findselectline $l
3622 return
3625 bell
3628 proc findprev {} {
3629 global matchinglines selectedline
3630 if {![info exists matchinglines]} {
3631 dofind
3632 return
3634 if {![info exists selectedline]} return
3635 set prev {}
3636 foreach l $matchinglines {
3637 if {$l >= $selectedline} break
3638 set prev $l
3640 if {$prev != {}} {
3641 findselectline $prev
3642 } else {
3643 bell
3647 proc stopfindproc {{done 0}} {
3648 global findprocpid findprocfile findids
3649 global ctext findoldcursor phase maincursor textcursor
3650 global findinprogress
3652 catch {unset findids}
3653 if {[info exists findprocpid]} {
3654 if {!$done} {
3655 catch {exec kill $findprocpid}
3657 catch {close $findprocfile}
3658 unset findprocpid
3660 catch {unset findinprogress}
3661 notbusy find
3664 # mark a commit as matching by putting a yellow background
3665 # behind the headline
3666 proc markheadline {l id} {
3667 global canv mainfont linehtag
3669 drawcmitrow $l
3670 set bbox [$canv bbox $linehtag($l)]
3671 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3672 $canv lower $t
3675 # mark the bits of a headline, author or date that match a find string
3676 proc markmatches {canv l str tag matches font} {
3677 set bbox [$canv bbox $tag]
3678 set x0 [lindex $bbox 0]
3679 set y0 [lindex $bbox 1]
3680 set y1 [lindex $bbox 3]
3681 foreach match $matches {
3682 set start [lindex $match 0]
3683 set end [lindex $match 1]
3684 if {$start > $end} continue
3685 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3686 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3687 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3688 [expr {$x0+$xlen+2}] $y1 \
3689 -outline {} -tags matches -fill yellow]
3690 $canv lower $t
3694 proc unmarkmatches {} {
3695 global matchinglines findids
3696 allcanvs delete matches
3697 catch {unset matchinglines}
3698 catch {unset findids}
3701 proc selcanvline {w x y} {
3702 global canv canvy0 ctext linespc
3703 global rowtextx
3704 set ymax [lindex [$canv cget -scrollregion] 3]
3705 if {$ymax == {}} return
3706 set yfrac [lindex [$canv yview] 0]
3707 set y [expr {$y + $yfrac * $ymax}]
3708 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3709 if {$l < 0} {
3710 set l 0
3712 if {$w eq $canv} {
3713 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3715 unmarkmatches
3716 selectline $l 1
3719 proc commit_descriptor {p} {
3720 global commitinfo
3721 if {![info exists commitinfo($p)]} {
3722 getcommit $p
3724 set l "..."
3725 if {[llength $commitinfo($p)] > 1} {
3726 set l [lindex $commitinfo($p) 0]
3728 return "$p ($l)\n"
3731 # append some text to the ctext widget, and make any SHA1 ID
3732 # that we know about be a clickable link.
3733 proc appendwithlinks {text tags} {
3734 global ctext commitrow linknum curview
3736 set start [$ctext index "end - 1c"]
3737 $ctext insert end $text $tags
3738 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3739 foreach l $links {
3740 set s [lindex $l 0]
3741 set e [lindex $l 1]
3742 set linkid [string range $text $s $e]
3743 if {![info exists commitrow($curview,$linkid)]} continue
3744 incr e
3745 $ctext tag add link "$start + $s c" "$start + $e c"
3746 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3747 $ctext tag bind link$linknum <1> \
3748 [list selectline $commitrow($curview,$linkid) 1]
3749 incr linknum
3751 $ctext tag conf link -foreground blue -underline 1
3752 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3753 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3756 proc viewnextline {dir} {
3757 global canv linespc
3759 $canv delete hover
3760 set ymax [lindex [$canv cget -scrollregion] 3]
3761 set wnow [$canv yview]
3762 set wtop [expr {[lindex $wnow 0] * $ymax}]
3763 set newtop [expr {$wtop + $dir * $linespc}]
3764 if {$newtop < 0} {
3765 set newtop 0
3766 } elseif {$newtop > $ymax} {
3767 set newtop $ymax
3769 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3772 # add a list of tag or branch names at position pos
3773 # returns the number of names inserted
3774 proc appendrefs {pos tags var} {
3775 global ctext commitrow linknum curview $var
3777 if {[catch {$ctext index $pos}]} {
3778 return 0
3780 set tags [lsort $tags]
3781 set sep {}
3782 foreach tag $tags {
3783 set id [set $var\($tag\)]
3784 set lk link$linknum
3785 incr linknum
3786 $ctext insert $pos $sep
3787 $ctext insert $pos $tag $lk
3788 $ctext tag conf $lk -foreground blue
3789 if {[info exists commitrow($curview,$id)]} {
3790 $ctext tag bind $lk <1> \
3791 [list selectline $commitrow($curview,$id) 1]
3792 $ctext tag conf $lk -underline 1
3793 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3794 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3796 set sep ", "
3798 return [llength $tags]
3801 proc taglist {ids} {
3802 global idtags
3804 set tags {}
3805 foreach id $ids {
3806 foreach tag $idtags($id) {
3807 lappend tags $tag
3810 return $tags
3813 # called when we have finished computing the nearby tags
3814 proc dispneartags {} {
3815 global selectedline currentid ctext anc_tags desc_tags showneartags
3816 global desc_heads
3818 if {![info exists selectedline] || !$showneartags} return
3819 set id $currentid
3820 $ctext conf -state normal
3821 if {[info exists desc_heads($id)]} {
3822 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3823 $ctext insert "branch -2c" "es"
3826 if {[info exists anc_tags($id)]} {
3827 appendrefs follows [taglist $anc_tags($id)] tagids
3829 if {[info exists desc_tags($id)]} {
3830 appendrefs precedes [taglist $desc_tags($id)] tagids
3832 $ctext conf -state disabled
3835 proc selectline {l isnew} {
3836 global canv canv2 canv3 ctext commitinfo selectedline
3837 global displayorder linehtag linentag linedtag
3838 global canvy0 linespc parentlist childlist
3839 global currentid sha1entry
3840 global commentend idtags linknum
3841 global mergemax numcommits pending_select
3842 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3844 catch {unset pending_select}
3845 $canv delete hover
3846 normalline
3847 cancel_next_highlight
3848 if {$l < 0 || $l >= $numcommits} return
3849 set y [expr {$canvy0 + $l * $linespc}]
3850 set ymax [lindex [$canv cget -scrollregion] 3]
3851 set ytop [expr {$y - $linespc - 1}]
3852 set ybot [expr {$y + $linespc + 1}]
3853 set wnow [$canv yview]
3854 set wtop [expr {[lindex $wnow 0] * $ymax}]
3855 set wbot [expr {[lindex $wnow 1] * $ymax}]
3856 set wh [expr {$wbot - $wtop}]
3857 set newtop $wtop
3858 if {$ytop < $wtop} {
3859 if {$ybot < $wtop} {
3860 set newtop [expr {$y - $wh / 2.0}]
3861 } else {
3862 set newtop $ytop
3863 if {$newtop > $wtop - $linespc} {
3864 set newtop [expr {$wtop - $linespc}]
3867 } elseif {$ybot > $wbot} {
3868 if {$ytop > $wbot} {
3869 set newtop [expr {$y - $wh / 2.0}]
3870 } else {
3871 set newtop [expr {$ybot - $wh}]
3872 if {$newtop < $wtop + $linespc} {
3873 set newtop [expr {$wtop + $linespc}]
3877 if {$newtop != $wtop} {
3878 if {$newtop < 0} {
3879 set newtop 0
3881 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3882 drawvisible
3885 if {![info exists linehtag($l)]} return
3886 $canv delete secsel
3887 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3888 -tags secsel -fill [$canv cget -selectbackground]]
3889 $canv lower $t
3890 $canv2 delete secsel
3891 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3892 -tags secsel -fill [$canv2 cget -selectbackground]]
3893 $canv2 lower $t
3894 $canv3 delete secsel
3895 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3896 -tags secsel -fill [$canv3 cget -selectbackground]]
3897 $canv3 lower $t
3899 if {$isnew} {
3900 addtohistory [list selectline $l 0]
3903 set selectedline $l
3905 set id [lindex $displayorder $l]
3906 set currentid $id
3907 $sha1entry delete 0 end
3908 $sha1entry insert 0 $id
3909 $sha1entry selection from 0
3910 $sha1entry selection to end
3911 rhighlight_sel $id
3913 $ctext conf -state normal
3914 clear_ctext
3915 set linknum 0
3916 set info $commitinfo($id)
3917 set date [formatdate [lindex $info 2]]
3918 $ctext insert end "Author: [lindex $info 1] $date\n"
3919 set date [formatdate [lindex $info 4]]
3920 $ctext insert end "Committer: [lindex $info 3] $date\n"
3921 if {[info exists idtags($id)]} {
3922 $ctext insert end "Tags:"
3923 foreach tag $idtags($id) {
3924 $ctext insert end " $tag"
3926 $ctext insert end "\n"
3929 set headers {}
3930 set olds [lindex $parentlist $l]
3931 if {[llength $olds] > 1} {
3932 set np 0
3933 foreach p $olds {
3934 if {$np >= $mergemax} {
3935 set tag mmax
3936 } else {
3937 set tag m$np
3939 $ctext insert end "Parent: " $tag
3940 appendwithlinks [commit_descriptor $p] {}
3941 incr np
3943 } else {
3944 foreach p $olds {
3945 append headers "Parent: [commit_descriptor $p]"
3949 foreach c [lindex $childlist $l] {
3950 append headers "Child: [commit_descriptor $c]"
3953 # make anything that looks like a SHA1 ID be a clickable link
3954 appendwithlinks $headers {}
3955 if {$showneartags} {
3956 if {![info exists allcommits]} {
3957 getallcommits
3959 $ctext insert end "Branch: "
3960 $ctext mark set branch "end -1c"
3961 $ctext mark gravity branch left
3962 if {[info exists desc_heads($id)]} {
3963 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3964 # turn "Branch" into "Branches"
3965 $ctext insert "branch -2c" "es"
3968 $ctext insert end "\nFollows: "
3969 $ctext mark set follows "end -1c"
3970 $ctext mark gravity follows left
3971 if {[info exists anc_tags($id)]} {
3972 appendrefs follows [taglist $anc_tags($id)] tagids
3974 $ctext insert end "\nPrecedes: "
3975 $ctext mark set precedes "end -1c"
3976 $ctext mark gravity precedes left
3977 if {[info exists desc_tags($id)]} {
3978 appendrefs precedes [taglist $desc_tags($id)] tagids
3980 $ctext insert end "\n"
3982 $ctext insert end "\n"
3983 appendwithlinks [lindex $info 5] {comment}
3985 $ctext tag delete Comments
3986 $ctext tag remove found 1.0 end
3987 $ctext conf -state disabled
3988 set commentend [$ctext index "end - 1c"]
3990 init_flist "Comments"
3991 if {$cmitmode eq "tree"} {
3992 gettree $id
3993 } elseif {[llength $olds] <= 1} {
3994 startdiff $id
3995 } else {
3996 mergediff $id $l
4000 proc selfirstline {} {
4001 unmarkmatches
4002 selectline 0 1
4005 proc sellastline {} {
4006 global numcommits
4007 unmarkmatches
4008 set l [expr {$numcommits - 1}]
4009 selectline $l 1
4012 proc selnextline {dir} {
4013 global selectedline
4014 if {![info exists selectedline]} return
4015 set l [expr {$selectedline + $dir}]
4016 unmarkmatches
4017 selectline $l 1
4020 proc selnextpage {dir} {
4021 global canv linespc selectedline numcommits
4023 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4024 if {$lpp < 1} {
4025 set lpp 1
4027 allcanvs yview scroll [expr {$dir * $lpp}] units
4028 drawvisible
4029 if {![info exists selectedline]} return
4030 set l [expr {$selectedline + $dir * $lpp}]
4031 if {$l < 0} {
4032 set l 0
4033 } elseif {$l >= $numcommits} {
4034 set l [expr $numcommits - 1]
4036 unmarkmatches
4037 selectline $l 1
4040 proc unselectline {} {
4041 global selectedline currentid
4043 catch {unset selectedline}
4044 catch {unset currentid}
4045 allcanvs delete secsel
4046 rhighlight_none
4047 cancel_next_highlight
4050 proc reselectline {} {
4051 global selectedline
4053 if {[info exists selectedline]} {
4054 selectline $selectedline 0
4058 proc addtohistory {cmd} {
4059 global history historyindex curview
4061 set elt [list $curview $cmd]
4062 if {$historyindex > 0
4063 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4064 return
4067 if {$historyindex < [llength $history]} {
4068 set history [lreplace $history $historyindex end $elt]
4069 } else {
4070 lappend history $elt
4072 incr historyindex
4073 if {$historyindex > 1} {
4074 .tf.bar.leftbut conf -state normal
4075 } else {
4076 .tf.bar.leftbut conf -state disabled
4078 .tf.bar.rightbut conf -state disabled
4081 proc godo {elt} {
4082 global curview
4084 set view [lindex $elt 0]
4085 set cmd [lindex $elt 1]
4086 if {$curview != $view} {
4087 showview $view
4089 eval $cmd
4092 proc goback {} {
4093 global history historyindex
4095 if {$historyindex > 1} {
4096 incr historyindex -1
4097 godo [lindex $history [expr {$historyindex - 1}]]
4098 .tf.bar.rightbut conf -state normal
4100 if {$historyindex <= 1} {
4101 .tf.bar.leftbut conf -state disabled
4105 proc goforw {} {
4106 global history historyindex
4108 if {$historyindex < [llength $history]} {
4109 set cmd [lindex $history $historyindex]
4110 incr historyindex
4111 godo $cmd
4112 .tf.bar.leftbut conf -state normal
4114 if {$historyindex >= [llength $history]} {
4115 .tf.bar.rightbut conf -state disabled
4119 proc gettree {id} {
4120 global treefilelist treeidlist diffids diffmergeid treepending
4122 set diffids $id
4123 catch {unset diffmergeid}
4124 if {![info exists treefilelist($id)]} {
4125 if {![info exists treepending]} {
4126 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4127 return
4129 set treepending $id
4130 set treefilelist($id) {}
4131 set treeidlist($id) {}
4132 fconfigure $gtf -blocking 0
4133 fileevent $gtf readable [list gettreeline $gtf $id]
4135 } else {
4136 setfilelist $id
4140 proc gettreeline {gtf id} {
4141 global treefilelist treeidlist treepending cmitmode diffids
4143 while {[gets $gtf line] >= 0} {
4144 if {[lindex $line 1] ne "blob"} continue
4145 set sha1 [lindex $line 2]
4146 set fname [lindex $line 3]
4147 lappend treefilelist($id) $fname
4148 lappend treeidlist($id) $sha1
4150 if {![eof $gtf]} return
4151 close $gtf
4152 unset treepending
4153 if {$cmitmode ne "tree"} {
4154 if {![info exists diffmergeid]} {
4155 gettreediffs $diffids
4157 } elseif {$id ne $diffids} {
4158 gettree $diffids
4159 } else {
4160 setfilelist $id
4164 proc showfile {f} {
4165 global treefilelist treeidlist diffids
4166 global ctext commentend
4168 set i [lsearch -exact $treefilelist($diffids) $f]
4169 if {$i < 0} {
4170 puts "oops, $f not in list for id $diffids"
4171 return
4173 set blob [lindex $treeidlist($diffids) $i]
4174 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4175 puts "oops, error reading blob $blob: $err"
4176 return
4178 fconfigure $bf -blocking 0
4179 fileevent $bf readable [list getblobline $bf $diffids]
4180 $ctext config -state normal
4181 clear_ctext $commentend
4182 $ctext insert end "\n"
4183 $ctext insert end "$f\n" filesep
4184 $ctext config -state disabled
4185 $ctext yview $commentend
4188 proc getblobline {bf id} {
4189 global diffids cmitmode ctext
4191 if {$id ne $diffids || $cmitmode ne "tree"} {
4192 catch {close $bf}
4193 return
4195 $ctext config -state normal
4196 while {[gets $bf line] >= 0} {
4197 $ctext insert end "$line\n"
4199 if {[eof $bf]} {
4200 # delete last newline
4201 $ctext delete "end - 2c" "end - 1c"
4202 close $bf
4204 $ctext config -state disabled
4207 proc mergediff {id l} {
4208 global diffmergeid diffopts mdifffd
4209 global diffids
4210 global parentlist
4212 set diffmergeid $id
4213 set diffids $id
4214 # this doesn't seem to actually affect anything...
4215 set env(GIT_DIFF_OPTS) $diffopts
4216 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4217 if {[catch {set mdf [open $cmd r]} err]} {
4218 error_popup "Error getting merge diffs: $err"
4219 return
4221 fconfigure $mdf -blocking 0
4222 set mdifffd($id) $mdf
4223 set np [llength [lindex $parentlist $l]]
4224 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4225 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4228 proc getmergediffline {mdf id np} {
4229 global diffmergeid ctext cflist nextupdate mergemax
4230 global difffilestart mdifffd
4232 set n [gets $mdf line]
4233 if {$n < 0} {
4234 if {[eof $mdf]} {
4235 close $mdf
4237 return
4239 if {![info exists diffmergeid] || $id != $diffmergeid
4240 || $mdf != $mdifffd($id)} {
4241 return
4243 $ctext conf -state normal
4244 if {[regexp {^diff --cc (.*)} $line match fname]} {
4245 # start of a new file
4246 $ctext insert end "\n"
4247 set here [$ctext index "end - 1c"]
4248 lappend difffilestart $here
4249 add_flist [list $fname]
4250 set l [expr {(78 - [string length $fname]) / 2}]
4251 set pad [string range "----------------------------------------" 1 $l]
4252 $ctext insert end "$pad $fname $pad\n" filesep
4253 } elseif {[regexp {^@@} $line]} {
4254 $ctext insert end "$line\n" hunksep
4255 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4256 # do nothing
4257 } else {
4258 # parse the prefix - one ' ', '-' or '+' for each parent
4259 set spaces {}
4260 set minuses {}
4261 set pluses {}
4262 set isbad 0
4263 for {set j 0} {$j < $np} {incr j} {
4264 set c [string range $line $j $j]
4265 if {$c == " "} {
4266 lappend spaces $j
4267 } elseif {$c == "-"} {
4268 lappend minuses $j
4269 } elseif {$c == "+"} {
4270 lappend pluses $j
4271 } else {
4272 set isbad 1
4273 break
4276 set tags {}
4277 set num {}
4278 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4279 # line doesn't appear in result, parents in $minuses have the line
4280 set num [lindex $minuses 0]
4281 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4282 # line appears in result, parents in $pluses don't have the line
4283 lappend tags mresult
4284 set num [lindex $spaces 0]
4286 if {$num ne {}} {
4287 if {$num >= $mergemax} {
4288 set num "max"
4290 lappend tags m$num
4292 $ctext insert end "$line\n" $tags
4294 $ctext conf -state disabled
4295 if {[clock clicks -milliseconds] >= $nextupdate} {
4296 incr nextupdate 100
4297 fileevent $mdf readable {}
4298 update
4299 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4303 proc startdiff {ids} {
4304 global treediffs diffids treepending diffmergeid
4306 set diffids $ids
4307 catch {unset diffmergeid}
4308 if {![info exists treediffs($ids)]} {
4309 if {![info exists treepending]} {
4310 gettreediffs $ids
4312 } else {
4313 addtocflist $ids
4317 proc addtocflist {ids} {
4318 global treediffs cflist
4319 add_flist $treediffs($ids)
4320 getblobdiffs $ids
4323 proc gettreediffs {ids} {
4324 global treediff treepending
4325 set treepending $ids
4326 set treediff {}
4327 if {[catch \
4328 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4329 ]} return
4330 fconfigure $gdtf -blocking 0
4331 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4334 proc gettreediffline {gdtf ids} {
4335 global treediff treediffs treepending diffids diffmergeid
4336 global cmitmode
4338 set n [gets $gdtf line]
4339 if {$n < 0} {
4340 if {![eof $gdtf]} return
4341 close $gdtf
4342 set treediffs($ids) $treediff
4343 unset treepending
4344 if {$cmitmode eq "tree"} {
4345 gettree $diffids
4346 } elseif {$ids != $diffids} {
4347 if {![info exists diffmergeid]} {
4348 gettreediffs $diffids
4350 } else {
4351 addtocflist $ids
4353 return
4355 set file [lindex $line 5]
4356 lappend treediff $file
4359 proc getblobdiffs {ids} {
4360 global diffopts blobdifffd diffids env curdifftag curtagstart
4361 global nextupdate diffinhdr treediffs
4363 set env(GIT_DIFF_OPTS) $diffopts
4364 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4365 if {[catch {set bdf [open $cmd r]} err]} {
4366 puts "error getting diffs: $err"
4367 return
4369 set diffinhdr 0
4370 fconfigure $bdf -blocking 0
4371 set blobdifffd($ids) $bdf
4372 set curdifftag Comments
4373 set curtagstart 0.0
4374 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4375 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4378 proc setinlist {var i val} {
4379 global $var
4381 while {[llength [set $var]] < $i} {
4382 lappend $var {}
4384 if {[llength [set $var]] == $i} {
4385 lappend $var $val
4386 } else {
4387 lset $var $i $val
4391 proc getblobdiffline {bdf ids} {
4392 global diffids blobdifffd ctext curdifftag curtagstart
4393 global diffnexthead diffnextnote difffilestart
4394 global nextupdate diffinhdr treediffs
4396 set n [gets $bdf line]
4397 if {$n < 0} {
4398 if {[eof $bdf]} {
4399 close $bdf
4400 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4401 $ctext tag add $curdifftag $curtagstart end
4404 return
4406 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4407 return
4409 $ctext conf -state normal
4410 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4411 # start of a new file
4412 $ctext insert end "\n"
4413 $ctext tag add $curdifftag $curtagstart end
4414 set here [$ctext index "end - 1c"]
4415 set curtagstart $here
4416 set header $newname
4417 set i [lsearch -exact $treediffs($ids) $fname]
4418 if {$i >= 0} {
4419 setinlist difffilestart $i $here
4421 if {$newname ne $fname} {
4422 set i [lsearch -exact $treediffs($ids) $newname]
4423 if {$i >= 0} {
4424 setinlist difffilestart $i $here
4427 set curdifftag "f:$fname"
4428 $ctext tag delete $curdifftag
4429 set l [expr {(78 - [string length $header]) / 2}]
4430 set pad [string range "----------------------------------------" 1 $l]
4431 $ctext insert end "$pad $header $pad\n" filesep
4432 set diffinhdr 1
4433 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4434 # do nothing
4435 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4436 set diffinhdr 0
4437 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4438 $line match f1l f1c f2l f2c rest]} {
4439 $ctext insert end "$line\n" hunksep
4440 set diffinhdr 0
4441 } else {
4442 set x [string range $line 0 0]
4443 if {$x == "-" || $x == "+"} {
4444 set tag [expr {$x == "+"}]
4445 $ctext insert end "$line\n" d$tag
4446 } elseif {$x == " "} {
4447 $ctext insert end "$line\n"
4448 } elseif {$diffinhdr || $x == "\\"} {
4449 # e.g. "\ No newline at end of file"
4450 $ctext insert end "$line\n" filesep
4451 } else {
4452 # Something else we don't recognize
4453 if {$curdifftag != "Comments"} {
4454 $ctext insert end "\n"
4455 $ctext tag add $curdifftag $curtagstart end
4456 set curtagstart [$ctext index "end - 1c"]
4457 set curdifftag Comments
4459 $ctext insert end "$line\n" filesep
4462 $ctext conf -state disabled
4463 if {[clock clicks -milliseconds] >= $nextupdate} {
4464 incr nextupdate 100
4465 fileevent $bdf readable {}
4466 update
4467 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4471 proc prevfile {} {
4472 global difffilestart ctext
4473 set prev [lindex $difffilestart 0]
4474 set here [$ctext index @0,0]
4475 foreach loc $difffilestart {
4476 if {[$ctext compare $loc >= $here]} {
4477 $ctext yview $prev
4478 return
4480 set prev $loc
4482 $ctext yview $prev
4485 proc nextfile {} {
4486 global difffilestart ctext
4487 set here [$ctext index @0,0]
4488 foreach loc $difffilestart {
4489 if {[$ctext compare $loc > $here]} {
4490 $ctext yview $loc
4491 return
4496 proc clear_ctext {{first 1.0}} {
4497 global ctext smarktop smarkbot
4499 set l [lindex [split $first .] 0]
4500 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4501 set smarktop $l
4503 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4504 set smarkbot $l
4506 $ctext delete $first end
4509 proc incrsearch {name ix op} {
4510 global ctext searchstring searchdirn
4512 $ctext tag remove found 1.0 end
4513 if {[catch {$ctext index anchor}]} {
4514 # no anchor set, use start of selection, or of visible area
4515 set sel [$ctext tag ranges sel]
4516 if {$sel ne {}} {
4517 $ctext mark set anchor [lindex $sel 0]
4518 } elseif {$searchdirn eq "-forwards"} {
4519 $ctext mark set anchor @0,0
4520 } else {
4521 $ctext mark set anchor @0,[winfo height $ctext]
4524 if {$searchstring ne {}} {
4525 set here [$ctext search $searchdirn -- $searchstring anchor]
4526 if {$here ne {}} {
4527 $ctext see $here
4529 searchmarkvisible 1
4533 proc dosearch {} {
4534 global sstring ctext searchstring searchdirn
4536 focus $sstring
4537 $sstring icursor end
4538 set searchdirn -forwards
4539 if {$searchstring ne {}} {
4540 set sel [$ctext tag ranges sel]
4541 if {$sel ne {}} {
4542 set start "[lindex $sel 0] + 1c"
4543 } elseif {[catch {set start [$ctext index anchor]}]} {
4544 set start "@0,0"
4546 set match [$ctext search -count mlen -- $searchstring $start]
4547 $ctext tag remove sel 1.0 end
4548 if {$match eq {}} {
4549 bell
4550 return
4552 $ctext see $match
4553 set mend "$match + $mlen c"
4554 $ctext tag add sel $match $mend
4555 $ctext mark unset anchor
4559 proc dosearchback {} {
4560 global sstring ctext searchstring searchdirn
4562 focus $sstring
4563 $sstring icursor end
4564 set searchdirn -backwards
4565 if {$searchstring ne {}} {
4566 set sel [$ctext tag ranges sel]
4567 if {$sel ne {}} {
4568 set start [lindex $sel 0]
4569 } elseif {[catch {set start [$ctext index anchor]}]} {
4570 set start @0,[winfo height $ctext]
4572 set match [$ctext search -backwards -count ml -- $searchstring $start]
4573 $ctext tag remove sel 1.0 end
4574 if {$match eq {}} {
4575 bell
4576 return
4578 $ctext see $match
4579 set mend "$match + $ml c"
4580 $ctext tag add sel $match $mend
4581 $ctext mark unset anchor
4585 proc searchmark {first last} {
4586 global ctext searchstring
4588 set mend $first.0
4589 while {1} {
4590 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4591 if {$match eq {}} break
4592 set mend "$match + $mlen c"
4593 $ctext tag add found $match $mend
4597 proc searchmarkvisible {doall} {
4598 global ctext smarktop smarkbot
4600 set topline [lindex [split [$ctext index @0,0] .] 0]
4601 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4602 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4603 # no overlap with previous
4604 searchmark $topline $botline
4605 set smarktop $topline
4606 set smarkbot $botline
4607 } else {
4608 if {$topline < $smarktop} {
4609 searchmark $topline [expr {$smarktop-1}]
4610 set smarktop $topline
4612 if {$botline > $smarkbot} {
4613 searchmark [expr {$smarkbot+1}] $botline
4614 set smarkbot $botline
4619 proc scrolltext {f0 f1} {
4620 global searchstring
4622 .bleft.sb set $f0 $f1
4623 if {$searchstring ne {}} {
4624 searchmarkvisible 0
4628 proc setcoords {} {
4629 global linespc charspc canvx0 canvy0 mainfont
4630 global xspc1 xspc2 lthickness
4632 set linespc [font metrics $mainfont -linespace]
4633 set charspc [font measure $mainfont "m"]
4634 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4635 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4636 set lthickness [expr {int($linespc / 9) + 1}]
4637 set xspc1(0) $linespc
4638 set xspc2 $linespc
4641 proc redisplay {} {
4642 global canv
4643 global selectedline
4645 set ymax [lindex [$canv cget -scrollregion] 3]
4646 if {$ymax eq {} || $ymax == 0} return
4647 set span [$canv yview]
4648 clear_display
4649 setcanvscroll
4650 allcanvs yview moveto [lindex $span 0]
4651 drawvisible
4652 if {[info exists selectedline]} {
4653 selectline $selectedline 0
4654 allcanvs yview moveto [lindex $span 0]
4658 proc incrfont {inc} {
4659 global mainfont textfont ctext canv phase
4660 global stopped entries
4661 unmarkmatches
4662 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4663 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4664 setcoords
4665 $ctext conf -font $textfont
4666 $ctext tag conf filesep -font [concat $textfont bold]
4667 foreach e $entries {
4668 $e conf -font $mainfont
4670 if {$phase eq "getcommits"} {
4671 $canv itemconf textitems -font $mainfont
4673 redisplay
4676 proc clearsha1 {} {
4677 global sha1entry sha1string
4678 if {[string length $sha1string] == 40} {
4679 $sha1entry delete 0 end
4683 proc sha1change {n1 n2 op} {
4684 global sha1string currentid sha1but
4685 if {$sha1string == {}
4686 || ([info exists currentid] && $sha1string == $currentid)} {
4687 set state disabled
4688 } else {
4689 set state normal
4691 if {[$sha1but cget -state] == $state} return
4692 if {$state == "normal"} {
4693 $sha1but conf -state normal -relief raised -text "Goto: "
4694 } else {
4695 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4699 proc gotocommit {} {
4700 global sha1string currentid commitrow tagids headids
4701 global displayorder numcommits curview
4703 if {$sha1string == {}
4704 || ([info exists currentid] && $sha1string == $currentid)} return
4705 if {[info exists tagids($sha1string)]} {
4706 set id $tagids($sha1string)
4707 } elseif {[info exists headids($sha1string)]} {
4708 set id $headids($sha1string)
4709 } else {
4710 set id [string tolower $sha1string]
4711 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4712 set matches {}
4713 foreach i $displayorder {
4714 if {[string match $id* $i]} {
4715 lappend matches $i
4718 if {$matches ne {}} {
4719 if {[llength $matches] > 1} {
4720 error_popup "Short SHA1 id $id is ambiguous"
4721 return
4723 set id [lindex $matches 0]
4727 if {[info exists commitrow($curview,$id)]} {
4728 selectline $commitrow($curview,$id) 1
4729 return
4731 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4732 set type "SHA1 id"
4733 } else {
4734 set type "Tag/Head"
4736 error_popup "$type $sha1string is not known"
4739 proc lineenter {x y id} {
4740 global hoverx hovery hoverid hovertimer
4741 global commitinfo canv
4743 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4744 set hoverx $x
4745 set hovery $y
4746 set hoverid $id
4747 if {[info exists hovertimer]} {
4748 after cancel $hovertimer
4750 set hovertimer [after 500 linehover]
4751 $canv delete hover
4754 proc linemotion {x y id} {
4755 global hoverx hovery hoverid hovertimer
4757 if {[info exists hoverid] && $id == $hoverid} {
4758 set hoverx $x
4759 set hovery $y
4760 if {[info exists hovertimer]} {
4761 after cancel $hovertimer
4763 set hovertimer [after 500 linehover]
4767 proc lineleave {id} {
4768 global hoverid hovertimer canv
4770 if {[info exists hoverid] && $id == $hoverid} {
4771 $canv delete hover
4772 if {[info exists hovertimer]} {
4773 after cancel $hovertimer
4774 unset hovertimer
4776 unset hoverid
4780 proc linehover {} {
4781 global hoverx hovery hoverid hovertimer
4782 global canv linespc lthickness
4783 global commitinfo mainfont
4785 set text [lindex $commitinfo($hoverid) 0]
4786 set ymax [lindex [$canv cget -scrollregion] 3]
4787 if {$ymax == {}} return
4788 set yfrac [lindex [$canv yview] 0]
4789 set x [expr {$hoverx + 2 * $linespc}]
4790 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4791 set x0 [expr {$x - 2 * $lthickness}]
4792 set y0 [expr {$y - 2 * $lthickness}]
4793 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4794 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4795 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4796 -fill \#ffff80 -outline black -width 1 -tags hover]
4797 $canv raise $t
4798 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4799 -font $mainfont]
4800 $canv raise $t
4803 proc clickisonarrow {id y} {
4804 global lthickness
4806 set ranges [rowranges $id]
4807 set thresh [expr {2 * $lthickness + 6}]
4808 set n [expr {[llength $ranges] - 1}]
4809 for {set i 1} {$i < $n} {incr i} {
4810 set row [lindex $ranges $i]
4811 if {abs([yc $row] - $y) < $thresh} {
4812 return $i
4815 return {}
4818 proc arrowjump {id n y} {
4819 global canv
4821 # 1 <-> 2, 3 <-> 4, etc...
4822 set n [expr {(($n - 1) ^ 1) + 1}]
4823 set row [lindex [rowranges $id] $n]
4824 set yt [yc $row]
4825 set ymax [lindex [$canv cget -scrollregion] 3]
4826 if {$ymax eq {} || $ymax <= 0} return
4827 set view [$canv yview]
4828 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4829 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4830 if {$yfrac < 0} {
4831 set yfrac 0
4833 allcanvs yview moveto $yfrac
4836 proc lineclick {x y id isnew} {
4837 global ctext commitinfo children canv thickerline curview
4839 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4840 unmarkmatches
4841 unselectline
4842 normalline
4843 $canv delete hover
4844 # draw this line thicker than normal
4845 set thickerline $id
4846 drawlines $id
4847 if {$isnew} {
4848 set ymax [lindex [$canv cget -scrollregion] 3]
4849 if {$ymax eq {}} return
4850 set yfrac [lindex [$canv yview] 0]
4851 set y [expr {$y + $yfrac * $ymax}]
4853 set dirn [clickisonarrow $id $y]
4854 if {$dirn ne {}} {
4855 arrowjump $id $dirn $y
4856 return
4859 if {$isnew} {
4860 addtohistory [list lineclick $x $y $id 0]
4862 # fill the details pane with info about this line
4863 $ctext conf -state normal
4864 clear_ctext
4865 $ctext tag conf link -foreground blue -underline 1
4866 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4867 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4868 $ctext insert end "Parent:\t"
4869 $ctext insert end $id [list link link0]
4870 $ctext tag bind link0 <1> [list selbyid $id]
4871 set info $commitinfo($id)
4872 $ctext insert end "\n\t[lindex $info 0]\n"
4873 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4874 set date [formatdate [lindex $info 2]]
4875 $ctext insert end "\tDate:\t$date\n"
4876 set kids $children($curview,$id)
4877 if {$kids ne {}} {
4878 $ctext insert end "\nChildren:"
4879 set i 0
4880 foreach child $kids {
4881 incr i
4882 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4883 set info $commitinfo($child)
4884 $ctext insert end "\n\t"
4885 $ctext insert end $child [list link link$i]
4886 $ctext tag bind link$i <1> [list selbyid $child]
4887 $ctext insert end "\n\t[lindex $info 0]"
4888 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4889 set date [formatdate [lindex $info 2]]
4890 $ctext insert end "\n\tDate:\t$date\n"
4893 $ctext conf -state disabled
4894 init_flist {}
4897 proc normalline {} {
4898 global thickerline
4899 if {[info exists thickerline]} {
4900 set id $thickerline
4901 unset thickerline
4902 drawlines $id
4906 proc selbyid {id} {
4907 global commitrow curview
4908 if {[info exists commitrow($curview,$id)]} {
4909 selectline $commitrow($curview,$id) 1
4913 proc mstime {} {
4914 global startmstime
4915 if {![info exists startmstime]} {
4916 set startmstime [clock clicks -milliseconds]
4918 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4921 proc rowmenu {x y id} {
4922 global rowctxmenu commitrow selectedline rowmenuid curview
4924 if {![info exists selectedline]
4925 || $commitrow($curview,$id) eq $selectedline} {
4926 set state disabled
4927 } else {
4928 set state normal
4930 $rowctxmenu entryconfigure "Diff this*" -state $state
4931 $rowctxmenu entryconfigure "Diff selected*" -state $state
4932 $rowctxmenu entryconfigure "Make patch" -state $state
4933 set rowmenuid $id
4934 tk_popup $rowctxmenu $x $y
4937 proc diffvssel {dirn} {
4938 global rowmenuid selectedline displayorder
4940 if {![info exists selectedline]} return
4941 if {$dirn} {
4942 set oldid [lindex $displayorder $selectedline]
4943 set newid $rowmenuid
4944 } else {
4945 set oldid $rowmenuid
4946 set newid [lindex $displayorder $selectedline]
4948 addtohistory [list doseldiff $oldid $newid]
4949 doseldiff $oldid $newid
4952 proc doseldiff {oldid newid} {
4953 global ctext
4954 global commitinfo
4956 $ctext conf -state normal
4957 clear_ctext
4958 init_flist "Top"
4959 $ctext insert end "From "
4960 $ctext tag conf link -foreground blue -underline 1
4961 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4962 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4963 $ctext tag bind link0 <1> [list selbyid $oldid]
4964 $ctext insert end $oldid [list link link0]
4965 $ctext insert end "\n "
4966 $ctext insert end [lindex $commitinfo($oldid) 0]
4967 $ctext insert end "\n\nTo "
4968 $ctext tag bind link1 <1> [list selbyid $newid]
4969 $ctext insert end $newid [list link link1]
4970 $ctext insert end "\n "
4971 $ctext insert end [lindex $commitinfo($newid) 0]
4972 $ctext insert end "\n"
4973 $ctext conf -state disabled
4974 $ctext tag delete Comments
4975 $ctext tag remove found 1.0 end
4976 startdiff [list $oldid $newid]
4979 proc mkpatch {} {
4980 global rowmenuid currentid commitinfo patchtop patchnum
4982 if {![info exists currentid]} return
4983 set oldid $currentid
4984 set oldhead [lindex $commitinfo($oldid) 0]
4985 set newid $rowmenuid
4986 set newhead [lindex $commitinfo($newid) 0]
4987 set top .patch
4988 set patchtop $top
4989 catch {destroy $top}
4990 toplevel $top
4991 label $top.title -text "Generate patch"
4992 grid $top.title - -pady 10
4993 label $top.from -text "From:"
4994 entry $top.fromsha1 -width 40 -relief flat
4995 $top.fromsha1 insert 0 $oldid
4996 $top.fromsha1 conf -state readonly
4997 grid $top.from $top.fromsha1 -sticky w
4998 entry $top.fromhead -width 60 -relief flat
4999 $top.fromhead insert 0 $oldhead
5000 $top.fromhead conf -state readonly
5001 grid x $top.fromhead -sticky w
5002 label $top.to -text "To:"
5003 entry $top.tosha1 -width 40 -relief flat
5004 $top.tosha1 insert 0 $newid
5005 $top.tosha1 conf -state readonly
5006 grid $top.to $top.tosha1 -sticky w
5007 entry $top.tohead -width 60 -relief flat
5008 $top.tohead insert 0 $newhead
5009 $top.tohead conf -state readonly
5010 grid x $top.tohead -sticky w
5011 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5012 grid $top.rev x -pady 10
5013 label $top.flab -text "Output file:"
5014 entry $top.fname -width 60
5015 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5016 incr patchnum
5017 grid $top.flab $top.fname -sticky w
5018 frame $top.buts
5019 button $top.buts.gen -text "Generate" -command mkpatchgo
5020 button $top.buts.can -text "Cancel" -command mkpatchcan
5021 grid $top.buts.gen $top.buts.can
5022 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5023 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5024 grid $top.buts - -pady 10 -sticky ew
5025 focus $top.fname
5028 proc mkpatchrev {} {
5029 global patchtop
5031 set oldid [$patchtop.fromsha1 get]
5032 set oldhead [$patchtop.fromhead get]
5033 set newid [$patchtop.tosha1 get]
5034 set newhead [$patchtop.tohead get]
5035 foreach e [list fromsha1 fromhead tosha1 tohead] \
5036 v [list $newid $newhead $oldid $oldhead] {
5037 $patchtop.$e conf -state normal
5038 $patchtop.$e delete 0 end
5039 $patchtop.$e insert 0 $v
5040 $patchtop.$e conf -state readonly
5044 proc mkpatchgo {} {
5045 global patchtop
5047 set oldid [$patchtop.fromsha1 get]
5048 set newid [$patchtop.tosha1 get]
5049 set fname [$patchtop.fname get]
5050 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5051 error_popup "Error creating patch: $err"
5053 catch {destroy $patchtop}
5054 unset patchtop
5057 proc mkpatchcan {} {
5058 global patchtop
5060 catch {destroy $patchtop}
5061 unset patchtop
5064 proc mktag {} {
5065 global rowmenuid mktagtop commitinfo
5067 set top .maketag
5068 set mktagtop $top
5069 catch {destroy $top}
5070 toplevel $top
5071 label $top.title -text "Create tag"
5072 grid $top.title - -pady 10
5073 label $top.id -text "ID:"
5074 entry $top.sha1 -width 40 -relief flat
5075 $top.sha1 insert 0 $rowmenuid
5076 $top.sha1 conf -state readonly
5077 grid $top.id $top.sha1 -sticky w
5078 entry $top.head -width 60 -relief flat
5079 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5080 $top.head conf -state readonly
5081 grid x $top.head -sticky w
5082 label $top.tlab -text "Tag name:"
5083 entry $top.tag -width 60
5084 grid $top.tlab $top.tag -sticky w
5085 frame $top.buts
5086 button $top.buts.gen -text "Create" -command mktaggo
5087 button $top.buts.can -text "Cancel" -command mktagcan
5088 grid $top.buts.gen $top.buts.can
5089 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5090 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5091 grid $top.buts - -pady 10 -sticky ew
5092 focus $top.tag
5095 proc domktag {} {
5096 global mktagtop env tagids idtags
5098 set id [$mktagtop.sha1 get]
5099 set tag [$mktagtop.tag get]
5100 if {$tag == {}} {
5101 error_popup "No tag name specified"
5102 return
5104 if {[info exists tagids($tag)]} {
5105 error_popup "Tag \"$tag\" already exists"
5106 return
5108 if {[catch {
5109 set dir [gitdir]
5110 set fname [file join $dir "refs/tags" $tag]
5111 set f [open $fname w]
5112 puts $f $id
5113 close $f
5114 } err]} {
5115 error_popup "Error creating tag: $err"
5116 return
5119 set tagids($tag) $id
5120 lappend idtags($id) $tag
5121 redrawtags $id
5122 addedtag $id
5125 proc redrawtags {id} {
5126 global canv linehtag commitrow idpos selectedline curview
5127 global mainfont canvxmax
5129 if {![info exists commitrow($curview,$id)]} return
5130 drawcmitrow $commitrow($curview,$id)
5131 $canv delete tag.$id
5132 set xt [eval drawtags $id $idpos($id)]
5133 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5134 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5135 set xr [expr {$xt + [font measure $mainfont $text]}]
5136 if {$xr > $canvxmax} {
5137 set canvxmax $xr
5138 setcanvscroll
5140 if {[info exists selectedline]
5141 && $selectedline == $commitrow($curview,$id)} {
5142 selectline $selectedline 0
5146 proc mktagcan {} {
5147 global mktagtop
5149 catch {destroy $mktagtop}
5150 unset mktagtop
5153 proc mktaggo {} {
5154 domktag
5155 mktagcan
5158 proc writecommit {} {
5159 global rowmenuid wrcomtop commitinfo wrcomcmd
5161 set top .writecommit
5162 set wrcomtop $top
5163 catch {destroy $top}
5164 toplevel $top
5165 label $top.title -text "Write commit to file"
5166 grid $top.title - -pady 10
5167 label $top.id -text "ID:"
5168 entry $top.sha1 -width 40 -relief flat
5169 $top.sha1 insert 0 $rowmenuid
5170 $top.sha1 conf -state readonly
5171 grid $top.id $top.sha1 -sticky w
5172 entry $top.head -width 60 -relief flat
5173 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5174 $top.head conf -state readonly
5175 grid x $top.head -sticky w
5176 label $top.clab -text "Command:"
5177 entry $top.cmd -width 60 -textvariable wrcomcmd
5178 grid $top.clab $top.cmd -sticky w -pady 10
5179 label $top.flab -text "Output file:"
5180 entry $top.fname -width 60
5181 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5182 grid $top.flab $top.fname -sticky w
5183 frame $top.buts
5184 button $top.buts.gen -text "Write" -command wrcomgo
5185 button $top.buts.can -text "Cancel" -command wrcomcan
5186 grid $top.buts.gen $top.buts.can
5187 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5188 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5189 grid $top.buts - -pady 10 -sticky ew
5190 focus $top.fname
5193 proc wrcomgo {} {
5194 global wrcomtop
5196 set id [$wrcomtop.sha1 get]
5197 set cmd "echo $id | [$wrcomtop.cmd get]"
5198 set fname [$wrcomtop.fname get]
5199 if {[catch {exec sh -c $cmd >$fname &} err]} {
5200 error_popup "Error writing commit: $err"
5202 catch {destroy $wrcomtop}
5203 unset wrcomtop
5206 proc wrcomcan {} {
5207 global wrcomtop
5209 catch {destroy $wrcomtop}
5210 unset wrcomtop
5213 proc mkbranch {} {
5214 global rowmenuid mkbrtop
5216 set top .makebranch
5217 catch {destroy $top}
5218 toplevel $top
5219 label $top.title -text "Create new branch"
5220 grid $top.title - -pady 10
5221 label $top.id -text "ID:"
5222 entry $top.sha1 -width 40 -relief flat
5223 $top.sha1 insert 0 $rowmenuid
5224 $top.sha1 conf -state readonly
5225 grid $top.id $top.sha1 -sticky w
5226 label $top.nlab -text "Name:"
5227 entry $top.name -width 40
5228 grid $top.nlab $top.name -sticky w
5229 frame $top.buts
5230 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5231 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5232 grid $top.buts.go $top.buts.can
5233 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5234 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5235 grid $top.buts - -pady 10 -sticky ew
5236 focus $top.name
5239 proc mkbrgo {top} {
5240 global headids idheads
5242 set name [$top.name get]
5243 set id [$top.sha1 get]
5244 if {$name eq {}} {
5245 error_popup "Please specify a name for the new branch"
5246 return
5248 catch {destroy $top}
5249 nowbusy newbranch
5250 update
5251 if {[catch {
5252 exec git branch $name $id
5253 } err]} {
5254 notbusy newbranch
5255 error_popup $err
5256 } else {
5257 addedhead $id $name
5258 # XXX should update list of heads displayed for selected commit
5259 notbusy newbranch
5260 redrawtags $id
5264 proc cherrypick {} {
5265 global rowmenuid curview commitrow
5266 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5268 if {[info exists desc_heads($rowmenuid)]
5269 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5270 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5271 included in branch $mainhead -- really re-apply it?"]
5272 if {!$ok} return
5274 nowbusy cherrypick
5275 update
5276 set oldhead [exec git rev-parse HEAD]
5277 # Unfortunately git-cherry-pick writes stuff to stderr even when
5278 # no error occurs, and exec takes that as an indication of error...
5279 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5280 notbusy cherrypick
5281 error_popup $err
5282 return
5284 set newhead [exec git rev-parse HEAD]
5285 if {$newhead eq $oldhead} {
5286 notbusy cherrypick
5287 error_popup "No changes committed"
5288 return
5290 set allparents($newhead) $oldhead
5291 lappend allchildren($oldhead) $newhead
5292 set desc_heads($newhead) $mainhead
5293 if {[info exists anc_tags($oldhead)]} {
5294 set anc_tags($newhead) $anc_tags($oldhead)
5296 set desc_tags($newhead) {}
5297 if {[info exists commitrow($curview,$oldhead)]} {
5298 insertrow $commitrow($curview,$oldhead) $newhead
5299 if {$mainhead ne {}} {
5300 movedhead $newhead $mainhead
5302 redrawtags $oldhead
5303 redrawtags $newhead
5305 notbusy cherrypick
5308 # context menu for a head
5309 proc headmenu {x y id head} {
5310 global headmenuid headmenuhead headctxmenu
5312 set headmenuid $id
5313 set headmenuhead $head
5314 tk_popup $headctxmenu $x $y
5317 proc cobranch {} {
5318 global headmenuid headmenuhead mainhead headids
5320 # check the tree is clean first??
5321 set oldmainhead $mainhead
5322 nowbusy checkout
5323 update
5324 if {[catch {
5325 exec git checkout $headmenuhead
5326 } err]} {
5327 notbusy checkout
5328 error_popup $err
5329 } else {
5330 notbusy checkout
5331 set mainhead $headmenuhead
5332 if {[info exists headids($oldmainhead)]} {
5333 redrawtags $headids($oldmainhead)
5335 redrawtags $headmenuid
5339 proc rmbranch {} {
5340 global desc_heads headmenuid headmenuhead mainhead
5341 global headids idheads
5343 set head $headmenuhead
5344 set id $headmenuid
5345 if {$head eq $mainhead} {
5346 error_popup "Cannot delete the currently checked-out branch"
5347 return
5349 if {$desc_heads($id) eq $head} {
5350 # the stuff on this branch isn't on any other branch
5351 if {![confirm_popup "The commits on branch $head aren't on any other\
5352 branch.\nReally delete branch $head?"]} return
5354 nowbusy rmbranch
5355 update
5356 if {[catch {exec git branch -D $head} err]} {
5357 notbusy rmbranch
5358 error_popup $err
5359 return
5361 removedhead $id $head
5362 redrawtags $id
5363 notbusy rmbranch
5366 # Stuff for finding nearby tags
5367 proc getallcommits {} {
5368 global allcstart allcommits allcfd allids
5370 set allids {}
5371 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5372 set allcfd $fd
5373 fconfigure $fd -blocking 0
5374 set allcommits "reading"
5375 nowbusy allcommits
5376 restartgetall $fd
5379 proc discardallcommits {} {
5380 global allparents allchildren allcommits allcfd
5381 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5383 if {![info exists allcommits]} return
5384 if {$allcommits eq "reading"} {
5385 catch {close $allcfd}
5387 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5388 alldtags tagisdesc desc_heads} {
5389 catch {unset $v}
5393 proc restartgetall {fd} {
5394 global allcstart
5396 fileevent $fd readable [list getallclines $fd]
5397 set allcstart [clock clicks -milliseconds]
5400 proc combine_dtags {l1 l2} {
5401 global tagisdesc notfirstd
5403 set res [lsort -unique [concat $l1 $l2]]
5404 for {set i 0} {$i < [llength $res]} {incr i} {
5405 set x [lindex $res $i]
5406 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5407 set y [lindex $res $j]
5408 if {[info exists tagisdesc($x,$y)]} {
5409 if {$tagisdesc($x,$y) > 0} {
5410 # x is a descendent of y, exclude x
5411 set res [lreplace $res $i $i]
5412 incr i -1
5413 break
5414 } else {
5415 # y is a descendent of x, exclude y
5416 set res [lreplace $res $j $j]
5418 } else {
5419 # no relation, keep going
5420 incr j
5424 return $res
5427 proc combine_atags {l1 l2} {
5428 global tagisdesc
5430 set res [lsort -unique [concat $l1 $l2]]
5431 for {set i 0} {$i < [llength $res]} {incr i} {
5432 set x [lindex $res $i]
5433 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5434 set y [lindex $res $j]
5435 if {[info exists tagisdesc($x,$y)]} {
5436 if {$tagisdesc($x,$y) < 0} {
5437 # x is an ancestor of y, exclude x
5438 set res [lreplace $res $i $i]
5439 incr i -1
5440 break
5441 } else {
5442 # y is an ancestor of x, exclude y
5443 set res [lreplace $res $j $j]
5445 } else {
5446 # no relation, keep going
5447 incr j
5451 return $res
5454 proc forward_pass {id children} {
5455 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5457 set dtags {}
5458 set dheads {}
5459 foreach child $children {
5460 if {[info exists idtags($child)]} {
5461 set ctags [list $child]
5462 } else {
5463 set ctags $desc_tags($child)
5465 if {$dtags eq {}} {
5466 set dtags $ctags
5467 } elseif {$ctags ne $dtags} {
5468 set dtags [combine_dtags $dtags $ctags]
5470 set cheads $desc_heads($child)
5471 if {$dheads eq {}} {
5472 set dheads $cheads
5473 } elseif {$cheads ne $dheads} {
5474 set dheads [lsort -unique [concat $dheads $cheads]]
5477 set desc_tags($id) $dtags
5478 if {[info exists idtags($id)]} {
5479 set adt $dtags
5480 foreach tag $dtags {
5481 set adt [concat $adt $alldtags($tag)]
5483 set adt [lsort -unique $adt]
5484 set alldtags($id) $adt
5485 foreach tag $adt {
5486 set tagisdesc($id,$tag) -1
5487 set tagisdesc($tag,$id) 1
5490 if {[info exists idheads($id)]} {
5491 set dheads [concat $dheads $idheads($id)]
5493 set desc_heads($id) $dheads
5496 proc getallclines {fd} {
5497 global allparents allchildren allcommits allcstart
5498 global desc_tags anc_tags idtags tagisdesc allids
5499 global idheads travindex
5501 while {[gets $fd line] >= 0} {
5502 set id [lindex $line 0]
5503 lappend allids $id
5504 set olds [lrange $line 1 end]
5505 set allparents($id) $olds
5506 if {![info exists allchildren($id)]} {
5507 set allchildren($id) {}
5509 foreach p $olds {
5510 lappend allchildren($p) $id
5512 # compute nearest tagged descendents as we go
5513 # also compute descendent heads
5514 forward_pass $id $allchildren($id)
5515 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5516 fileevent $fd readable {}
5517 after idle restartgetall $fd
5518 return
5521 if {[eof $fd]} {
5522 set travindex [llength $allids]
5523 set allcommits "traversing"
5524 after idle restartatags
5525 if {[catch {close $fd} err]} {
5526 error_popup "Error reading full commit graph: $err.\n\
5527 Results may be incomplete."
5532 # walk backward through the tree and compute nearest tagged ancestors
5533 proc restartatags {} {
5534 global allids allparents idtags anc_tags travindex
5536 set t0 [clock clicks -milliseconds]
5537 set i $travindex
5538 while {[incr i -1] >= 0} {
5539 set id [lindex $allids $i]
5540 set atags {}
5541 foreach p $allparents($id) {
5542 if {[info exists idtags($p)]} {
5543 set ptags [list $p]
5544 } else {
5545 set ptags $anc_tags($p)
5547 if {$atags eq {}} {
5548 set atags $ptags
5549 } elseif {$ptags ne $atags} {
5550 set atags [combine_atags $atags $ptags]
5553 set anc_tags($id) $atags
5554 if {[clock clicks -milliseconds] - $t0 >= 50} {
5555 set travindex $i
5556 after idle restartatags
5557 return
5560 set allcommits "done"
5561 set travindex 0
5562 notbusy allcommits
5563 dispneartags
5566 # update the desc_tags and anc_tags arrays for a new tag just added
5567 proc addedtag {id} {
5568 global desc_tags anc_tags allparents allchildren allcommits
5569 global idtags tagisdesc alldtags
5571 if {![info exists desc_tags($id)]} return
5572 set adt $desc_tags($id)
5573 foreach t $desc_tags($id) {
5574 set adt [concat $adt $alldtags($t)]
5576 set adt [lsort -unique $adt]
5577 set alldtags($id) $adt
5578 foreach t $adt {
5579 set tagisdesc($id,$t) -1
5580 set tagisdesc($t,$id) 1
5582 if {[info exists anc_tags($id)]} {
5583 set todo $anc_tags($id)
5584 while {$todo ne {}} {
5585 set do [lindex $todo 0]
5586 set todo [lrange $todo 1 end]
5587 if {[info exists tagisdesc($id,$do)]} continue
5588 set tagisdesc($do,$id) -1
5589 set tagisdesc($id,$do) 1
5590 if {[info exists anc_tags($do)]} {
5591 set todo [concat $todo $anc_tags($do)]
5596 set lastold $desc_tags($id)
5597 set lastnew [list $id]
5598 set nup 0
5599 set nch 0
5600 set todo $allparents($id)
5601 while {$todo ne {}} {
5602 set do [lindex $todo 0]
5603 set todo [lrange $todo 1 end]
5604 if {![info exists desc_tags($do)]} continue
5605 if {$desc_tags($do) ne $lastold} {
5606 set lastold $desc_tags($do)
5607 set lastnew [combine_dtags $lastold [list $id]]
5608 incr nch
5610 if {$lastold eq $lastnew} continue
5611 set desc_tags($do) $lastnew
5612 incr nup
5613 if {![info exists idtags($do)]} {
5614 set todo [concat $todo $allparents($do)]
5618 if {![info exists anc_tags($id)]} return
5619 set lastold $anc_tags($id)
5620 set lastnew [list $id]
5621 set nup 0
5622 set nch 0
5623 set todo $allchildren($id)
5624 while {$todo ne {}} {
5625 set do [lindex $todo 0]
5626 set todo [lrange $todo 1 end]
5627 if {![info exists anc_tags($do)]} continue
5628 if {$anc_tags($do) ne $lastold} {
5629 set lastold $anc_tags($do)
5630 set lastnew [combine_atags $lastold [list $id]]
5631 incr nch
5633 if {$lastold eq $lastnew} continue
5634 set anc_tags($do) $lastnew
5635 incr nup
5636 if {![info exists idtags($do)]} {
5637 set todo [concat $todo $allchildren($do)]
5642 # update the desc_heads array for a new head just added
5643 proc addedhead {hid head} {
5644 global desc_heads allparents headids idheads
5646 set headids($head) $hid
5647 lappend idheads($hid) $head
5649 set todo [list $hid]
5650 while {$todo ne {}} {
5651 set do [lindex $todo 0]
5652 set todo [lrange $todo 1 end]
5653 if {![info exists desc_heads($do)] ||
5654 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5655 set oldheads $desc_heads($do)
5656 lappend desc_heads($do) $head
5657 set heads $desc_heads($do)
5658 while {1} {
5659 set p $allparents($do)
5660 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5661 $desc_heads($p) ne $oldheads} break
5662 set do $p
5663 set desc_heads($do) $heads
5665 set todo [concat $todo $p]
5669 # update the desc_heads array for a head just removed
5670 proc removedhead {hid head} {
5671 global desc_heads allparents headids idheads
5673 unset headids($head)
5674 if {$idheads($hid) eq $head} {
5675 unset idheads($hid)
5676 } else {
5677 set i [lsearch -exact $idheads($hid) $head]
5678 if {$i >= 0} {
5679 set idheads($hid) [lreplace $idheads($hid) $i $i]
5683 set todo [list $hid]
5684 while {$todo ne {}} {
5685 set do [lindex $todo 0]
5686 set todo [lrange $todo 1 end]
5687 if {![info exists desc_heads($do)]} continue
5688 set i [lsearch -exact $desc_heads($do) $head]
5689 if {$i < 0} continue
5690 set oldheads $desc_heads($do)
5691 set heads [lreplace $desc_heads($do) $i $i]
5692 while {1} {
5693 set desc_heads($do) $heads
5694 set p $allparents($do)
5695 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5696 $desc_heads($p) ne $oldheads} break
5697 set do $p
5699 set todo [concat $todo $p]
5703 # update things for a head moved to a child of its previous location
5704 proc movedhead {id name} {
5705 global headids idheads
5707 set oldid $headids($name)
5708 set headids($name) $id
5709 if {$idheads($oldid) eq $name} {
5710 unset idheads($oldid)
5711 } else {
5712 set i [lsearch -exact $idheads($oldid) $name]
5713 if {$i >= 0} {
5714 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5717 lappend idheads($id) $name
5720 proc changedrefs {} {
5721 global desc_heads desc_tags anc_tags allcommits allids
5722 global allchildren allparents idtags travindex
5724 if {![info exists allcommits]} return
5725 catch {unset desc_heads}
5726 catch {unset desc_tags}
5727 catch {unset anc_tags}
5728 catch {unset alldtags}
5729 catch {unset tagisdesc}
5730 foreach id $allids {
5731 forward_pass $id $allchildren($id)
5733 if {$allcommits ne "reading"} {
5734 set travindex [llength $allids]
5735 if {$allcommits ne "traversing"} {
5736 set allcommits "traversing"
5737 after idle restartatags
5742 proc rereadrefs {} {
5743 global idtags idheads idotherrefs mainhead
5745 set refids [concat [array names idtags] \
5746 [array names idheads] [array names idotherrefs]]
5747 foreach id $refids {
5748 if {![info exists ref($id)]} {
5749 set ref($id) [listrefs $id]
5752 set oldmainhead $mainhead
5753 readrefs
5754 changedrefs
5755 set refids [lsort -unique [concat $refids [array names idtags] \
5756 [array names idheads] [array names idotherrefs]]]
5757 foreach id $refids {
5758 set v [listrefs $id]
5759 if {![info exists ref($id)] || $ref($id) != $v ||
5760 ($id eq $oldmainhead && $id ne $mainhead) ||
5761 ($id eq $mainhead && $id ne $oldmainhead)} {
5762 redrawtags $id
5767 proc listrefs {id} {
5768 global idtags idheads idotherrefs
5770 set x {}
5771 if {[info exists idtags($id)]} {
5772 set x $idtags($id)
5774 set y {}
5775 if {[info exists idheads($id)]} {
5776 set y $idheads($id)
5778 set z {}
5779 if {[info exists idotherrefs($id)]} {
5780 set z $idotherrefs($id)
5782 return [list $x $y $z]
5785 proc showtag {tag isnew} {
5786 global ctext tagcontents tagids linknum
5788 if {$isnew} {
5789 addtohistory [list showtag $tag 0]
5791 $ctext conf -state normal
5792 clear_ctext
5793 set linknum 0
5794 if {[info exists tagcontents($tag)]} {
5795 set text $tagcontents($tag)
5796 } else {
5797 set text "Tag: $tag\nId: $tagids($tag)"
5799 appendwithlinks $text {}
5800 $ctext conf -state disabled
5801 init_flist {}
5804 proc doquit {} {
5805 global stopped
5806 set stopped 100
5807 savestuff .
5808 destroy .
5811 proc doprefs {} {
5812 global maxwidth maxgraphpct diffopts
5813 global oldprefs prefstop showneartags
5814 global bgcolor fgcolor ctext diffcolors
5816 set top .gitkprefs
5817 set prefstop $top
5818 if {[winfo exists $top]} {
5819 raise $top
5820 return
5822 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5823 set oldprefs($v) [set $v]
5825 toplevel $top
5826 wm title $top "Gitk preferences"
5827 label $top.ldisp -text "Commit list display options"
5828 grid $top.ldisp - -sticky w -pady 10
5829 label $top.spacer -text " "
5830 label $top.maxwidthl -text "Maximum graph width (lines)" \
5831 -font optionfont
5832 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5833 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5834 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5835 -font optionfont
5836 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5837 grid x $top.maxpctl $top.maxpct -sticky w
5839 label $top.ddisp -text "Diff display options"
5840 grid $top.ddisp - -sticky w -pady 10
5841 label $top.diffoptl -text "Options for diff program" \
5842 -font optionfont
5843 entry $top.diffopt -width 20 -textvariable diffopts
5844 grid x $top.diffoptl $top.diffopt -sticky w
5845 frame $top.ntag
5846 label $top.ntag.l -text "Display nearby tags" -font optionfont
5847 checkbutton $top.ntag.b -variable showneartags
5848 pack $top.ntag.b $top.ntag.l -side left
5849 grid x $top.ntag -sticky w
5851 label $top.cdisp -text "Colors: press to choose"
5852 grid $top.cdisp - -sticky w -pady 10
5853 label $top.bg -padx 40 -relief sunk -background $bgcolor
5854 button $top.bgbut -text "Background" -font optionfont \
5855 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5856 grid x $top.bgbut $top.bg -sticky w
5857 label $top.fg -padx 40 -relief sunk -background $fgcolor
5858 button $top.fgbut -text "Foreground" -font optionfont \
5859 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5860 grid x $top.fgbut $top.fg -sticky w
5861 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5862 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5863 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5864 [list $ctext tag conf d0 -foreground]]
5865 grid x $top.diffoldbut $top.diffold -sticky w
5866 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5867 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5868 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5869 [list $ctext tag conf d1 -foreground]]
5870 grid x $top.diffnewbut $top.diffnew -sticky w
5871 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5872 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5873 -command [list choosecolor diffcolors 2 $top.hunksep \
5874 "diff hunk header" \
5875 [list $ctext tag conf hunksep -foreground]]
5876 grid x $top.hunksepbut $top.hunksep -sticky w
5878 frame $top.buts
5879 button $top.buts.ok -text "OK" -command prefsok
5880 button $top.buts.can -text "Cancel" -command prefscan
5881 grid $top.buts.ok $top.buts.can
5882 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5883 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5884 grid $top.buts - - -pady 10 -sticky ew
5887 proc choosecolor {v vi w x cmd} {
5888 global $v
5890 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5891 -title "Gitk: choose color for $x"]
5892 if {$c eq {}} return
5893 $w conf -background $c
5894 lset $v $vi $c
5895 eval $cmd $c
5898 proc setbg {c} {
5899 global bglist
5901 foreach w $bglist {
5902 $w conf -background $c
5906 proc setfg {c} {
5907 global fglist canv
5909 foreach w $fglist {
5910 $w conf -foreground $c
5912 allcanvs itemconf text -fill $c
5913 $canv itemconf circle -outline $c
5916 proc prefscan {} {
5917 global maxwidth maxgraphpct diffopts
5918 global oldprefs prefstop showneartags
5920 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5921 set $v $oldprefs($v)
5923 catch {destroy $prefstop}
5924 unset prefstop
5927 proc prefsok {} {
5928 global maxwidth maxgraphpct
5929 global oldprefs prefstop showneartags
5931 catch {destroy $prefstop}
5932 unset prefstop
5933 if {$maxwidth != $oldprefs(maxwidth)
5934 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5935 redisplay
5936 } elseif {$showneartags != $oldprefs(showneartags)} {
5937 reselectline
5941 proc formatdate {d} {
5942 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5945 # This list of encoding names and aliases is distilled from
5946 # http://www.iana.org/assignments/character-sets.
5947 # Not all of them are supported by Tcl.
5948 set encoding_aliases {
5949 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5950 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5951 { ISO-10646-UTF-1 csISO10646UTF1 }
5952 { ISO_646.basic:1983 ref csISO646basic1983 }
5953 { INVARIANT csINVARIANT }
5954 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5955 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5956 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5957 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5958 { NATS-DANO iso-ir-9-1 csNATSDANO }
5959 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5960 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5961 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5962 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5963 { ISO-2022-KR csISO2022KR }
5964 { EUC-KR csEUCKR }
5965 { ISO-2022-JP csISO2022JP }
5966 { ISO-2022-JP-2 csISO2022JP2 }
5967 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5968 csISO13JISC6220jp }
5969 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5970 { IT iso-ir-15 ISO646-IT csISO15Italian }
5971 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5972 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5973 { greek7-old iso-ir-18 csISO18Greek7Old }
5974 { latin-greek iso-ir-19 csISO19LatinGreek }
5975 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5976 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5977 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5978 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5979 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5980 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5981 { INIS iso-ir-49 csISO49INIS }
5982 { INIS-8 iso-ir-50 csISO50INIS8 }
5983 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5984 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5985 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5986 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5987 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5988 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5989 csISO60Norwegian1 }
5990 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5991 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5992 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5993 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5994 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5995 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5996 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5997 { greek7 iso-ir-88 csISO88Greek7 }
5998 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5999 { iso-ir-90 csISO90 }
6000 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6001 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6002 csISO92JISC62991984b }
6003 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6004 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6005 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6006 csISO95JIS62291984handadd }
6007 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6008 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6009 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6010 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6011 CP819 csISOLatin1 }
6012 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6013 { T.61-7bit iso-ir-102 csISO102T617bit }
6014 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6015 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6016 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6017 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6018 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6019 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6020 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6021 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6022 arabic csISOLatinArabic }
6023 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6024 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6025 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6026 greek greek8 csISOLatinGreek }
6027 { T.101-G2 iso-ir-128 csISO128T101G2 }
6028 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6029 csISOLatinHebrew }
6030 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6031 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6032 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6033 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6034 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6035 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6036 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6037 csISOLatinCyrillic }
6038 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6039 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6040 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6041 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6042 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6043 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6044 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6045 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6046 { ISO_10367-box iso-ir-155 csISO10367Box }
6047 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6048 { latin-lap lap iso-ir-158 csISO158Lap }
6049 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6050 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6051 { us-dk csUSDK }
6052 { dk-us csDKUS }
6053 { JIS_X0201 X0201 csHalfWidthKatakana }
6054 { KSC5636 ISO646-KR csKSC5636 }
6055 { ISO-10646-UCS-2 csUnicode }
6056 { ISO-10646-UCS-4 csUCS4 }
6057 { DEC-MCS dec csDECMCS }
6058 { hp-roman8 roman8 r8 csHPRoman8 }
6059 { macintosh mac csMacintosh }
6060 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6061 csIBM037 }
6062 { IBM038 EBCDIC-INT cp038 csIBM038 }
6063 { IBM273 CP273 csIBM273 }
6064 { IBM274 EBCDIC-BE CP274 csIBM274 }
6065 { IBM275 EBCDIC-BR cp275 csIBM275 }
6066 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6067 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6068 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6069 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6070 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6071 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6072 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6073 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6074 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6075 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6076 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6077 { IBM437 cp437 437 csPC8CodePage437 }
6078 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6079 { IBM775 cp775 csPC775Baltic }
6080 { IBM850 cp850 850 csPC850Multilingual }
6081 { IBM851 cp851 851 csIBM851 }
6082 { IBM852 cp852 852 csPCp852 }
6083 { IBM855 cp855 855 csIBM855 }
6084 { IBM857 cp857 857 csIBM857 }
6085 { IBM860 cp860 860 csIBM860 }
6086 { IBM861 cp861 861 cp-is csIBM861 }
6087 { IBM862 cp862 862 csPC862LatinHebrew }
6088 { IBM863 cp863 863 csIBM863 }
6089 { IBM864 cp864 csIBM864 }
6090 { IBM865 cp865 865 csIBM865 }
6091 { IBM866 cp866 866 csIBM866 }
6092 { IBM868 CP868 cp-ar csIBM868 }
6093 { IBM869 cp869 869 cp-gr csIBM869 }
6094 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6095 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6096 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6097 { IBM891 cp891 csIBM891 }
6098 { IBM903 cp903 csIBM903 }
6099 { IBM904 cp904 904 csIBBM904 }
6100 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6101 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6102 { IBM1026 CP1026 csIBM1026 }
6103 { EBCDIC-AT-DE csIBMEBCDICATDE }
6104 { EBCDIC-AT-DE-A csEBCDICATDEA }
6105 { EBCDIC-CA-FR csEBCDICCAFR }
6106 { EBCDIC-DK-NO csEBCDICDKNO }
6107 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6108 { EBCDIC-FI-SE csEBCDICFISE }
6109 { EBCDIC-FI-SE-A csEBCDICFISEA }
6110 { EBCDIC-FR csEBCDICFR }
6111 { EBCDIC-IT csEBCDICIT }
6112 { EBCDIC-PT csEBCDICPT }
6113 { EBCDIC-ES csEBCDICES }
6114 { EBCDIC-ES-A csEBCDICESA }
6115 { EBCDIC-ES-S csEBCDICESS }
6116 { EBCDIC-UK csEBCDICUK }
6117 { EBCDIC-US csEBCDICUS }
6118 { UNKNOWN-8BIT csUnknown8BiT }
6119 { MNEMONIC csMnemonic }
6120 { MNEM csMnem }
6121 { VISCII csVISCII }
6122 { VIQR csVIQR }
6123 { KOI8-R csKOI8R }
6124 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6125 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6126 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6127 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6128 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6129 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6130 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6131 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6132 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6133 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6134 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6135 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6136 { IBM1047 IBM-1047 }
6137 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6138 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6139 { UNICODE-1-1 csUnicode11 }
6140 { CESU-8 csCESU-8 }
6141 { BOCU-1 csBOCU-1 }
6142 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6143 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6144 l8 }
6145 { ISO-8859-15 ISO_8859-15 Latin-9 }
6146 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6147 { GBK CP936 MS936 windows-936 }
6148 { JIS_Encoding csJISEncoding }
6149 { Shift_JIS MS_Kanji csShiftJIS }
6150 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6151 EUC-JP }
6152 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6153 { ISO-10646-UCS-Basic csUnicodeASCII }
6154 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6155 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6156 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6157 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6158 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6159 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6160 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6161 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6162 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6163 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6164 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6165 { Ventura-US csVenturaUS }
6166 { Ventura-International csVenturaInternational }
6167 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6168 { PC8-Turkish csPC8Turkish }
6169 { IBM-Symbols csIBMSymbols }
6170 { IBM-Thai csIBMThai }
6171 { HP-Legal csHPLegal }
6172 { HP-Pi-font csHPPiFont }
6173 { HP-Math8 csHPMath8 }
6174 { Adobe-Symbol-Encoding csHPPSMath }
6175 { HP-DeskTop csHPDesktop }
6176 { Ventura-Math csVenturaMath }
6177 { Microsoft-Publishing csMicrosoftPublishing }
6178 { Windows-31J csWindows31J }
6179 { GB2312 csGB2312 }
6180 { Big5 csBig5 }
6183 proc tcl_encoding {enc} {
6184 global encoding_aliases
6185 set names [encoding names]
6186 set lcnames [string tolower $names]
6187 set enc [string tolower $enc]
6188 set i [lsearch -exact $lcnames $enc]
6189 if {$i < 0} {
6190 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6191 if {[regsub {^iso[-_]} $enc iso encx]} {
6192 set i [lsearch -exact $lcnames $encx]
6195 if {$i < 0} {
6196 foreach l $encoding_aliases {
6197 set ll [string tolower $l]
6198 if {[lsearch -exact $ll $enc] < 0} continue
6199 # look through the aliases for one that tcl knows about
6200 foreach e $ll {
6201 set i [lsearch -exact $lcnames $e]
6202 if {$i < 0} {
6203 if {[regsub {^iso[-_]} $e iso ex]} {
6204 set i [lsearch -exact $lcnames $ex]
6207 if {$i >= 0} break
6209 break
6212 if {$i >= 0} {
6213 return [lindex $names $i]
6215 return {}
6218 # defaults...
6219 set datemode 0
6220 set diffopts "-U 5 -p"
6221 set wrcomcmd "git diff-tree --stdin -p --pretty"
6223 set gitencoding {}
6224 catch {
6225 set gitencoding [exec git config --get i18n.commitencoding]
6227 if {$gitencoding == ""} {
6228 set gitencoding "utf-8"
6230 set tclencoding [tcl_encoding $gitencoding]
6231 if {$tclencoding == {}} {
6232 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6235 set mainfont {Helvetica 9}
6236 set textfont {Courier 9}
6237 set uifont {Helvetica 9 bold}
6238 set findmergefiles 0
6239 set maxgraphpct 50
6240 set maxwidth 16
6241 set revlistorder 0
6242 set fastdate 0
6243 set uparrowlen 7
6244 set downarrowlen 7
6245 set mingaplen 30
6246 set cmitmode "patch"
6247 set wrapcomment "none"
6248 set showneartags 1
6250 set colors {green red blue magenta darkgrey brown orange}
6251 set bgcolor white
6252 set fgcolor black
6253 set diffcolors {red "#00a000" blue}
6255 catch {source ~/.gitk}
6257 font create optionfont -family sans-serif -size -12
6259 set revtreeargs {}
6260 foreach arg $argv {
6261 switch -regexp -- $arg {
6262 "^$" { }
6263 "^-d" { set datemode 1 }
6264 default {
6265 lappend revtreeargs $arg
6270 # check that we can find a .git directory somewhere...
6271 set gitdir [gitdir]
6272 if {![file isdirectory $gitdir]} {
6273 show_error {} . "Cannot find the git directory \"$gitdir\"."
6274 exit 1
6277 set cmdline_files {}
6278 set i [lsearch -exact $revtreeargs "--"]
6279 if {$i >= 0} {
6280 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6281 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6282 } elseif {$revtreeargs ne {}} {
6283 if {[catch {
6284 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6285 set cmdline_files [split $f "\n"]
6286 set n [llength $cmdline_files]
6287 set revtreeargs [lrange $revtreeargs 0 end-$n]
6288 } err]} {
6289 # unfortunately we get both stdout and stderr in $err,
6290 # so look for "fatal:".
6291 set i [string first "fatal:" $err]
6292 if {$i > 0} {
6293 set err [string range $err [expr {$i + 6}] end]
6295 show_error {} . "Bad arguments to gitk:\n$err"
6296 exit 1
6300 set history {}
6301 set historyindex 0
6302 set fh_serial 0
6303 set nhl_names {}
6304 set highlight_paths {}
6305 set searchdirn -forwards
6306 set boldrows {}
6307 set boldnamerows {}
6309 set optim_delay 16
6311 set nextviewnum 1
6312 set curview 0
6313 set selectedview 0
6314 set selectedhlview None
6315 set viewfiles(0) {}
6316 set viewperm(0) 0
6317 set viewargs(0) {}
6319 set cmdlineok 0
6320 set stopped 0
6321 set stuffsaved 0
6322 set patchnum 0
6323 setcoords
6324 makewindow
6325 wm title . "[file tail $argv0]: [file tail [pwd]]"
6326 readrefs
6328 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6329 # create a view for the files/dirs specified on the command line
6330 set curview 1
6331 set selectedview 1
6332 set nextviewnum 2
6333 set viewname(1) "Command line"
6334 set viewfiles(1) $cmdline_files
6335 set viewargs(1) $revtreeargs
6336 set viewperm(1) 0
6337 addviewmenu 1
6338 .bar.view entryconf Edit* -state normal
6339 .bar.view entryconf Delete* -state normal
6342 if {[info exists permviews]} {
6343 foreach v $permviews {
6344 set n $nextviewnum
6345 incr nextviewnum
6346 set viewname($n) [lindex $v 0]
6347 set viewfiles($n) [lindex $v 1]
6348 set viewargs($n) [lindex $v 2]
6349 set viewperm($n) 1
6350 addviewmenu $n
6353 getcommits