More missing static
[git/kirr.git] / gitk
blob87c3690ff3f742984ea91dcd45fb8475ae988f1e
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
596 frame .bleft.mid
598 button .bleft.top.search -text "Search" -command dosearch \
599 -font $uifont
600 pack .bleft.top.search -side left -padx 5
601 set sstring .bleft.top.sstring
602 entry $sstring -width 20 -font $textfont -textvariable searchstring
603 lappend entries $sstring
604 trace add variable searchstring write incrsearch
605 pack $sstring -side left -expand 1 -fill x
606 radiobutton .bleft.mid.diff -text "Diff" \
607 -command changediffdisp -variable diffelide -value {0 0}
608 radiobutton .bleft.mid.old -text "Old version" \
609 -command changediffdisp -variable diffelide -value {0 1}
610 radiobutton .bleft.mid.new -text "New version" \
611 -command changediffdisp -variable diffelide -value {1 0}
612 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
613 set ctext .bleft.ctext
614 text $ctext -background $bgcolor -foreground $fgcolor \
615 -state disabled -font $textfont \
616 -yscrollcommand scrolltext -wrap none
617 scrollbar .bleft.sb -command "$ctext yview"
618 pack .bleft.top -side top -fill x
619 pack .bleft.mid -side top -fill x
620 pack .bleft.sb -side right -fill y
621 pack $ctext -side left -fill both -expand 1
622 lappend bglist $ctext
623 lappend fglist $ctext
625 $ctext tag conf comment -wrap $wrapcomment
626 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
627 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
628 $ctext tag conf d0 -fore [lindex $diffcolors 0]
629 $ctext tag conf d1 -fore [lindex $diffcolors 1]
630 $ctext tag conf m0 -fore red
631 $ctext tag conf m1 -fore blue
632 $ctext tag conf m2 -fore green
633 $ctext tag conf m3 -fore purple
634 $ctext tag conf m4 -fore brown
635 $ctext tag conf m5 -fore "#009090"
636 $ctext tag conf m6 -fore magenta
637 $ctext tag conf m7 -fore "#808000"
638 $ctext tag conf m8 -fore "#009000"
639 $ctext tag conf m9 -fore "#ff0080"
640 $ctext tag conf m10 -fore cyan
641 $ctext tag conf m11 -fore "#b07070"
642 $ctext tag conf m12 -fore "#70b0f0"
643 $ctext tag conf m13 -fore "#70f0b0"
644 $ctext tag conf m14 -fore "#f0b070"
645 $ctext tag conf m15 -fore "#ff70b0"
646 $ctext tag conf mmax -fore darkgrey
647 set mergemax 16
648 $ctext tag conf mresult -font [concat $textfont bold]
649 $ctext tag conf msep -font [concat $textfont bold]
650 $ctext tag conf found -back yellow
652 .pwbottom add .bleft
653 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
655 # lower right
656 frame .bright
657 frame .bright.mode
658 radiobutton .bright.mode.patch -text "Patch" \
659 -command reselectline -variable cmitmode -value "patch"
660 .bright.mode.patch configure -font $uifont
661 radiobutton .bright.mode.tree -text "Tree" \
662 -command reselectline -variable cmitmode -value "tree"
663 .bright.mode.tree configure -font $uifont
664 grid .bright.mode.patch .bright.mode.tree -sticky ew
665 pack .bright.mode -side top -fill x
666 set cflist .bright.cfiles
667 set indent [font measure $mainfont "nn"]
668 text $cflist \
669 -background $bgcolor -foreground $fgcolor \
670 -font $mainfont \
671 -tabs [list $indent [expr {2 * $indent}]] \
672 -yscrollcommand ".bright.sb set" \
673 -cursor [. cget -cursor] \
674 -spacing1 1 -spacing3 1
675 lappend bglist $cflist
676 lappend fglist $cflist
677 scrollbar .bright.sb -command "$cflist yview"
678 pack .bright.sb -side right -fill y
679 pack $cflist -side left -fill both -expand 1
680 $cflist tag configure highlight \
681 -background [$cflist cget -selectbackground]
682 $cflist tag configure bold -font [concat $mainfont bold]
684 .pwbottom add .bright
685 .ctop add .pwbottom
687 # restore window position if known
688 if {[info exists geometry(main)]} {
689 wm geometry . "$geometry(main)"
692 bind .pwbottom <Configure> {resizecdetpanes %W %w}
693 pack .ctop -fill both -expand 1
694 bindall <1> {selcanvline %W %x %y}
695 #bindall <B1-Motion> {selcanvline %W %x %y}
696 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
697 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
698 bindall <2> "canvscan mark %W %x %y"
699 bindall <B2-Motion> "canvscan dragto %W %x %y"
700 bindkey <Home> selfirstline
701 bindkey <End> sellastline
702 bind . <Key-Up> "selnextline -1"
703 bind . <Key-Down> "selnextline 1"
704 bind . <Shift-Key-Up> "next_highlight -1"
705 bind . <Shift-Key-Down> "next_highlight 1"
706 bindkey <Key-Right> "goforw"
707 bindkey <Key-Left> "goback"
708 bind . <Key-Prior> "selnextpage -1"
709 bind . <Key-Next> "selnextpage 1"
710 bind . <Control-Home> "allcanvs yview moveto 0.0"
711 bind . <Control-End> "allcanvs yview moveto 1.0"
712 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
713 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
714 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
715 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
716 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
717 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
718 bindkey <Key-space> "$ctext yview scroll 1 pages"
719 bindkey p "selnextline -1"
720 bindkey n "selnextline 1"
721 bindkey z "goback"
722 bindkey x "goforw"
723 bindkey i "selnextline -1"
724 bindkey k "selnextline 1"
725 bindkey j "goback"
726 bindkey l "goforw"
727 bindkey b "$ctext yview scroll -1 pages"
728 bindkey d "$ctext yview scroll 18 units"
729 bindkey u "$ctext yview scroll -18 units"
730 bindkey / {findnext 1}
731 bindkey <Key-Return> {findnext 0}
732 bindkey ? findprev
733 bindkey f nextfile
734 bindkey <F5> updatecommits
735 bind . <Control-q> doquit
736 bind . <Control-f> dofind
737 bind . <Control-g> {findnext 0}
738 bind . <Control-r> dosearchback
739 bind . <Control-s> dosearch
740 bind . <Control-equal> {incrfont 1}
741 bind . <Control-KP_Add> {incrfont 1}
742 bind . <Control-minus> {incrfont -1}
743 bind . <Control-KP_Subtract> {incrfont -1}
744 wm protocol . WM_DELETE_WINDOW doquit
745 bind . <Button-1> "click %W"
746 bind $fstring <Key-Return> dofind
747 bind $sha1entry <Key-Return> gotocommit
748 bind $sha1entry <<PasteSelection>> clearsha1
749 bind $cflist <1> {sel_flist %W %x %y; break}
750 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
751 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
753 set maincursor [. cget -cursor]
754 set textcursor [$ctext cget -cursor]
755 set curtextcursor $textcursor
757 set rowctxmenu .rowctxmenu
758 menu $rowctxmenu -tearoff 0
759 $rowctxmenu add command -label "Diff this -> selected" \
760 -command {diffvssel 0}
761 $rowctxmenu add command -label "Diff selected -> this" \
762 -command {diffvssel 1}
763 $rowctxmenu add command -label "Make patch" -command mkpatch
764 $rowctxmenu add command -label "Create tag" -command mktag
765 $rowctxmenu add command -label "Write commit to file" -command writecommit
766 $rowctxmenu add command -label "Create new branch" -command mkbranch
767 $rowctxmenu add command -label "Cherry-pick this commit" \
768 -command cherrypick
770 set headctxmenu .headctxmenu
771 menu $headctxmenu -tearoff 0
772 $headctxmenu add command -label "Check out this branch" \
773 -command cobranch
774 $headctxmenu add command -label "Remove this branch" \
775 -command rmbranch
778 # mouse-2 makes all windows scan vertically, but only the one
779 # the cursor is in scans horizontally
780 proc canvscan {op w x y} {
781 global canv canv2 canv3
782 foreach c [list $canv $canv2 $canv3] {
783 if {$c == $w} {
784 $c scan $op $x $y
785 } else {
786 $c scan $op 0 $y
791 proc scrollcanv {cscroll f0 f1} {
792 $cscroll set $f0 $f1
793 drawfrac $f0 $f1
794 flushhighlights
797 # when we make a key binding for the toplevel, make sure
798 # it doesn't get triggered when that key is pressed in the
799 # find string entry widget.
800 proc bindkey {ev script} {
801 global entries
802 bind . $ev $script
803 set escript [bind Entry $ev]
804 if {$escript == {}} {
805 set escript [bind Entry <Key>]
807 foreach e $entries {
808 bind $e $ev "$escript; break"
812 # set the focus back to the toplevel for any click outside
813 # the entry widgets
814 proc click {w} {
815 global entries
816 foreach e $entries {
817 if {$w == $e} return
819 focus .
822 proc savestuff {w} {
823 global canv canv2 canv3 ctext cflist mainfont textfont uifont
824 global stuffsaved findmergefiles maxgraphpct
825 global maxwidth showneartags
826 global viewname viewfiles viewargs viewperm nextviewnum
827 global cmitmode wrapcomment
828 global colors bgcolor fgcolor diffcolors
830 if {$stuffsaved} return
831 if {![winfo viewable .]} return
832 catch {
833 set f [open "~/.gitk-new" w]
834 puts $f [list set mainfont $mainfont]
835 puts $f [list set textfont $textfont]
836 puts $f [list set uifont $uifont]
837 puts $f [list set findmergefiles $findmergefiles]
838 puts $f [list set maxgraphpct $maxgraphpct]
839 puts $f [list set maxwidth $maxwidth]
840 puts $f [list set cmitmode $cmitmode]
841 puts $f [list set wrapcomment $wrapcomment]
842 puts $f [list set showneartags $showneartags]
843 puts $f [list set bgcolor $bgcolor]
844 puts $f [list set fgcolor $fgcolor]
845 puts $f [list set colors $colors]
846 puts $f [list set diffcolors $diffcolors]
848 puts $f "set geometry(main) [wm geometry .]"
849 puts $f "set geometry(topwidth) [winfo width .tf]"
850 puts $f "set geometry(topheight) [winfo height .tf]"
851 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
852 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
853 puts $f "set geometry(botwidth) [winfo width .bleft]"
854 puts $f "set geometry(botheight) [winfo height .bleft]"
856 puts -nonewline $f "set permviews {"
857 for {set v 0} {$v < $nextviewnum} {incr v} {
858 if {$viewperm($v)} {
859 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
862 puts $f "}"
863 close $f
864 file rename -force "~/.gitk-new" "~/.gitk"
866 set stuffsaved 1
869 proc resizeclistpanes {win w} {
870 global oldwidth
871 if {[info exists oldwidth($win)]} {
872 set s0 [$win sash coord 0]
873 set s1 [$win sash coord 1]
874 if {$w < 60} {
875 set sash0 [expr {int($w/2 - 2)}]
876 set sash1 [expr {int($w*5/6 - 2)}]
877 } else {
878 set factor [expr {1.0 * $w / $oldwidth($win)}]
879 set sash0 [expr {int($factor * [lindex $s0 0])}]
880 set sash1 [expr {int($factor * [lindex $s1 0])}]
881 if {$sash0 < 30} {
882 set sash0 30
884 if {$sash1 < $sash0 + 20} {
885 set sash1 [expr {$sash0 + 20}]
887 if {$sash1 > $w - 10} {
888 set sash1 [expr {$w - 10}]
889 if {$sash0 > $sash1 - 20} {
890 set sash0 [expr {$sash1 - 20}]
894 $win sash place 0 $sash0 [lindex $s0 1]
895 $win sash place 1 $sash1 [lindex $s1 1]
897 set oldwidth($win) $w
900 proc resizecdetpanes {win w} {
901 global oldwidth
902 if {[info exists oldwidth($win)]} {
903 set s0 [$win sash coord 0]
904 if {$w < 60} {
905 set sash0 [expr {int($w*3/4 - 2)}]
906 } else {
907 set factor [expr {1.0 * $w / $oldwidth($win)}]
908 set sash0 [expr {int($factor * [lindex $s0 0])}]
909 if {$sash0 < 45} {
910 set sash0 45
912 if {$sash0 > $w - 15} {
913 set sash0 [expr {$w - 15}]
916 $win sash place 0 $sash0 [lindex $s0 1]
918 set oldwidth($win) $w
921 proc allcanvs args {
922 global canv canv2 canv3
923 eval $canv $args
924 eval $canv2 $args
925 eval $canv3 $args
928 proc bindall {event action} {
929 global canv canv2 canv3
930 bind $canv $event $action
931 bind $canv2 $event $action
932 bind $canv3 $event $action
935 proc about {} {
936 global uifont
937 set w .about
938 if {[winfo exists $w]} {
939 raise $w
940 return
942 toplevel $w
943 wm title $w "About gitk"
944 message $w.m -text {
945 Gitk - a commit viewer for git
947 Copyright © 2005-2006 Paul Mackerras
949 Use and redistribute under the terms of the GNU General Public License} \
950 -justify center -aspect 400 -border 2 -bg white -relief groove
951 pack $w.m -side top -fill x -padx 2 -pady 2
952 $w.m configure -font $uifont
953 button $w.ok -text Close -command "destroy $w" -default active
954 pack $w.ok -side bottom
955 $w.ok configure -font $uifont
956 bind $w <Visibility> "focus $w.ok"
957 bind $w <Key-Escape> "destroy $w"
958 bind $w <Key-Return> "destroy $w"
961 proc keys {} {
962 global uifont
963 set w .keys
964 if {[winfo exists $w]} {
965 raise $w
966 return
968 toplevel $w
969 wm title $w "Gitk key bindings"
970 message $w.m -text {
971 Gitk key bindings:
973 <Ctrl-Q> Quit
974 <Home> Move to first commit
975 <End> Move to last commit
976 <Up>, p, i Move up one commit
977 <Down>, n, k Move down one commit
978 <Left>, z, j Go back in history list
979 <Right>, x, l Go forward in history list
980 <PageUp> Move up one page in commit list
981 <PageDown> Move down one page in commit list
982 <Ctrl-Home> Scroll to top of commit list
983 <Ctrl-End> Scroll to bottom of commit list
984 <Ctrl-Up> Scroll commit list up one line
985 <Ctrl-Down> Scroll commit list down one line
986 <Ctrl-PageUp> Scroll commit list up one page
987 <Ctrl-PageDown> Scroll commit list down one page
988 <Shift-Up> Move to previous highlighted line
989 <Shift-Down> Move to next highlighted line
990 <Delete>, b Scroll diff view up one page
991 <Backspace> Scroll diff view up one page
992 <Space> Scroll diff view down one page
993 u Scroll diff view up 18 lines
994 d Scroll diff view down 18 lines
995 <Ctrl-F> Find
996 <Ctrl-G> Move to next find hit
997 <Return> Move to next find hit
998 / Move to next find hit, or redo find
999 ? Move to previous find hit
1000 f Scroll diff view to next file
1001 <Ctrl-S> Search for next hit in diff view
1002 <Ctrl-R> Search for previous hit in diff view
1003 <Ctrl-KP+> Increase font size
1004 <Ctrl-plus> Increase font size
1005 <Ctrl-KP-> Decrease font size
1006 <Ctrl-minus> Decrease font size
1007 <F5> Update
1009 -justify left -bg white -border 2 -relief groove
1010 pack $w.m -side top -fill both -padx 2 -pady 2
1011 $w.m configure -font $uifont
1012 button $w.ok -text Close -command "destroy $w" -default active
1013 pack $w.ok -side bottom
1014 $w.ok configure -font $uifont
1015 bind $w <Visibility> "focus $w.ok"
1016 bind $w <Key-Escape> "destroy $w"
1017 bind $w <Key-Return> "destroy $w"
1020 # Procedures for manipulating the file list window at the
1021 # bottom right of the overall window.
1023 proc treeview {w l openlevs} {
1024 global treecontents treediropen treeheight treeparent treeindex
1026 set ix 0
1027 set treeindex() 0
1028 set lev 0
1029 set prefix {}
1030 set prefixend -1
1031 set prefendstack {}
1032 set htstack {}
1033 set ht 0
1034 set treecontents() {}
1035 $w conf -state normal
1036 foreach f $l {
1037 while {[string range $f 0 $prefixend] ne $prefix} {
1038 if {$lev <= $openlevs} {
1039 $w mark set e:$treeindex($prefix) "end -1c"
1040 $w mark gravity e:$treeindex($prefix) left
1042 set treeheight($prefix) $ht
1043 incr ht [lindex $htstack end]
1044 set htstack [lreplace $htstack end end]
1045 set prefixend [lindex $prefendstack end]
1046 set prefendstack [lreplace $prefendstack end end]
1047 set prefix [string range $prefix 0 $prefixend]
1048 incr lev -1
1050 set tail [string range $f [expr {$prefixend+1}] end]
1051 while {[set slash [string first "/" $tail]] >= 0} {
1052 lappend htstack $ht
1053 set ht 0
1054 lappend prefendstack $prefixend
1055 incr prefixend [expr {$slash + 1}]
1056 set d [string range $tail 0 $slash]
1057 lappend treecontents($prefix) $d
1058 set oldprefix $prefix
1059 append prefix $d
1060 set treecontents($prefix) {}
1061 set treeindex($prefix) [incr ix]
1062 set treeparent($prefix) $oldprefix
1063 set tail [string range $tail [expr {$slash+1}] end]
1064 if {$lev <= $openlevs} {
1065 set ht 1
1066 set treediropen($prefix) [expr {$lev < $openlevs}]
1067 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1068 $w mark set d:$ix "end -1c"
1069 $w mark gravity d:$ix left
1070 set str "\n"
1071 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1072 $w insert end $str
1073 $w image create end -align center -image $bm -padx 1 \
1074 -name a:$ix
1075 $w insert end $d [highlight_tag $prefix]
1076 $w mark set s:$ix "end -1c"
1077 $w mark gravity s:$ix left
1079 incr lev
1081 if {$tail ne {}} {
1082 if {$lev <= $openlevs} {
1083 incr ht
1084 set str "\n"
1085 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1086 $w insert end $str
1087 $w insert end $tail [highlight_tag $f]
1089 lappend treecontents($prefix) $tail
1092 while {$htstack ne {}} {
1093 set treeheight($prefix) $ht
1094 incr ht [lindex $htstack end]
1095 set htstack [lreplace $htstack end end]
1097 $w conf -state disabled
1100 proc linetoelt {l} {
1101 global treeheight treecontents
1103 set y 2
1104 set prefix {}
1105 while {1} {
1106 foreach e $treecontents($prefix) {
1107 if {$y == $l} {
1108 return "$prefix$e"
1110 set n 1
1111 if {[string index $e end] eq "/"} {
1112 set n $treeheight($prefix$e)
1113 if {$y + $n > $l} {
1114 append prefix $e
1115 incr y
1116 break
1119 incr y $n
1124 proc highlight_tree {y prefix} {
1125 global treeheight treecontents cflist
1127 foreach e $treecontents($prefix) {
1128 set path $prefix$e
1129 if {[highlight_tag $path] ne {}} {
1130 $cflist tag add bold $y.0 "$y.0 lineend"
1132 incr y
1133 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1134 set y [highlight_tree $y $path]
1137 return $y
1140 proc treeclosedir {w dir} {
1141 global treediropen treeheight treeparent treeindex
1143 set ix $treeindex($dir)
1144 $w conf -state normal
1145 $w delete s:$ix e:$ix
1146 set treediropen($dir) 0
1147 $w image configure a:$ix -image tri-rt
1148 $w conf -state disabled
1149 set n [expr {1 - $treeheight($dir)}]
1150 while {$dir ne {}} {
1151 incr treeheight($dir) $n
1152 set dir $treeparent($dir)
1156 proc treeopendir {w dir} {
1157 global treediropen treeheight treeparent treecontents treeindex
1159 set ix $treeindex($dir)
1160 $w conf -state normal
1161 $w image configure a:$ix -image tri-dn
1162 $w mark set e:$ix s:$ix
1163 $w mark gravity e:$ix right
1164 set lev 0
1165 set str "\n"
1166 set n [llength $treecontents($dir)]
1167 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1168 incr lev
1169 append str "\t"
1170 incr treeheight($x) $n
1172 foreach e $treecontents($dir) {
1173 set de $dir$e
1174 if {[string index $e end] eq "/"} {
1175 set iy $treeindex($de)
1176 $w mark set d:$iy e:$ix
1177 $w mark gravity d:$iy left
1178 $w insert e:$ix $str
1179 set treediropen($de) 0
1180 $w image create e:$ix -align center -image tri-rt -padx 1 \
1181 -name a:$iy
1182 $w insert e:$ix $e [highlight_tag $de]
1183 $w mark set s:$iy e:$ix
1184 $w mark gravity s:$iy left
1185 set treeheight($de) 1
1186 } else {
1187 $w insert e:$ix $str
1188 $w insert e:$ix $e [highlight_tag $de]
1191 $w mark gravity e:$ix left
1192 $w conf -state disabled
1193 set treediropen($dir) 1
1194 set top [lindex [split [$w index @0,0] .] 0]
1195 set ht [$w cget -height]
1196 set l [lindex [split [$w index s:$ix] .] 0]
1197 if {$l < $top} {
1198 $w yview $l.0
1199 } elseif {$l + $n + 1 > $top + $ht} {
1200 set top [expr {$l + $n + 2 - $ht}]
1201 if {$l < $top} {
1202 set top $l
1204 $w yview $top.0
1208 proc treeclick {w x y} {
1209 global treediropen cmitmode ctext cflist cflist_top
1211 if {$cmitmode ne "tree"} return
1212 if {![info exists cflist_top]} return
1213 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1214 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1215 $cflist tag add highlight $l.0 "$l.0 lineend"
1216 set cflist_top $l
1217 if {$l == 1} {
1218 $ctext yview 1.0
1219 return
1221 set e [linetoelt $l]
1222 if {[string index $e end] ne "/"} {
1223 showfile $e
1224 } elseif {$treediropen($e)} {
1225 treeclosedir $w $e
1226 } else {
1227 treeopendir $w $e
1231 proc setfilelist {id} {
1232 global treefilelist cflist
1234 treeview $cflist $treefilelist($id) 0
1237 image create bitmap tri-rt -background black -foreground blue -data {
1238 #define tri-rt_width 13
1239 #define tri-rt_height 13
1240 static unsigned char tri-rt_bits[] = {
1241 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1242 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1243 0x00, 0x00};
1244 } -maskdata {
1245 #define tri-rt-mask_width 13
1246 #define tri-rt-mask_height 13
1247 static unsigned char tri-rt-mask_bits[] = {
1248 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1249 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1250 0x08, 0x00};
1252 image create bitmap tri-dn -background black -foreground blue -data {
1253 #define tri-dn_width 13
1254 #define tri-dn_height 13
1255 static unsigned char tri-dn_bits[] = {
1256 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1257 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1258 0x00, 0x00};
1259 } -maskdata {
1260 #define tri-dn-mask_width 13
1261 #define tri-dn-mask_height 13
1262 static unsigned char tri-dn-mask_bits[] = {
1263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1264 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1265 0x00, 0x00};
1268 proc init_flist {first} {
1269 global cflist cflist_top selectedline difffilestart
1271 $cflist conf -state normal
1272 $cflist delete 0.0 end
1273 if {$first ne {}} {
1274 $cflist insert end $first
1275 set cflist_top 1
1276 $cflist tag add highlight 1.0 "1.0 lineend"
1277 } else {
1278 catch {unset cflist_top}
1280 $cflist conf -state disabled
1281 set difffilestart {}
1284 proc highlight_tag {f} {
1285 global highlight_paths
1287 foreach p $highlight_paths {
1288 if {[string match $p $f]} {
1289 return "bold"
1292 return {}
1295 proc highlight_filelist {} {
1296 global cmitmode cflist
1298 $cflist conf -state normal
1299 if {$cmitmode ne "tree"} {
1300 set end [lindex [split [$cflist index end] .] 0]
1301 for {set l 2} {$l < $end} {incr l} {
1302 set line [$cflist get $l.0 "$l.0 lineend"]
1303 if {[highlight_tag $line] ne {}} {
1304 $cflist tag add bold $l.0 "$l.0 lineend"
1307 } else {
1308 highlight_tree 2 {}
1310 $cflist conf -state disabled
1313 proc unhighlight_filelist {} {
1314 global cflist
1316 $cflist conf -state normal
1317 $cflist tag remove bold 1.0 end
1318 $cflist conf -state disabled
1321 proc add_flist {fl} {
1322 global cflist
1324 $cflist conf -state normal
1325 foreach f $fl {
1326 $cflist insert end "\n"
1327 $cflist insert end $f [highlight_tag $f]
1329 $cflist conf -state disabled
1332 proc sel_flist {w x y} {
1333 global ctext difffilestart cflist cflist_top cmitmode
1335 if {$cmitmode eq "tree"} return
1336 if {![info exists cflist_top]} return
1337 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1338 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1339 $cflist tag add highlight $l.0 "$l.0 lineend"
1340 set cflist_top $l
1341 if {$l == 1} {
1342 $ctext yview 1.0
1343 } else {
1344 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1348 # Functions for adding and removing shell-type quoting
1350 proc shellquote {str} {
1351 if {![string match "*\['\"\\ \t]*" $str]} {
1352 return $str
1354 if {![string match "*\['\"\\]*" $str]} {
1355 return "\"$str\""
1357 if {![string match "*'*" $str]} {
1358 return "'$str'"
1360 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1363 proc shellarglist {l} {
1364 set str {}
1365 foreach a $l {
1366 if {$str ne {}} {
1367 append str " "
1369 append str [shellquote $a]
1371 return $str
1374 proc shelldequote {str} {
1375 set ret {}
1376 set used -1
1377 while {1} {
1378 incr used
1379 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1380 append ret [string range $str $used end]
1381 set used [string length $str]
1382 break
1384 set first [lindex $first 0]
1385 set ch [string index $str $first]
1386 if {$first > $used} {
1387 append ret [string range $str $used [expr {$first - 1}]]
1388 set used $first
1390 if {$ch eq " " || $ch eq "\t"} break
1391 incr used
1392 if {$ch eq "'"} {
1393 set first [string first "'" $str $used]
1394 if {$first < 0} {
1395 error "unmatched single-quote"
1397 append ret [string range $str $used [expr {$first - 1}]]
1398 set used $first
1399 continue
1401 if {$ch eq "\\"} {
1402 if {$used >= [string length $str]} {
1403 error "trailing backslash"
1405 append ret [string index $str $used]
1406 continue
1408 # here ch == "\""
1409 while {1} {
1410 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1411 error "unmatched double-quote"
1413 set first [lindex $first 0]
1414 set ch [string index $str $first]
1415 if {$first > $used} {
1416 append ret [string range $str $used [expr {$first - 1}]]
1417 set used $first
1419 if {$ch eq "\""} break
1420 incr used
1421 append ret [string index $str $used]
1422 incr used
1425 return [list $used $ret]
1428 proc shellsplit {str} {
1429 set l {}
1430 while {1} {
1431 set str [string trimleft $str]
1432 if {$str eq {}} break
1433 set dq [shelldequote $str]
1434 set n [lindex $dq 0]
1435 set word [lindex $dq 1]
1436 set str [string range $str $n end]
1437 lappend l $word
1439 return $l
1442 # Code to implement multiple views
1444 proc newview {ishighlight} {
1445 global nextviewnum newviewname newviewperm uifont newishighlight
1446 global newviewargs revtreeargs
1448 set newishighlight $ishighlight
1449 set top .gitkview
1450 if {[winfo exists $top]} {
1451 raise $top
1452 return
1454 set newviewname($nextviewnum) "View $nextviewnum"
1455 set newviewperm($nextviewnum) 0
1456 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1457 vieweditor $top $nextviewnum "Gitk view definition"
1460 proc editview {} {
1461 global curview
1462 global viewname viewperm newviewname newviewperm
1463 global viewargs newviewargs
1465 set top .gitkvedit-$curview
1466 if {[winfo exists $top]} {
1467 raise $top
1468 return
1470 set newviewname($curview) $viewname($curview)
1471 set newviewperm($curview) $viewperm($curview)
1472 set newviewargs($curview) [shellarglist $viewargs($curview)]
1473 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1476 proc vieweditor {top n title} {
1477 global newviewname newviewperm viewfiles
1478 global uifont
1480 toplevel $top
1481 wm title $top $title
1482 label $top.nl -text "Name" -font $uifont
1483 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1484 grid $top.nl $top.name -sticky w -pady 5
1485 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1486 -font $uifont
1487 grid $top.perm - -pady 5 -sticky w
1488 message $top.al -aspect 1000 -font $uifont \
1489 -text "Commits to include (arguments to git rev-list):"
1490 grid $top.al - -sticky w -pady 5
1491 entry $top.args -width 50 -textvariable newviewargs($n) \
1492 -background white -font $uifont
1493 grid $top.args - -sticky ew -padx 5
1494 message $top.l -aspect 1000 -font $uifont \
1495 -text "Enter files and directories to include, one per line:"
1496 grid $top.l - -sticky w
1497 text $top.t -width 40 -height 10 -background white -font $uifont
1498 if {[info exists viewfiles($n)]} {
1499 foreach f $viewfiles($n) {
1500 $top.t insert end $f
1501 $top.t insert end "\n"
1503 $top.t delete {end - 1c} end
1504 $top.t mark set insert 0.0
1506 grid $top.t - -sticky ew -padx 5
1507 frame $top.buts
1508 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1509 -font $uifont
1510 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1511 -font $uifont
1512 grid $top.buts.ok $top.buts.can
1513 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1514 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1515 grid $top.buts - -pady 10 -sticky ew
1516 focus $top.t
1519 proc doviewmenu {m first cmd op argv} {
1520 set nmenu [$m index end]
1521 for {set i $first} {$i <= $nmenu} {incr i} {
1522 if {[$m entrycget $i -command] eq $cmd} {
1523 eval $m $op $i $argv
1524 break
1529 proc allviewmenus {n op args} {
1530 global viewhlmenu
1532 doviewmenu .bar.view 5 [list showview $n] $op $args
1533 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1536 proc newviewok {top n} {
1537 global nextviewnum newviewperm newviewname newishighlight
1538 global viewname viewfiles viewperm selectedview curview
1539 global viewargs newviewargs viewhlmenu
1541 if {[catch {
1542 set newargs [shellsplit $newviewargs($n)]
1543 } err]} {
1544 error_popup "Error in commit selection arguments: $err"
1545 wm raise $top
1546 focus $top
1547 return
1549 set files {}
1550 foreach f [split [$top.t get 0.0 end] "\n"] {
1551 set ft [string trim $f]
1552 if {$ft ne {}} {
1553 lappend files $ft
1556 if {![info exists viewfiles($n)]} {
1557 # creating a new view
1558 incr nextviewnum
1559 set viewname($n) $newviewname($n)
1560 set viewperm($n) $newviewperm($n)
1561 set viewfiles($n) $files
1562 set viewargs($n) $newargs
1563 addviewmenu $n
1564 if {!$newishighlight} {
1565 after idle showview $n
1566 } else {
1567 after idle addvhighlight $n
1569 } else {
1570 # editing an existing view
1571 set viewperm($n) $newviewperm($n)
1572 if {$newviewname($n) ne $viewname($n)} {
1573 set viewname($n) $newviewname($n)
1574 doviewmenu .bar.view 5 [list showview $n] \
1575 entryconf [list -label $viewname($n)]
1576 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1577 entryconf [list -label $viewname($n) -value $viewname($n)]
1579 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1580 set viewfiles($n) $files
1581 set viewargs($n) $newargs
1582 if {$curview == $n} {
1583 after idle updatecommits
1587 catch {destroy $top}
1590 proc delview {} {
1591 global curview viewdata viewperm hlview selectedhlview
1593 if {$curview == 0} return
1594 if {[info exists hlview] && $hlview == $curview} {
1595 set selectedhlview None
1596 unset hlview
1598 allviewmenus $curview delete
1599 set viewdata($curview) {}
1600 set viewperm($curview) 0
1601 showview 0
1604 proc addviewmenu {n} {
1605 global viewname viewhlmenu
1607 .bar.view add radiobutton -label $viewname($n) \
1608 -command [list showview $n] -variable selectedview -value $n
1609 $viewhlmenu add radiobutton -label $viewname($n) \
1610 -command [list addvhighlight $n] -variable selectedhlview
1613 proc flatten {var} {
1614 global $var
1616 set ret {}
1617 foreach i [array names $var] {
1618 lappend ret $i [set $var\($i\)]
1620 return $ret
1623 proc unflatten {var l} {
1624 global $var
1626 catch {unset $var}
1627 foreach {i v} $l {
1628 set $var\($i\) $v
1632 proc showview {n} {
1633 global curview viewdata viewfiles
1634 global displayorder parentlist childlist rowidlist rowoffsets
1635 global colormap rowtextx commitrow nextcolor canvxmax
1636 global numcommits rowrangelist commitlisted idrowranges
1637 global selectedline currentid canv canvy0
1638 global matchinglines treediffs
1639 global pending_select phase
1640 global commitidx rowlaidout rowoptim linesegends
1641 global commfd nextupdate
1642 global selectedview
1643 global vparentlist vchildlist vdisporder vcmitlisted
1644 global hlview selectedhlview
1646 if {$n == $curview} return
1647 set selid {}
1648 if {[info exists selectedline]} {
1649 set selid $currentid
1650 set y [yc $selectedline]
1651 set ymax [lindex [$canv cget -scrollregion] 3]
1652 set span [$canv yview]
1653 set ytop [expr {[lindex $span 0] * $ymax}]
1654 set ybot [expr {[lindex $span 1] * $ymax}]
1655 if {$ytop < $y && $y < $ybot} {
1656 set yscreen [expr {$y - $ytop}]
1657 } else {
1658 set yscreen [expr {($ybot - $ytop) / 2}]
1661 unselectline
1662 normalline
1663 stopfindproc
1664 if {$curview >= 0} {
1665 set vparentlist($curview) $parentlist
1666 set vchildlist($curview) $childlist
1667 set vdisporder($curview) $displayorder
1668 set vcmitlisted($curview) $commitlisted
1669 if {$phase ne {}} {
1670 set viewdata($curview) \
1671 [list $phase $rowidlist $rowoffsets $rowrangelist \
1672 [flatten idrowranges] [flatten idinlist] \
1673 $rowlaidout $rowoptim $numcommits $linesegends]
1674 } elseif {![info exists viewdata($curview)]
1675 || [lindex $viewdata($curview) 0] ne {}} {
1676 set viewdata($curview) \
1677 [list {} $rowidlist $rowoffsets $rowrangelist]
1680 catch {unset matchinglines}
1681 catch {unset treediffs}
1682 clear_display
1683 if {[info exists hlview] && $hlview == $n} {
1684 unset hlview
1685 set selectedhlview None
1688 set curview $n
1689 set selectedview $n
1690 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1691 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1693 if {![info exists viewdata($n)]} {
1694 set pending_select $selid
1695 getcommits
1696 return
1699 set v $viewdata($n)
1700 set phase [lindex $v 0]
1701 set displayorder $vdisporder($n)
1702 set parentlist $vparentlist($n)
1703 set childlist $vchildlist($n)
1704 set commitlisted $vcmitlisted($n)
1705 set rowidlist [lindex $v 1]
1706 set rowoffsets [lindex $v 2]
1707 set rowrangelist [lindex $v 3]
1708 if {$phase eq {}} {
1709 set numcommits [llength $displayorder]
1710 catch {unset idrowranges}
1711 } else {
1712 unflatten idrowranges [lindex $v 4]
1713 unflatten idinlist [lindex $v 5]
1714 set rowlaidout [lindex $v 6]
1715 set rowoptim [lindex $v 7]
1716 set numcommits [lindex $v 8]
1717 set linesegends [lindex $v 9]
1720 catch {unset colormap}
1721 catch {unset rowtextx}
1722 set nextcolor 0
1723 set canvxmax [$canv cget -width]
1724 set curview $n
1725 set row 0
1726 setcanvscroll
1727 set yf 0
1728 set row 0
1729 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1730 set row $commitrow($n,$selid)
1731 # try to get the selected row in the same position on the screen
1732 set ymax [lindex [$canv cget -scrollregion] 3]
1733 set ytop [expr {[yc $row] - $yscreen}]
1734 if {$ytop < 0} {
1735 set ytop 0
1737 set yf [expr {$ytop * 1.0 / $ymax}]
1739 allcanvs yview moveto $yf
1740 drawvisible
1741 selectline $row 0
1742 if {$phase ne {}} {
1743 if {$phase eq "getcommits"} {
1744 show_status "Reading commits..."
1746 if {[info exists commfd($n)]} {
1747 layoutmore {}
1748 } else {
1749 finishcommits
1751 } elseif {$numcommits == 0} {
1752 show_status "No commits selected"
1756 # Stuff relating to the highlighting facility
1758 proc ishighlighted {row} {
1759 global vhighlights fhighlights nhighlights rhighlights
1761 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1762 return $nhighlights($row)
1764 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1765 return $vhighlights($row)
1767 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1768 return $fhighlights($row)
1770 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1771 return $rhighlights($row)
1773 return 0
1776 proc bolden {row font} {
1777 global canv linehtag selectedline boldrows
1779 lappend boldrows $row
1780 $canv itemconf $linehtag($row) -font $font
1781 if {[info exists selectedline] && $row == $selectedline} {
1782 $canv delete secsel
1783 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1784 -outline {{}} -tags secsel \
1785 -fill [$canv cget -selectbackground]]
1786 $canv lower $t
1790 proc bolden_name {row font} {
1791 global canv2 linentag selectedline boldnamerows
1793 lappend boldnamerows $row
1794 $canv2 itemconf $linentag($row) -font $font
1795 if {[info exists selectedline] && $row == $selectedline} {
1796 $canv2 delete secsel
1797 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1798 -outline {{}} -tags secsel \
1799 -fill [$canv2 cget -selectbackground]]
1800 $canv2 lower $t
1804 proc unbolden {} {
1805 global mainfont boldrows
1807 set stillbold {}
1808 foreach row $boldrows {
1809 if {![ishighlighted $row]} {
1810 bolden $row $mainfont
1811 } else {
1812 lappend stillbold $row
1815 set boldrows $stillbold
1818 proc addvhighlight {n} {
1819 global hlview curview viewdata vhl_done vhighlights commitidx
1821 if {[info exists hlview]} {
1822 delvhighlight
1824 set hlview $n
1825 if {$n != $curview && ![info exists viewdata($n)]} {
1826 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1827 set vparentlist($n) {}
1828 set vchildlist($n) {}
1829 set vdisporder($n) {}
1830 set vcmitlisted($n) {}
1831 start_rev_list $n
1833 set vhl_done $commitidx($hlview)
1834 if {$vhl_done > 0} {
1835 drawvisible
1839 proc delvhighlight {} {
1840 global hlview vhighlights
1842 if {![info exists hlview]} return
1843 unset hlview
1844 catch {unset vhighlights}
1845 unbolden
1848 proc vhighlightmore {} {
1849 global hlview vhl_done commitidx vhighlights
1850 global displayorder vdisporder curview mainfont
1852 set font [concat $mainfont bold]
1853 set max $commitidx($hlview)
1854 if {$hlview == $curview} {
1855 set disp $displayorder
1856 } else {
1857 set disp $vdisporder($hlview)
1859 set vr [visiblerows]
1860 set r0 [lindex $vr 0]
1861 set r1 [lindex $vr 1]
1862 for {set i $vhl_done} {$i < $max} {incr i} {
1863 set id [lindex $disp $i]
1864 if {[info exists commitrow($curview,$id)]} {
1865 set row $commitrow($curview,$id)
1866 if {$r0 <= $row && $row <= $r1} {
1867 if {![highlighted $row]} {
1868 bolden $row $font
1870 set vhighlights($row) 1
1874 set vhl_done $max
1877 proc askvhighlight {row id} {
1878 global hlview vhighlights commitrow iddrawn mainfont
1880 if {[info exists commitrow($hlview,$id)]} {
1881 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1882 bolden $row [concat $mainfont bold]
1884 set vhighlights($row) 1
1885 } else {
1886 set vhighlights($row) 0
1890 proc hfiles_change {name ix op} {
1891 global highlight_files filehighlight fhighlights fh_serial
1892 global mainfont highlight_paths
1894 if {[info exists filehighlight]} {
1895 # delete previous highlights
1896 catch {close $filehighlight}
1897 unset filehighlight
1898 catch {unset fhighlights}
1899 unbolden
1900 unhighlight_filelist
1902 set highlight_paths {}
1903 after cancel do_file_hl $fh_serial
1904 incr fh_serial
1905 if {$highlight_files ne {}} {
1906 after 300 do_file_hl $fh_serial
1910 proc makepatterns {l} {
1911 set ret {}
1912 foreach e $l {
1913 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1914 if {[string index $ee end] eq "/"} {
1915 lappend ret "$ee*"
1916 } else {
1917 lappend ret $ee
1918 lappend ret "$ee/*"
1921 return $ret
1924 proc do_file_hl {serial} {
1925 global highlight_files filehighlight highlight_paths gdttype fhl_list
1927 if {$gdttype eq "touching paths:"} {
1928 if {[catch {set paths [shellsplit $highlight_files]}]} return
1929 set highlight_paths [makepatterns $paths]
1930 highlight_filelist
1931 set gdtargs [concat -- $paths]
1932 } else {
1933 set gdtargs [list "-S$highlight_files"]
1935 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1936 set filehighlight [open $cmd r+]
1937 fconfigure $filehighlight -blocking 0
1938 fileevent $filehighlight readable readfhighlight
1939 set fhl_list {}
1940 drawvisible
1941 flushhighlights
1944 proc flushhighlights {} {
1945 global filehighlight fhl_list
1947 if {[info exists filehighlight]} {
1948 lappend fhl_list {}
1949 puts $filehighlight ""
1950 flush $filehighlight
1954 proc askfilehighlight {row id} {
1955 global filehighlight fhighlights fhl_list
1957 lappend fhl_list $id
1958 set fhighlights($row) -1
1959 puts $filehighlight $id
1962 proc readfhighlight {} {
1963 global filehighlight fhighlights commitrow curview mainfont iddrawn
1964 global fhl_list
1966 while {[gets $filehighlight line] >= 0} {
1967 set line [string trim $line]
1968 set i [lsearch -exact $fhl_list $line]
1969 if {$i < 0} continue
1970 for {set j 0} {$j < $i} {incr j} {
1971 set id [lindex $fhl_list $j]
1972 if {[info exists commitrow($curview,$id)]} {
1973 set fhighlights($commitrow($curview,$id)) 0
1976 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1977 if {$line eq {}} continue
1978 if {![info exists commitrow($curview,$line)]} continue
1979 set row $commitrow($curview,$line)
1980 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1981 bolden $row [concat $mainfont bold]
1983 set fhighlights($row) 1
1985 if {[eof $filehighlight]} {
1986 # strange...
1987 puts "oops, git diff-tree died"
1988 catch {close $filehighlight}
1989 unset filehighlight
1991 next_hlcont
1994 proc find_change {name ix op} {
1995 global nhighlights mainfont boldnamerows
1996 global findstring findpattern findtype
1998 # delete previous highlights, if any
1999 foreach row $boldnamerows {
2000 bolden_name $row $mainfont
2002 set boldnamerows {}
2003 catch {unset nhighlights}
2004 unbolden
2005 if {$findtype ne "Regexp"} {
2006 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2007 $findstring]
2008 set findpattern "*$e*"
2010 drawvisible
2013 proc askfindhighlight {row id} {
2014 global nhighlights commitinfo iddrawn mainfont
2015 global findstring findtype findloc findpattern
2017 if {![info exists commitinfo($id)]} {
2018 getcommit $id
2020 set info $commitinfo($id)
2021 set isbold 0
2022 set fldtypes {Headline Author Date Committer CDate Comments}
2023 foreach f $info ty $fldtypes {
2024 if {$findloc ne "All fields" && $findloc ne $ty} {
2025 continue
2027 if {$findtype eq "Regexp"} {
2028 set doesmatch [regexp $findstring $f]
2029 } elseif {$findtype eq "IgnCase"} {
2030 set doesmatch [string match -nocase $findpattern $f]
2031 } else {
2032 set doesmatch [string match $findpattern $f]
2034 if {$doesmatch} {
2035 if {$ty eq "Author"} {
2036 set isbold 2
2037 } else {
2038 set isbold 1
2042 if {[info exists iddrawn($id)]} {
2043 if {$isbold && ![ishighlighted $row]} {
2044 bolden $row [concat $mainfont bold]
2046 if {$isbold >= 2} {
2047 bolden_name $row [concat $mainfont bold]
2050 set nhighlights($row) $isbold
2053 proc vrel_change {name ix op} {
2054 global highlight_related
2056 rhighlight_none
2057 if {$highlight_related ne "None"} {
2058 after idle drawvisible
2062 # prepare for testing whether commits are descendents or ancestors of a
2063 proc rhighlight_sel {a} {
2064 global descendent desc_todo ancestor anc_todo
2065 global highlight_related rhighlights
2067 catch {unset descendent}
2068 set desc_todo [list $a]
2069 catch {unset ancestor}
2070 set anc_todo [list $a]
2071 if {$highlight_related ne "None"} {
2072 rhighlight_none
2073 after idle drawvisible
2077 proc rhighlight_none {} {
2078 global rhighlights
2080 catch {unset rhighlights}
2081 unbolden
2084 proc is_descendent {a} {
2085 global curview children commitrow descendent desc_todo
2087 set v $curview
2088 set la $commitrow($v,$a)
2089 set todo $desc_todo
2090 set leftover {}
2091 set done 0
2092 for {set i 0} {$i < [llength $todo]} {incr i} {
2093 set do [lindex $todo $i]
2094 if {$commitrow($v,$do) < $la} {
2095 lappend leftover $do
2096 continue
2098 foreach nk $children($v,$do) {
2099 if {![info exists descendent($nk)]} {
2100 set descendent($nk) 1
2101 lappend todo $nk
2102 if {$nk eq $a} {
2103 set done 1
2107 if {$done} {
2108 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2109 return
2112 set descendent($a) 0
2113 set desc_todo $leftover
2116 proc is_ancestor {a} {
2117 global curview parentlist commitrow ancestor anc_todo
2119 set v $curview
2120 set la $commitrow($v,$a)
2121 set todo $anc_todo
2122 set leftover {}
2123 set done 0
2124 for {set i 0} {$i < [llength $todo]} {incr i} {
2125 set do [lindex $todo $i]
2126 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2127 lappend leftover $do
2128 continue
2130 foreach np [lindex $parentlist $commitrow($v,$do)] {
2131 if {![info exists ancestor($np)]} {
2132 set ancestor($np) 1
2133 lappend todo $np
2134 if {$np eq $a} {
2135 set done 1
2139 if {$done} {
2140 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2141 return
2144 set ancestor($a) 0
2145 set anc_todo $leftover
2148 proc askrelhighlight {row id} {
2149 global descendent highlight_related iddrawn mainfont rhighlights
2150 global selectedline ancestor
2152 if {![info exists selectedline]} return
2153 set isbold 0
2154 if {$highlight_related eq "Descendent" ||
2155 $highlight_related eq "Not descendent"} {
2156 if {![info exists descendent($id)]} {
2157 is_descendent $id
2159 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2160 set isbold 1
2162 } elseif {$highlight_related eq "Ancestor" ||
2163 $highlight_related eq "Not ancestor"} {
2164 if {![info exists ancestor($id)]} {
2165 is_ancestor $id
2167 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2168 set isbold 1
2171 if {[info exists iddrawn($id)]} {
2172 if {$isbold && ![ishighlighted $row]} {
2173 bolden $row [concat $mainfont bold]
2176 set rhighlights($row) $isbold
2179 proc next_hlcont {} {
2180 global fhl_row fhl_dirn displayorder numcommits
2181 global vhighlights fhighlights nhighlights rhighlights
2182 global hlview filehighlight findstring highlight_related
2184 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2185 set row $fhl_row
2186 while {1} {
2187 if {$row < 0 || $row >= $numcommits} {
2188 bell
2189 set fhl_dirn 0
2190 return
2192 set id [lindex $displayorder $row]
2193 if {[info exists hlview]} {
2194 if {![info exists vhighlights($row)]} {
2195 askvhighlight $row $id
2197 if {$vhighlights($row) > 0} break
2199 if {$findstring ne {}} {
2200 if {![info exists nhighlights($row)]} {
2201 askfindhighlight $row $id
2203 if {$nhighlights($row) > 0} break
2205 if {$highlight_related ne "None"} {
2206 if {![info exists rhighlights($row)]} {
2207 askrelhighlight $row $id
2209 if {$rhighlights($row) > 0} break
2211 if {[info exists filehighlight]} {
2212 if {![info exists fhighlights($row)]} {
2213 # ask for a few more while we're at it...
2214 set r $row
2215 for {set n 0} {$n < 100} {incr n} {
2216 if {![info exists fhighlights($r)]} {
2217 askfilehighlight $r [lindex $displayorder $r]
2219 incr r $fhl_dirn
2220 if {$r < 0 || $r >= $numcommits} break
2222 flushhighlights
2224 if {$fhighlights($row) < 0} {
2225 set fhl_row $row
2226 return
2228 if {$fhighlights($row) > 0} break
2230 incr row $fhl_dirn
2232 set fhl_dirn 0
2233 selectline $row 1
2236 proc next_highlight {dirn} {
2237 global selectedline fhl_row fhl_dirn
2238 global hlview filehighlight findstring highlight_related
2240 if {![info exists selectedline]} return
2241 if {!([info exists hlview] || $findstring ne {} ||
2242 $highlight_related ne "None" || [info exists filehighlight])} return
2243 set fhl_row [expr {$selectedline + $dirn}]
2244 set fhl_dirn $dirn
2245 next_hlcont
2248 proc cancel_next_highlight {} {
2249 global fhl_dirn
2251 set fhl_dirn 0
2254 # Graph layout functions
2256 proc shortids {ids} {
2257 set res {}
2258 foreach id $ids {
2259 if {[llength $id] > 1} {
2260 lappend res [shortids $id]
2261 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2262 lappend res [string range $id 0 7]
2263 } else {
2264 lappend res $id
2267 return $res
2270 proc incrange {l x o} {
2271 set n [llength $l]
2272 while {$x < $n} {
2273 set e [lindex $l $x]
2274 if {$e ne {}} {
2275 lset l $x [expr {$e + $o}]
2277 incr x
2279 return $l
2282 proc ntimes {n o} {
2283 set ret {}
2284 for {} {$n > 0} {incr n -1} {
2285 lappend ret $o
2287 return $ret
2290 proc usedinrange {id l1 l2} {
2291 global children commitrow childlist curview
2293 if {[info exists commitrow($curview,$id)]} {
2294 set r $commitrow($curview,$id)
2295 if {$l1 <= $r && $r <= $l2} {
2296 return [expr {$r - $l1 + 1}]
2298 set kids [lindex $childlist $r]
2299 } else {
2300 set kids $children($curview,$id)
2302 foreach c $kids {
2303 set r $commitrow($curview,$c)
2304 if {$l1 <= $r && $r <= $l2} {
2305 return [expr {$r - $l1 + 1}]
2308 return 0
2311 proc sanity {row {full 0}} {
2312 global rowidlist rowoffsets
2314 set col -1
2315 set ids [lindex $rowidlist $row]
2316 foreach id $ids {
2317 incr col
2318 if {$id eq {}} continue
2319 if {$col < [llength $ids] - 1 &&
2320 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2321 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2323 set o [lindex $rowoffsets $row $col]
2324 set y $row
2325 set x $col
2326 while {$o ne {}} {
2327 incr y -1
2328 incr x $o
2329 if {[lindex $rowidlist $y $x] != $id} {
2330 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2331 puts " id=[shortids $id] check started at row $row"
2332 for {set i $row} {$i >= $y} {incr i -1} {
2333 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2335 break
2337 if {!$full} break
2338 set o [lindex $rowoffsets $y $x]
2343 proc makeuparrow {oid x y z} {
2344 global rowidlist rowoffsets uparrowlen idrowranges
2346 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2347 incr y -1
2348 incr x $z
2349 set off0 [lindex $rowoffsets $y]
2350 for {set x0 $x} {1} {incr x0} {
2351 if {$x0 >= [llength $off0]} {
2352 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2353 break
2355 set z [lindex $off0 $x0]
2356 if {$z ne {}} {
2357 incr x0 $z
2358 break
2361 set z [expr {$x0 - $x}]
2362 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2363 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2365 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2366 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2367 lappend idrowranges($oid) $y
2370 proc initlayout {} {
2371 global rowidlist rowoffsets displayorder commitlisted
2372 global rowlaidout rowoptim
2373 global idinlist rowchk rowrangelist idrowranges
2374 global numcommits canvxmax canv
2375 global nextcolor
2376 global parentlist childlist children
2377 global colormap rowtextx
2378 global linesegends
2380 set numcommits 0
2381 set displayorder {}
2382 set commitlisted {}
2383 set parentlist {}
2384 set childlist {}
2385 set rowrangelist {}
2386 set nextcolor 0
2387 set rowidlist {{}}
2388 set rowoffsets {{}}
2389 catch {unset idinlist}
2390 catch {unset rowchk}
2391 set rowlaidout 0
2392 set rowoptim 0
2393 set canvxmax [$canv cget -width]
2394 catch {unset colormap}
2395 catch {unset rowtextx}
2396 catch {unset idrowranges}
2397 set linesegends {}
2400 proc setcanvscroll {} {
2401 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2403 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2404 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2405 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2406 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2409 proc visiblerows {} {
2410 global canv numcommits linespc
2412 set ymax [lindex [$canv cget -scrollregion] 3]
2413 if {$ymax eq {} || $ymax == 0} return
2414 set f [$canv yview]
2415 set y0 [expr {int([lindex $f 0] * $ymax)}]
2416 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2417 if {$r0 < 0} {
2418 set r0 0
2420 set y1 [expr {int([lindex $f 1] * $ymax)}]
2421 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2422 if {$r1 >= $numcommits} {
2423 set r1 [expr {$numcommits - 1}]
2425 return [list $r0 $r1]
2428 proc layoutmore {tmax} {
2429 global rowlaidout rowoptim commitidx numcommits optim_delay
2430 global uparrowlen curview
2432 while {1} {
2433 if {$rowoptim - $optim_delay > $numcommits} {
2434 showstuff [expr {$rowoptim - $optim_delay}]
2435 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2436 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2437 if {$nr > 100} {
2438 set nr 100
2440 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2441 incr rowoptim $nr
2442 } elseif {$commitidx($curview) > $rowlaidout} {
2443 set nr [expr {$commitidx($curview) - $rowlaidout}]
2444 # may need to increase this threshold if uparrowlen or
2445 # mingaplen are increased...
2446 if {$nr > 150} {
2447 set nr 150
2449 set row $rowlaidout
2450 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2451 if {$rowlaidout == $row} {
2452 return 0
2454 } else {
2455 return 0
2457 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2458 return 1
2463 proc showstuff {canshow} {
2464 global numcommits commitrow pending_select selectedline
2465 global linesegends idrowranges idrangedrawn curview
2467 if {$numcommits == 0} {
2468 global phase
2469 set phase "incrdraw"
2470 allcanvs delete all
2472 set row $numcommits
2473 set numcommits $canshow
2474 setcanvscroll
2475 set rows [visiblerows]
2476 set r0 [lindex $rows 0]
2477 set r1 [lindex $rows 1]
2478 set selrow -1
2479 for {set r $row} {$r < $canshow} {incr r} {
2480 foreach id [lindex $linesegends [expr {$r+1}]] {
2481 set i -1
2482 foreach {s e} [rowranges $id] {
2483 incr i
2484 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2485 && ![info exists idrangedrawn($id,$i)]} {
2486 drawlineseg $id $i
2487 set idrangedrawn($id,$i) 1
2492 if {$canshow > $r1} {
2493 set canshow $r1
2495 while {$row < $canshow} {
2496 drawcmitrow $row
2497 incr row
2499 if {[info exists pending_select] &&
2500 [info exists commitrow($curview,$pending_select)] &&
2501 $commitrow($curview,$pending_select) < $numcommits} {
2502 selectline $commitrow($curview,$pending_select) 1
2504 if {![info exists selectedline] && ![info exists pending_select]} {
2505 selectline 0 1
2509 proc layoutrows {row endrow last} {
2510 global rowidlist rowoffsets displayorder
2511 global uparrowlen downarrowlen maxwidth mingaplen
2512 global childlist parentlist
2513 global idrowranges linesegends
2514 global commitidx curview
2515 global idinlist rowchk rowrangelist
2517 set idlist [lindex $rowidlist $row]
2518 set offs [lindex $rowoffsets $row]
2519 while {$row < $endrow} {
2520 set id [lindex $displayorder $row]
2521 set oldolds {}
2522 set newolds {}
2523 foreach p [lindex $parentlist $row] {
2524 if {![info exists idinlist($p)]} {
2525 lappend newolds $p
2526 } elseif {!$idinlist($p)} {
2527 lappend oldolds $p
2530 set lse {}
2531 set nev [expr {[llength $idlist] + [llength $newolds]
2532 + [llength $oldolds] - $maxwidth + 1}]
2533 if {$nev > 0} {
2534 if {!$last &&
2535 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2536 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2537 set i [lindex $idlist $x]
2538 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2539 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2540 [expr {$row + $uparrowlen + $mingaplen}]]
2541 if {$r == 0} {
2542 set idlist [lreplace $idlist $x $x]
2543 set offs [lreplace $offs $x $x]
2544 set offs [incrange $offs $x 1]
2545 set idinlist($i) 0
2546 set rm1 [expr {$row - 1}]
2547 lappend lse $i
2548 lappend idrowranges($i) $rm1
2549 if {[incr nev -1] <= 0} break
2550 continue
2552 set rowchk($id) [expr {$row + $r}]
2555 lset rowidlist $row $idlist
2556 lset rowoffsets $row $offs
2558 lappend linesegends $lse
2559 set col [lsearch -exact $idlist $id]
2560 if {$col < 0} {
2561 set col [llength $idlist]
2562 lappend idlist $id
2563 lset rowidlist $row $idlist
2564 set z {}
2565 if {[lindex $childlist $row] ne {}} {
2566 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2567 unset idinlist($id)
2569 lappend offs $z
2570 lset rowoffsets $row $offs
2571 if {$z ne {}} {
2572 makeuparrow $id $col $row $z
2574 } else {
2575 unset idinlist($id)
2577 set ranges {}
2578 if {[info exists idrowranges($id)]} {
2579 set ranges $idrowranges($id)
2580 lappend ranges $row
2581 unset idrowranges($id)
2583 lappend rowrangelist $ranges
2584 incr row
2585 set offs [ntimes [llength $idlist] 0]
2586 set l [llength $newolds]
2587 set idlist [eval lreplace \$idlist $col $col $newolds]
2588 set o 0
2589 if {$l != 1} {
2590 set offs [lrange $offs 0 [expr {$col - 1}]]
2591 foreach x $newolds {
2592 lappend offs {}
2593 incr o -1
2595 incr o
2596 set tmp [expr {[llength $idlist] - [llength $offs]}]
2597 if {$tmp > 0} {
2598 set offs [concat $offs [ntimes $tmp $o]]
2600 } else {
2601 lset offs $col {}
2603 foreach i $newolds {
2604 set idinlist($i) 1
2605 set idrowranges($i) $row
2607 incr col $l
2608 foreach oid $oldolds {
2609 set idinlist($oid) 1
2610 set idlist [linsert $idlist $col $oid]
2611 set offs [linsert $offs $col $o]
2612 makeuparrow $oid $col $row $o
2613 incr col
2615 lappend rowidlist $idlist
2616 lappend rowoffsets $offs
2618 return $row
2621 proc addextraid {id row} {
2622 global displayorder commitrow commitinfo
2623 global commitidx commitlisted
2624 global parentlist childlist children curview
2626 incr commitidx($curview)
2627 lappend displayorder $id
2628 lappend commitlisted 0
2629 lappend parentlist {}
2630 set commitrow($curview,$id) $row
2631 readcommit $id
2632 if {![info exists commitinfo($id)]} {
2633 set commitinfo($id) {"No commit information available"}
2635 if {![info exists children($curview,$id)]} {
2636 set children($curview,$id) {}
2638 lappend childlist $children($curview,$id)
2641 proc layouttail {} {
2642 global rowidlist rowoffsets idinlist commitidx curview
2643 global idrowranges rowrangelist
2645 set row $commitidx($curview)
2646 set idlist [lindex $rowidlist $row]
2647 while {$idlist ne {}} {
2648 set col [expr {[llength $idlist] - 1}]
2649 set id [lindex $idlist $col]
2650 addextraid $id $row
2651 unset idinlist($id)
2652 lappend idrowranges($id) $row
2653 lappend rowrangelist $idrowranges($id)
2654 unset idrowranges($id)
2655 incr row
2656 set offs [ntimes $col 0]
2657 set idlist [lreplace $idlist $col $col]
2658 lappend rowidlist $idlist
2659 lappend rowoffsets $offs
2662 foreach id [array names idinlist] {
2663 addextraid $id $row
2664 lset rowidlist $row [list $id]
2665 lset rowoffsets $row 0
2666 makeuparrow $id 0 $row 0
2667 lappend idrowranges($id) $row
2668 lappend rowrangelist $idrowranges($id)
2669 unset idrowranges($id)
2670 incr row
2671 lappend rowidlist {}
2672 lappend rowoffsets {}
2676 proc insert_pad {row col npad} {
2677 global rowidlist rowoffsets
2679 set pad [ntimes $npad {}]
2680 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2681 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2682 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2685 proc optimize_rows {row col endrow} {
2686 global rowidlist rowoffsets idrowranges displayorder
2688 for {} {$row < $endrow} {incr row} {
2689 set idlist [lindex $rowidlist $row]
2690 set offs [lindex $rowoffsets $row]
2691 set haspad 0
2692 for {} {$col < [llength $offs]} {incr col} {
2693 if {[lindex $idlist $col] eq {}} {
2694 set haspad 1
2695 continue
2697 set z [lindex $offs $col]
2698 if {$z eq {}} continue
2699 set isarrow 0
2700 set x0 [expr {$col + $z}]
2701 set y0 [expr {$row - 1}]
2702 set z0 [lindex $rowoffsets $y0 $x0]
2703 if {$z0 eq {}} {
2704 set id [lindex $idlist $col]
2705 set ranges [rowranges $id]
2706 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2707 set isarrow 1
2710 if {$z < -1 || ($z < 0 && $isarrow)} {
2711 set npad [expr {-1 - $z + $isarrow}]
2712 set offs [incrange $offs $col $npad]
2713 insert_pad $y0 $x0 $npad
2714 if {$y0 > 0} {
2715 optimize_rows $y0 $x0 $row
2717 set z [lindex $offs $col]
2718 set x0 [expr {$col + $z}]
2719 set z0 [lindex $rowoffsets $y0 $x0]
2720 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2721 set npad [expr {$z - 1 + $isarrow}]
2722 set y1 [expr {$row + 1}]
2723 set offs2 [lindex $rowoffsets $y1]
2724 set x1 -1
2725 foreach z $offs2 {
2726 incr x1
2727 if {$z eq {} || $x1 + $z < $col} continue
2728 if {$x1 + $z > $col} {
2729 incr npad
2731 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2732 break
2734 set pad [ntimes $npad {}]
2735 set idlist [eval linsert \$idlist $col $pad]
2736 set tmp [eval linsert \$offs $col $pad]
2737 incr col $npad
2738 set offs [incrange $tmp $col [expr {-$npad}]]
2739 set z [lindex $offs $col]
2740 set haspad 1
2742 if {$z0 eq {} && !$isarrow} {
2743 # this line links to its first child on row $row-2
2744 set rm2 [expr {$row - 2}]
2745 set id [lindex $displayorder $rm2]
2746 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2747 if {$xc >= 0} {
2748 set z0 [expr {$xc - $x0}]
2751 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2752 insert_pad $y0 $x0 1
2753 set offs [incrange $offs $col 1]
2754 optimize_rows $y0 [expr {$x0 + 1}] $row
2757 if {!$haspad} {
2758 set o {}
2759 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2760 set o [lindex $offs $col]
2761 if {$o eq {}} {
2762 # check if this is the link to the first child
2763 set id [lindex $idlist $col]
2764 set ranges [rowranges $id]
2765 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2766 # it is, work out offset to child
2767 set y0 [expr {$row - 1}]
2768 set id [lindex $displayorder $y0]
2769 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2770 if {$x0 >= 0} {
2771 set o [expr {$x0 - $col}]
2775 if {$o eq {} || $o <= 0} break
2777 if {$o ne {} && [incr col] < [llength $idlist]} {
2778 set y1 [expr {$row + 1}]
2779 set offs2 [lindex $rowoffsets $y1]
2780 set x1 -1
2781 foreach z $offs2 {
2782 incr x1
2783 if {$z eq {} || $x1 + $z < $col} continue
2784 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2785 break
2787 set idlist [linsert $idlist $col {}]
2788 set tmp [linsert $offs $col {}]
2789 incr col
2790 set offs [incrange $tmp $col -1]
2793 lset rowidlist $row $idlist
2794 lset rowoffsets $row $offs
2795 set col 0
2799 proc xc {row col} {
2800 global canvx0 linespc
2801 return [expr {$canvx0 + $col * $linespc}]
2804 proc yc {row} {
2805 global canvy0 linespc
2806 return [expr {$canvy0 + $row * $linespc}]
2809 proc linewidth {id} {
2810 global thickerline lthickness
2812 set wid $lthickness
2813 if {[info exists thickerline] && $id eq $thickerline} {
2814 set wid [expr {2 * $lthickness}]
2816 return $wid
2819 proc rowranges {id} {
2820 global phase idrowranges commitrow rowlaidout rowrangelist curview
2822 set ranges {}
2823 if {$phase eq {} ||
2824 ([info exists commitrow($curview,$id)]
2825 && $commitrow($curview,$id) < $rowlaidout)} {
2826 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2827 } elseif {[info exists idrowranges($id)]} {
2828 set ranges $idrowranges($id)
2830 return $ranges
2833 proc drawlineseg {id i} {
2834 global rowoffsets rowidlist
2835 global displayorder
2836 global canv colormap linespc
2837 global numcommits commitrow curview
2839 set ranges [rowranges $id]
2840 set downarrow 1
2841 if {[info exists commitrow($curview,$id)]
2842 && $commitrow($curview,$id) < $numcommits} {
2843 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2844 } else {
2845 set downarrow 1
2847 set startrow [lindex $ranges [expr {2 * $i}]]
2848 set row [lindex $ranges [expr {2 * $i + 1}]]
2849 if {$startrow == $row} return
2850 assigncolor $id
2851 set coords {}
2852 set col [lsearch -exact [lindex $rowidlist $row] $id]
2853 if {$col < 0} {
2854 puts "oops: drawline: id $id not on row $row"
2855 return
2857 set lasto {}
2858 set ns 0
2859 while {1} {
2860 set o [lindex $rowoffsets $row $col]
2861 if {$o eq {}} break
2862 if {$o ne $lasto} {
2863 # changing direction
2864 set x [xc $row $col]
2865 set y [yc $row]
2866 lappend coords $x $y
2867 set lasto $o
2869 incr col $o
2870 incr row -1
2872 set x [xc $row $col]
2873 set y [yc $row]
2874 lappend coords $x $y
2875 if {$i == 0} {
2876 # draw the link to the first child as part of this line
2877 incr row -1
2878 set child [lindex $displayorder $row]
2879 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2880 if {$ccol >= 0} {
2881 set x [xc $row $ccol]
2882 set y [yc $row]
2883 if {$ccol < $col - 1} {
2884 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2885 } elseif {$ccol > $col + 1} {
2886 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2888 lappend coords $x $y
2891 if {[llength $coords] < 4} return
2892 if {$downarrow} {
2893 # This line has an arrow at the lower end: check if the arrow is
2894 # on a diagonal segment, and if so, work around the Tk 8.4
2895 # refusal to draw arrows on diagonal lines.
2896 set x0 [lindex $coords 0]
2897 set x1 [lindex $coords 2]
2898 if {$x0 != $x1} {
2899 set y0 [lindex $coords 1]
2900 set y1 [lindex $coords 3]
2901 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2902 # we have a nearby vertical segment, just trim off the diag bit
2903 set coords [lrange $coords 2 end]
2904 } else {
2905 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2906 set xi [expr {$x0 - $slope * $linespc / 2}]
2907 set yi [expr {$y0 - $linespc / 2}]
2908 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2912 set arrow [expr {2 * ($i > 0) + $downarrow}]
2913 set arrow [lindex {none first last both} $arrow]
2914 set t [$canv create line $coords -width [linewidth $id] \
2915 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2916 $canv lower $t
2917 bindline $t $id
2920 proc drawparentlinks {id row col olds} {
2921 global rowidlist canv colormap
2923 set row2 [expr {$row + 1}]
2924 set x [xc $row $col]
2925 set y [yc $row]
2926 set y2 [yc $row2]
2927 set ids [lindex $rowidlist $row2]
2928 # rmx = right-most X coord used
2929 set rmx 0
2930 foreach p $olds {
2931 set i [lsearch -exact $ids $p]
2932 if {$i < 0} {
2933 puts "oops, parent $p of $id not in list"
2934 continue
2936 set x2 [xc $row2 $i]
2937 if {$x2 > $rmx} {
2938 set rmx $x2
2940 set ranges [rowranges $p]
2941 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2942 && $row2 < [lindex $ranges 1]} {
2943 # drawlineseg will do this one for us
2944 continue
2946 assigncolor $p
2947 # should handle duplicated parents here...
2948 set coords [list $x $y]
2949 if {$i < $col - 1} {
2950 lappend coords [xc $row [expr {$i + 1}]] $y
2951 } elseif {$i > $col + 1} {
2952 lappend coords [xc $row [expr {$i - 1}]] $y
2954 lappend coords $x2 $y2
2955 set t [$canv create line $coords -width [linewidth $p] \
2956 -fill $colormap($p) -tags lines.$p]
2957 $canv lower $t
2958 bindline $t $p
2960 return $rmx
2963 proc drawlines {id} {
2964 global colormap canv
2965 global idrangedrawn
2966 global children iddrawn commitrow rowidlist curview
2968 $canv delete lines.$id
2969 set nr [expr {[llength [rowranges $id]] / 2}]
2970 for {set i 0} {$i < $nr} {incr i} {
2971 if {[info exists idrangedrawn($id,$i)]} {
2972 drawlineseg $id $i
2975 foreach child $children($curview,$id) {
2976 if {[info exists iddrawn($child)]} {
2977 set row $commitrow($curview,$child)
2978 set col [lsearch -exact [lindex $rowidlist $row] $child]
2979 if {$col >= 0} {
2980 drawparentlinks $child $row $col [list $id]
2986 proc drawcmittext {id row col rmx} {
2987 global linespc canv canv2 canv3 canvy0 fgcolor
2988 global commitlisted commitinfo rowidlist
2989 global rowtextx idpos idtags idheads idotherrefs
2990 global linehtag linentag linedtag
2991 global mainfont canvxmax boldrows boldnamerows fgcolor
2993 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2994 set x [xc $row $col]
2995 set y [yc $row]
2996 set orad [expr {$linespc / 3}]
2997 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2998 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2999 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3000 $canv raise $t
3001 $canv bind $t <1> {selcanvline {} %x %y}
3002 set xt [xc $row [llength [lindex $rowidlist $row]]]
3003 if {$xt < $rmx} {
3004 set xt $rmx
3006 set rowtextx($row) $xt
3007 set idpos($id) [list $x $xt $y]
3008 if {[info exists idtags($id)] || [info exists idheads($id)]
3009 || [info exists idotherrefs($id)]} {
3010 set xt [drawtags $id $x $xt $y]
3012 set headline [lindex $commitinfo($id) 0]
3013 set name [lindex $commitinfo($id) 1]
3014 set date [lindex $commitinfo($id) 2]
3015 set date [formatdate $date]
3016 set font $mainfont
3017 set nfont $mainfont
3018 set isbold [ishighlighted $row]
3019 if {$isbold > 0} {
3020 lappend boldrows $row
3021 lappend font bold
3022 if {$isbold > 1} {
3023 lappend boldnamerows $row
3024 lappend nfont bold
3027 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3028 -text $headline -font $font -tags text]
3029 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3030 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3031 -text $name -font $nfont -tags text]
3032 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3033 -text $date -font $mainfont -tags text]
3034 set xr [expr {$xt + [font measure $mainfont $headline]}]
3035 if {$xr > $canvxmax} {
3036 set canvxmax $xr
3037 setcanvscroll
3041 proc drawcmitrow {row} {
3042 global displayorder rowidlist
3043 global idrangedrawn iddrawn
3044 global commitinfo parentlist numcommits
3045 global filehighlight fhighlights findstring nhighlights
3046 global hlview vhighlights
3047 global highlight_related rhighlights
3049 if {$row >= $numcommits} return
3050 foreach id [lindex $rowidlist $row] {
3051 if {$id eq {}} continue
3052 set i -1
3053 foreach {s e} [rowranges $id] {
3054 incr i
3055 if {$row < $s} continue
3056 if {$e eq {}} break
3057 if {$row <= $e} {
3058 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3059 drawlineseg $id $i
3060 set idrangedrawn($id,$i) 1
3062 break
3067 set id [lindex $displayorder $row]
3068 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3069 askvhighlight $row $id
3071 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3072 askfilehighlight $row $id
3074 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3075 askfindhighlight $row $id
3077 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3078 askrelhighlight $row $id
3080 if {[info exists iddrawn($id)]} return
3081 set col [lsearch -exact [lindex $rowidlist $row] $id]
3082 if {$col < 0} {
3083 puts "oops, row $row id $id not in list"
3084 return
3086 if {![info exists commitinfo($id)]} {
3087 getcommit $id
3089 assigncolor $id
3090 set olds [lindex $parentlist $row]
3091 if {$olds ne {}} {
3092 set rmx [drawparentlinks $id $row $col $olds]
3093 } else {
3094 set rmx 0
3096 drawcmittext $id $row $col $rmx
3097 set iddrawn($id) 1
3100 proc drawfrac {f0 f1} {
3101 global numcommits canv
3102 global linespc
3104 set ymax [lindex [$canv cget -scrollregion] 3]
3105 if {$ymax eq {} || $ymax == 0} return
3106 set y0 [expr {int($f0 * $ymax)}]
3107 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3108 if {$row < 0} {
3109 set row 0
3111 set y1 [expr {int($f1 * $ymax)}]
3112 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3113 if {$endrow >= $numcommits} {
3114 set endrow [expr {$numcommits - 1}]
3116 for {} {$row <= $endrow} {incr row} {
3117 drawcmitrow $row
3121 proc drawvisible {} {
3122 global canv
3123 eval drawfrac [$canv yview]
3126 proc clear_display {} {
3127 global iddrawn idrangedrawn
3128 global vhighlights fhighlights nhighlights rhighlights
3130 allcanvs delete all
3131 catch {unset iddrawn}
3132 catch {unset idrangedrawn}
3133 catch {unset vhighlights}
3134 catch {unset fhighlights}
3135 catch {unset nhighlights}
3136 catch {unset rhighlights}
3139 proc findcrossings {id} {
3140 global rowidlist parentlist numcommits rowoffsets displayorder
3142 set cross {}
3143 set ccross {}
3144 foreach {s e} [rowranges $id] {
3145 if {$e >= $numcommits} {
3146 set e [expr {$numcommits - 1}]
3148 if {$e <= $s} continue
3149 set x [lsearch -exact [lindex $rowidlist $e] $id]
3150 if {$x < 0} {
3151 puts "findcrossings: oops, no [shortids $id] in row $e"
3152 continue
3154 for {set row $e} {[incr row -1] >= $s} {} {
3155 set olds [lindex $parentlist $row]
3156 set kid [lindex $displayorder $row]
3157 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3158 if {$kidx < 0} continue
3159 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3160 foreach p $olds {
3161 set px [lsearch -exact $nextrow $p]
3162 if {$px < 0} continue
3163 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3164 if {[lsearch -exact $ccross $p] >= 0} continue
3165 if {$x == $px + ($kidx < $px? -1: 1)} {
3166 lappend ccross $p
3167 } elseif {[lsearch -exact $cross $p] < 0} {
3168 lappend cross $p
3172 set inc [lindex $rowoffsets $row $x]
3173 if {$inc eq {}} break
3174 incr x $inc
3177 return [concat $ccross {{}} $cross]
3180 proc assigncolor {id} {
3181 global colormap colors nextcolor
3182 global commitrow parentlist children children curview
3184 if {[info exists colormap($id)]} return
3185 set ncolors [llength $colors]
3186 if {[info exists children($curview,$id)]} {
3187 set kids $children($curview,$id)
3188 } else {
3189 set kids {}
3191 if {[llength $kids] == 1} {
3192 set child [lindex $kids 0]
3193 if {[info exists colormap($child)]
3194 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3195 set colormap($id) $colormap($child)
3196 return
3199 set badcolors {}
3200 set origbad {}
3201 foreach x [findcrossings $id] {
3202 if {$x eq {}} {
3203 # delimiter between corner crossings and other crossings
3204 if {[llength $badcolors] >= $ncolors - 1} break
3205 set origbad $badcolors
3207 if {[info exists colormap($x)]
3208 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3209 lappend badcolors $colormap($x)
3212 if {[llength $badcolors] >= $ncolors} {
3213 set badcolors $origbad
3215 set origbad $badcolors
3216 if {[llength $badcolors] < $ncolors - 1} {
3217 foreach child $kids {
3218 if {[info exists colormap($child)]
3219 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3220 lappend badcolors $colormap($child)
3222 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3223 if {[info exists colormap($p)]
3224 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3225 lappend badcolors $colormap($p)
3229 if {[llength $badcolors] >= $ncolors} {
3230 set badcolors $origbad
3233 for {set i 0} {$i <= $ncolors} {incr i} {
3234 set c [lindex $colors $nextcolor]
3235 if {[incr nextcolor] >= $ncolors} {
3236 set nextcolor 0
3238 if {[lsearch -exact $badcolors $c]} break
3240 set colormap($id) $c
3243 proc bindline {t id} {
3244 global canv
3246 $canv bind $t <Enter> "lineenter %x %y $id"
3247 $canv bind $t <Motion> "linemotion %x %y $id"
3248 $canv bind $t <Leave> "lineleave $id"
3249 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3252 proc drawtags {id x xt y1} {
3253 global idtags idheads idotherrefs mainhead
3254 global linespc lthickness
3255 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3257 set marks {}
3258 set ntags 0
3259 set nheads 0
3260 if {[info exists idtags($id)]} {
3261 set marks $idtags($id)
3262 set ntags [llength $marks]
3264 if {[info exists idheads($id)]} {
3265 set marks [concat $marks $idheads($id)]
3266 set nheads [llength $idheads($id)]
3268 if {[info exists idotherrefs($id)]} {
3269 set marks [concat $marks $idotherrefs($id)]
3271 if {$marks eq {}} {
3272 return $xt
3275 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3276 set yt [expr {$y1 - 0.5 * $linespc}]
3277 set yb [expr {$yt + $linespc - 1}]
3278 set xvals {}
3279 set wvals {}
3280 set i -1
3281 foreach tag $marks {
3282 incr i
3283 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3284 set wid [font measure [concat $mainfont bold] $tag]
3285 } else {
3286 set wid [font measure $mainfont $tag]
3288 lappend xvals $xt
3289 lappend wvals $wid
3290 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3292 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3293 -width $lthickness -fill black -tags tag.$id]
3294 $canv lower $t
3295 foreach tag $marks x $xvals wid $wvals {
3296 set xl [expr {$x + $delta}]
3297 set xr [expr {$x + $delta + $wid + $lthickness}]
3298 set font $mainfont
3299 if {[incr ntags -1] >= 0} {
3300 # draw a tag
3301 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3302 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3303 -width 1 -outline black -fill yellow -tags tag.$id]
3304 $canv bind $t <1> [list showtag $tag 1]
3305 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3306 } else {
3307 # draw a head or other ref
3308 if {[incr nheads -1] >= 0} {
3309 set col green
3310 if {$tag eq $mainhead} {
3311 lappend font bold
3313 } else {
3314 set col "#ddddff"
3316 set xl [expr {$xl - $delta/2}]
3317 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3318 -width 1 -outline black -fill $col -tags tag.$id
3319 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3320 set rwid [font measure $mainfont $remoteprefix]
3321 set xi [expr {$x + 1}]
3322 set yti [expr {$yt + 1}]
3323 set xri [expr {$x + $rwid}]
3324 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3325 -width 0 -fill "#ffddaa" -tags tag.$id
3328 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3329 -font $font -tags [list tag.$id text]]
3330 if {$ntags >= 0} {
3331 $canv bind $t <1> [list showtag $tag 1]
3332 } elseif {$nheads >= 0} {
3333 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3336 return $xt
3339 proc xcoord {i level ln} {
3340 global canvx0 xspc1 xspc2
3342 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3343 if {$i > 0 && $i == $level} {
3344 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3345 } elseif {$i > $level} {
3346 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3348 return $x
3351 proc show_status {msg} {
3352 global canv mainfont fgcolor
3354 clear_display
3355 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3356 -tags text -fill $fgcolor
3359 proc finishcommits {} {
3360 global commitidx phase curview
3361 global pending_select
3363 if {$commitidx($curview) > 0} {
3364 drawrest
3365 } else {
3366 show_status "No commits selected"
3368 set phase {}
3369 catch {unset pending_select}
3372 # Insert a new commit as the child of the commit on row $row.
3373 # The new commit will be displayed on row $row and the commits
3374 # on that row and below will move down one row.
3375 proc insertrow {row newcmit} {
3376 global displayorder parentlist childlist commitlisted
3377 global commitrow curview rowidlist rowoffsets numcommits
3378 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3379 global linesegends selectedline
3381 if {$row >= $numcommits} {
3382 puts "oops, inserting new row $row but only have $numcommits rows"
3383 return
3385 set p [lindex $displayorder $row]
3386 set displayorder [linsert $displayorder $row $newcmit]
3387 set parentlist [linsert $parentlist $row $p]
3388 set kids [lindex $childlist $row]
3389 lappend kids $newcmit
3390 lset childlist $row $kids
3391 set childlist [linsert $childlist $row {}]
3392 set commitlisted [linsert $commitlisted $row 1]
3393 set l [llength $displayorder]
3394 for {set r $row} {$r < $l} {incr r} {
3395 set id [lindex $displayorder $r]
3396 set commitrow($curview,$id) $r
3399 set idlist [lindex $rowidlist $row]
3400 set offs [lindex $rowoffsets $row]
3401 set newoffs {}
3402 foreach x $idlist {
3403 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3404 lappend newoffs {}
3405 } else {
3406 lappend newoffs 0
3409 if {[llength $kids] == 1} {
3410 set col [lsearch -exact $idlist $p]
3411 lset idlist $col $newcmit
3412 } else {
3413 set col [llength $idlist]
3414 lappend idlist $newcmit
3415 lappend offs {}
3416 lset rowoffsets $row $offs
3418 set rowidlist [linsert $rowidlist $row $idlist]
3419 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3421 set rowrangelist [linsert $rowrangelist $row {}]
3422 set l [llength $rowrangelist]
3423 for {set r 0} {$r < $l} {incr r} {
3424 set ranges [lindex $rowrangelist $r]
3425 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3426 set newranges {}
3427 foreach x $ranges {
3428 if {$x >= $row} {
3429 lappend newranges [expr {$x + 1}]
3430 } else {
3431 lappend newranges $x
3434 lset rowrangelist $r $newranges
3437 if {[llength $kids] > 1} {
3438 set rp1 [expr {$row + 1}]
3439 set ranges [lindex $rowrangelist $rp1]
3440 if {$ranges eq {}} {
3441 set ranges [list $row $rp1]
3442 } elseif {[lindex $ranges end-1] == $rp1} {
3443 lset ranges end-1 $row
3445 lset rowrangelist $rp1 $ranges
3447 foreach id [array names idrowranges] {
3448 set ranges $idrowranges($id)
3449 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3450 set newranges {}
3451 foreach x $ranges {
3452 if {$x >= $row} {
3453 lappend newranges [expr {$x + 1}]
3454 } else {
3455 lappend newranges $x
3458 set idrowranges($id) $newranges
3462 set linesegends [linsert $linesegends $row {}]
3464 incr rowlaidout
3465 incr rowoptim
3466 incr numcommits
3468 if {[info exists selectedline] && $selectedline >= $row} {
3469 incr selectedline
3471 redisplay
3474 # Don't change the text pane cursor if it is currently the hand cursor,
3475 # showing that we are over a sha1 ID link.
3476 proc settextcursor {c} {
3477 global ctext curtextcursor
3479 if {[$ctext cget -cursor] == $curtextcursor} {
3480 $ctext config -cursor $c
3482 set curtextcursor $c
3485 proc nowbusy {what} {
3486 global isbusy
3488 if {[array names isbusy] eq {}} {
3489 . config -cursor watch
3490 settextcursor watch
3492 set isbusy($what) 1
3495 proc notbusy {what} {
3496 global isbusy maincursor textcursor
3498 catch {unset isbusy($what)}
3499 if {[array names isbusy] eq {}} {
3500 . config -cursor $maincursor
3501 settextcursor $textcursor
3505 proc drawrest {} {
3506 global startmsecs
3507 global rowlaidout commitidx curview
3508 global pending_select
3510 set row $rowlaidout
3511 layoutrows $rowlaidout $commitidx($curview) 1
3512 layouttail
3513 optimize_rows $row 0 $commitidx($curview)
3514 showstuff $commitidx($curview)
3515 if {[info exists pending_select]} {
3516 selectline 0 1
3519 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3520 #global numcommits
3521 #puts "overall $drawmsecs ms for $numcommits commits"
3524 proc findmatches {f} {
3525 global findtype foundstring foundstrlen
3526 if {$findtype == "Regexp"} {
3527 set matches [regexp -indices -all -inline $foundstring $f]
3528 } else {
3529 if {$findtype == "IgnCase"} {
3530 set str [string tolower $f]
3531 } else {
3532 set str $f
3534 set matches {}
3535 set i 0
3536 while {[set j [string first $foundstring $str $i]] >= 0} {
3537 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3538 set i [expr {$j + $foundstrlen}]
3541 return $matches
3544 proc dofind {} {
3545 global findtype findloc findstring markedmatches commitinfo
3546 global numcommits displayorder linehtag linentag linedtag
3547 global mainfont canv canv2 canv3 selectedline
3548 global matchinglines foundstring foundstrlen matchstring
3549 global commitdata
3551 stopfindproc
3552 unmarkmatches
3553 cancel_next_highlight
3554 focus .
3555 set matchinglines {}
3556 if {$findtype == "IgnCase"} {
3557 set foundstring [string tolower $findstring]
3558 } else {
3559 set foundstring $findstring
3561 set foundstrlen [string length $findstring]
3562 if {$foundstrlen == 0} return
3563 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3564 set matchstring "*$matchstring*"
3565 if {![info exists selectedline]} {
3566 set oldsel -1
3567 } else {
3568 set oldsel $selectedline
3570 set didsel 0
3571 set fldtypes {Headline Author Date Committer CDate Comments}
3572 set l -1
3573 foreach id $displayorder {
3574 set d $commitdata($id)
3575 incr l
3576 if {$findtype == "Regexp"} {
3577 set doesmatch [regexp $foundstring $d]
3578 } elseif {$findtype == "IgnCase"} {
3579 set doesmatch [string match -nocase $matchstring $d]
3580 } else {
3581 set doesmatch [string match $matchstring $d]
3583 if {!$doesmatch} continue
3584 if {![info exists commitinfo($id)]} {
3585 getcommit $id
3587 set info $commitinfo($id)
3588 set doesmatch 0
3589 foreach f $info ty $fldtypes {
3590 if {$findloc != "All fields" && $findloc != $ty} {
3591 continue
3593 set matches [findmatches $f]
3594 if {$matches == {}} continue
3595 set doesmatch 1
3596 if {$ty == "Headline"} {
3597 drawcmitrow $l
3598 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3599 } elseif {$ty == "Author"} {
3600 drawcmitrow $l
3601 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3602 } elseif {$ty == "Date"} {
3603 drawcmitrow $l
3604 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3607 if {$doesmatch} {
3608 lappend matchinglines $l
3609 if {!$didsel && $l > $oldsel} {
3610 findselectline $l
3611 set didsel 1
3615 if {$matchinglines == {}} {
3616 bell
3617 } elseif {!$didsel} {
3618 findselectline [lindex $matchinglines 0]
3622 proc findselectline {l} {
3623 global findloc commentend ctext
3624 selectline $l 1
3625 if {$findloc == "All fields" || $findloc == "Comments"} {
3626 # highlight the matches in the comments
3627 set f [$ctext get 1.0 $commentend]
3628 set matches [findmatches $f]
3629 foreach match $matches {
3630 set start [lindex $match 0]
3631 set end [expr {[lindex $match 1] + 1}]
3632 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3637 proc findnext {restart} {
3638 global matchinglines selectedline
3639 if {![info exists matchinglines]} {
3640 if {$restart} {
3641 dofind
3643 return
3645 if {![info exists selectedline]} return
3646 foreach l $matchinglines {
3647 if {$l > $selectedline} {
3648 findselectline $l
3649 return
3652 bell
3655 proc findprev {} {
3656 global matchinglines selectedline
3657 if {![info exists matchinglines]} {
3658 dofind
3659 return
3661 if {![info exists selectedline]} return
3662 set prev {}
3663 foreach l $matchinglines {
3664 if {$l >= $selectedline} break
3665 set prev $l
3667 if {$prev != {}} {
3668 findselectline $prev
3669 } else {
3670 bell
3674 proc stopfindproc {{done 0}} {
3675 global findprocpid findprocfile findids
3676 global ctext findoldcursor phase maincursor textcursor
3677 global findinprogress
3679 catch {unset findids}
3680 if {[info exists findprocpid]} {
3681 if {!$done} {
3682 catch {exec kill $findprocpid}
3684 catch {close $findprocfile}
3685 unset findprocpid
3687 catch {unset findinprogress}
3688 notbusy find
3691 # mark a commit as matching by putting a yellow background
3692 # behind the headline
3693 proc markheadline {l id} {
3694 global canv mainfont linehtag
3696 drawcmitrow $l
3697 set bbox [$canv bbox $linehtag($l)]
3698 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3699 $canv lower $t
3702 # mark the bits of a headline, author or date that match a find string
3703 proc markmatches {canv l str tag matches font} {
3704 set bbox [$canv bbox $tag]
3705 set x0 [lindex $bbox 0]
3706 set y0 [lindex $bbox 1]
3707 set y1 [lindex $bbox 3]
3708 foreach match $matches {
3709 set start [lindex $match 0]
3710 set end [lindex $match 1]
3711 if {$start > $end} continue
3712 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3713 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3714 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3715 [expr {$x0+$xlen+2}] $y1 \
3716 -outline {} -tags matches -fill yellow]
3717 $canv lower $t
3721 proc unmarkmatches {} {
3722 global matchinglines findids
3723 allcanvs delete matches
3724 catch {unset matchinglines}
3725 catch {unset findids}
3728 proc selcanvline {w x y} {
3729 global canv canvy0 ctext linespc
3730 global rowtextx
3731 set ymax [lindex [$canv cget -scrollregion] 3]
3732 if {$ymax == {}} return
3733 set yfrac [lindex [$canv yview] 0]
3734 set y [expr {$y + $yfrac * $ymax}]
3735 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3736 if {$l < 0} {
3737 set l 0
3739 if {$w eq $canv} {
3740 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3742 unmarkmatches
3743 selectline $l 1
3746 proc commit_descriptor {p} {
3747 global commitinfo
3748 if {![info exists commitinfo($p)]} {
3749 getcommit $p
3751 set l "..."
3752 if {[llength $commitinfo($p)] > 1} {
3753 set l [lindex $commitinfo($p) 0]
3755 return "$p ($l)\n"
3758 # append some text to the ctext widget, and make any SHA1 ID
3759 # that we know about be a clickable link.
3760 proc appendwithlinks {text tags} {
3761 global ctext commitrow linknum curview
3763 set start [$ctext index "end - 1c"]
3764 $ctext insert end $text $tags
3765 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3766 foreach l $links {
3767 set s [lindex $l 0]
3768 set e [lindex $l 1]
3769 set linkid [string range $text $s $e]
3770 if {![info exists commitrow($curview,$linkid)]} continue
3771 incr e
3772 $ctext tag add link "$start + $s c" "$start + $e c"
3773 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3774 $ctext tag bind link$linknum <1> \
3775 [list selectline $commitrow($curview,$linkid) 1]
3776 incr linknum
3778 $ctext tag conf link -foreground blue -underline 1
3779 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3780 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3783 proc viewnextline {dir} {
3784 global canv linespc
3786 $canv delete hover
3787 set ymax [lindex [$canv cget -scrollregion] 3]
3788 set wnow [$canv yview]
3789 set wtop [expr {[lindex $wnow 0] * $ymax}]
3790 set newtop [expr {$wtop + $dir * $linespc}]
3791 if {$newtop < 0} {
3792 set newtop 0
3793 } elseif {$newtop > $ymax} {
3794 set newtop $ymax
3796 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3799 # add a list of tag or branch names at position pos
3800 # returns the number of names inserted
3801 proc appendrefs {pos tags var} {
3802 global ctext commitrow linknum curview $var
3804 if {[catch {$ctext index $pos}]} {
3805 return 0
3807 set tags [lsort $tags]
3808 set sep {}
3809 foreach tag $tags {
3810 set id [set $var\($tag\)]
3811 set lk link$linknum
3812 incr linknum
3813 $ctext insert $pos $sep
3814 $ctext insert $pos $tag $lk
3815 $ctext tag conf $lk -foreground blue
3816 if {[info exists commitrow($curview,$id)]} {
3817 $ctext tag bind $lk <1> \
3818 [list selectline $commitrow($curview,$id) 1]
3819 $ctext tag conf $lk -underline 1
3820 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3821 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3823 set sep ", "
3825 return [llength $tags]
3828 proc taglist {ids} {
3829 global idtags
3831 set tags {}
3832 foreach id $ids {
3833 foreach tag $idtags($id) {
3834 lappend tags $tag
3837 return $tags
3840 # called when we have finished computing the nearby tags
3841 proc dispneartags {} {
3842 global selectedline currentid ctext anc_tags desc_tags showneartags
3843 global desc_heads
3845 if {![info exists selectedline] || !$showneartags} return
3846 set id $currentid
3847 $ctext conf -state normal
3848 if {[info exists desc_heads($id)]} {
3849 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3850 $ctext insert "branch -2c" "es"
3853 if {[info exists anc_tags($id)]} {
3854 appendrefs follows [taglist $anc_tags($id)] tagids
3856 if {[info exists desc_tags($id)]} {
3857 appendrefs precedes [taglist $desc_tags($id)] tagids
3859 $ctext conf -state disabled
3862 proc selectline {l isnew} {
3863 global canv canv2 canv3 ctext commitinfo selectedline
3864 global displayorder linehtag linentag linedtag
3865 global canvy0 linespc parentlist childlist
3866 global currentid sha1entry
3867 global commentend idtags linknum
3868 global mergemax numcommits pending_select
3869 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3871 catch {unset pending_select}
3872 $canv delete hover
3873 normalline
3874 cancel_next_highlight
3875 if {$l < 0 || $l >= $numcommits} return
3876 set y [expr {$canvy0 + $l * $linespc}]
3877 set ymax [lindex [$canv cget -scrollregion] 3]
3878 set ytop [expr {$y - $linespc - 1}]
3879 set ybot [expr {$y + $linespc + 1}]
3880 set wnow [$canv yview]
3881 set wtop [expr {[lindex $wnow 0] * $ymax}]
3882 set wbot [expr {[lindex $wnow 1] * $ymax}]
3883 set wh [expr {$wbot - $wtop}]
3884 set newtop $wtop
3885 if {$ytop < $wtop} {
3886 if {$ybot < $wtop} {
3887 set newtop [expr {$y - $wh / 2.0}]
3888 } else {
3889 set newtop $ytop
3890 if {$newtop > $wtop - $linespc} {
3891 set newtop [expr {$wtop - $linespc}]
3894 } elseif {$ybot > $wbot} {
3895 if {$ytop > $wbot} {
3896 set newtop [expr {$y - $wh / 2.0}]
3897 } else {
3898 set newtop [expr {$ybot - $wh}]
3899 if {$newtop < $wtop + $linespc} {
3900 set newtop [expr {$wtop + $linespc}]
3904 if {$newtop != $wtop} {
3905 if {$newtop < 0} {
3906 set newtop 0
3908 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3909 drawvisible
3912 if {![info exists linehtag($l)]} return
3913 $canv delete secsel
3914 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3915 -tags secsel -fill [$canv cget -selectbackground]]
3916 $canv lower $t
3917 $canv2 delete secsel
3918 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3919 -tags secsel -fill [$canv2 cget -selectbackground]]
3920 $canv2 lower $t
3921 $canv3 delete secsel
3922 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3923 -tags secsel -fill [$canv3 cget -selectbackground]]
3924 $canv3 lower $t
3926 if {$isnew} {
3927 addtohistory [list selectline $l 0]
3930 set selectedline $l
3932 set id [lindex $displayorder $l]
3933 set currentid $id
3934 $sha1entry delete 0 end
3935 $sha1entry insert 0 $id
3936 $sha1entry selection from 0
3937 $sha1entry selection to end
3938 rhighlight_sel $id
3940 $ctext conf -state normal
3941 clear_ctext
3942 set linknum 0
3943 set info $commitinfo($id)
3944 set date [formatdate [lindex $info 2]]
3945 $ctext insert end "Author: [lindex $info 1] $date\n"
3946 set date [formatdate [lindex $info 4]]
3947 $ctext insert end "Committer: [lindex $info 3] $date\n"
3948 if {[info exists idtags($id)]} {
3949 $ctext insert end "Tags:"
3950 foreach tag $idtags($id) {
3951 $ctext insert end " $tag"
3953 $ctext insert end "\n"
3956 set headers {}
3957 set olds [lindex $parentlist $l]
3958 if {[llength $olds] > 1} {
3959 set np 0
3960 foreach p $olds {
3961 if {$np >= $mergemax} {
3962 set tag mmax
3963 } else {
3964 set tag m$np
3966 $ctext insert end "Parent: " $tag
3967 appendwithlinks [commit_descriptor $p] {}
3968 incr np
3970 } else {
3971 foreach p $olds {
3972 append headers "Parent: [commit_descriptor $p]"
3976 foreach c [lindex $childlist $l] {
3977 append headers "Child: [commit_descriptor $c]"
3980 # make anything that looks like a SHA1 ID be a clickable link
3981 appendwithlinks $headers {}
3982 if {$showneartags} {
3983 if {![info exists allcommits]} {
3984 getallcommits
3986 $ctext insert end "Branch: "
3987 $ctext mark set branch "end -1c"
3988 $ctext mark gravity branch left
3989 if {[info exists desc_heads($id)]} {
3990 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3991 # turn "Branch" into "Branches"
3992 $ctext insert "branch -2c" "es"
3995 $ctext insert end "\nFollows: "
3996 $ctext mark set follows "end -1c"
3997 $ctext mark gravity follows left
3998 if {[info exists anc_tags($id)]} {
3999 appendrefs follows [taglist $anc_tags($id)] tagids
4001 $ctext insert end "\nPrecedes: "
4002 $ctext mark set precedes "end -1c"
4003 $ctext mark gravity precedes left
4004 if {[info exists desc_tags($id)]} {
4005 appendrefs precedes [taglist $desc_tags($id)] tagids
4007 $ctext insert end "\n"
4009 $ctext insert end "\n"
4010 appendwithlinks [lindex $info 5] {comment}
4012 $ctext tag delete Comments
4013 $ctext tag remove found 1.0 end
4014 $ctext conf -state disabled
4015 set commentend [$ctext index "end - 1c"]
4017 init_flist "Comments"
4018 if {$cmitmode eq "tree"} {
4019 gettree $id
4020 } elseif {[llength $olds] <= 1} {
4021 startdiff $id
4022 } else {
4023 mergediff $id $l
4027 proc selfirstline {} {
4028 unmarkmatches
4029 selectline 0 1
4032 proc sellastline {} {
4033 global numcommits
4034 unmarkmatches
4035 set l [expr {$numcommits - 1}]
4036 selectline $l 1
4039 proc selnextline {dir} {
4040 global selectedline
4041 if {![info exists selectedline]} return
4042 set l [expr {$selectedline + $dir}]
4043 unmarkmatches
4044 selectline $l 1
4047 proc selnextpage {dir} {
4048 global canv linespc selectedline numcommits
4050 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4051 if {$lpp < 1} {
4052 set lpp 1
4054 allcanvs yview scroll [expr {$dir * $lpp}] units
4055 drawvisible
4056 if {![info exists selectedline]} return
4057 set l [expr {$selectedline + $dir * $lpp}]
4058 if {$l < 0} {
4059 set l 0
4060 } elseif {$l >= $numcommits} {
4061 set l [expr $numcommits - 1]
4063 unmarkmatches
4064 selectline $l 1
4067 proc unselectline {} {
4068 global selectedline currentid
4070 catch {unset selectedline}
4071 catch {unset currentid}
4072 allcanvs delete secsel
4073 rhighlight_none
4074 cancel_next_highlight
4077 proc reselectline {} {
4078 global selectedline
4080 if {[info exists selectedline]} {
4081 selectline $selectedline 0
4085 proc addtohistory {cmd} {
4086 global history historyindex curview
4088 set elt [list $curview $cmd]
4089 if {$historyindex > 0
4090 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4091 return
4094 if {$historyindex < [llength $history]} {
4095 set history [lreplace $history $historyindex end $elt]
4096 } else {
4097 lappend history $elt
4099 incr historyindex
4100 if {$historyindex > 1} {
4101 .tf.bar.leftbut conf -state normal
4102 } else {
4103 .tf.bar.leftbut conf -state disabled
4105 .tf.bar.rightbut conf -state disabled
4108 proc godo {elt} {
4109 global curview
4111 set view [lindex $elt 0]
4112 set cmd [lindex $elt 1]
4113 if {$curview != $view} {
4114 showview $view
4116 eval $cmd
4119 proc goback {} {
4120 global history historyindex
4122 if {$historyindex > 1} {
4123 incr historyindex -1
4124 godo [lindex $history [expr {$historyindex - 1}]]
4125 .tf.bar.rightbut conf -state normal
4127 if {$historyindex <= 1} {
4128 .tf.bar.leftbut conf -state disabled
4132 proc goforw {} {
4133 global history historyindex
4135 if {$historyindex < [llength $history]} {
4136 set cmd [lindex $history $historyindex]
4137 incr historyindex
4138 godo $cmd
4139 .tf.bar.leftbut conf -state normal
4141 if {$historyindex >= [llength $history]} {
4142 .tf.bar.rightbut conf -state disabled
4146 proc gettree {id} {
4147 global treefilelist treeidlist diffids diffmergeid treepending
4149 set diffids $id
4150 catch {unset diffmergeid}
4151 if {![info exists treefilelist($id)]} {
4152 if {![info exists treepending]} {
4153 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4154 return
4156 set treepending $id
4157 set treefilelist($id) {}
4158 set treeidlist($id) {}
4159 fconfigure $gtf -blocking 0
4160 fileevent $gtf readable [list gettreeline $gtf $id]
4162 } else {
4163 setfilelist $id
4167 proc gettreeline {gtf id} {
4168 global treefilelist treeidlist treepending cmitmode diffids
4170 while {[gets $gtf line] >= 0} {
4171 if {[lindex $line 1] ne "blob"} continue
4172 set sha1 [lindex $line 2]
4173 set fname [lindex $line 3]
4174 lappend treefilelist($id) $fname
4175 lappend treeidlist($id) $sha1
4177 if {![eof $gtf]} return
4178 close $gtf
4179 unset treepending
4180 if {$cmitmode ne "tree"} {
4181 if {![info exists diffmergeid]} {
4182 gettreediffs $diffids
4184 } elseif {$id ne $diffids} {
4185 gettree $diffids
4186 } else {
4187 setfilelist $id
4191 proc showfile {f} {
4192 global treefilelist treeidlist diffids
4193 global ctext commentend
4195 set i [lsearch -exact $treefilelist($diffids) $f]
4196 if {$i < 0} {
4197 puts "oops, $f not in list for id $diffids"
4198 return
4200 set blob [lindex $treeidlist($diffids) $i]
4201 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4202 puts "oops, error reading blob $blob: $err"
4203 return
4205 fconfigure $bf -blocking 0
4206 fileevent $bf readable [list getblobline $bf $diffids]
4207 $ctext config -state normal
4208 clear_ctext $commentend
4209 $ctext insert end "\n"
4210 $ctext insert end "$f\n" filesep
4211 $ctext config -state disabled
4212 $ctext yview $commentend
4215 proc getblobline {bf id} {
4216 global diffids cmitmode ctext
4218 if {$id ne $diffids || $cmitmode ne "tree"} {
4219 catch {close $bf}
4220 return
4222 $ctext config -state normal
4223 while {[gets $bf line] >= 0} {
4224 $ctext insert end "$line\n"
4226 if {[eof $bf]} {
4227 # delete last newline
4228 $ctext delete "end - 2c" "end - 1c"
4229 close $bf
4231 $ctext config -state disabled
4234 proc mergediff {id l} {
4235 global diffmergeid diffopts mdifffd
4236 global diffids
4237 global parentlist
4239 set diffmergeid $id
4240 set diffids $id
4241 # this doesn't seem to actually affect anything...
4242 set env(GIT_DIFF_OPTS) $diffopts
4243 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4244 if {[catch {set mdf [open $cmd r]} err]} {
4245 error_popup "Error getting merge diffs: $err"
4246 return
4248 fconfigure $mdf -blocking 0
4249 set mdifffd($id) $mdf
4250 set np [llength [lindex $parentlist $l]]
4251 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4252 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4255 proc getmergediffline {mdf id np} {
4256 global diffmergeid ctext cflist nextupdate mergemax
4257 global difffilestart mdifffd
4259 set n [gets $mdf line]
4260 if {$n < 0} {
4261 if {[eof $mdf]} {
4262 close $mdf
4264 return
4266 if {![info exists diffmergeid] || $id != $diffmergeid
4267 || $mdf != $mdifffd($id)} {
4268 return
4270 $ctext conf -state normal
4271 if {[regexp {^diff --cc (.*)} $line match fname]} {
4272 # start of a new file
4273 $ctext insert end "\n"
4274 set here [$ctext index "end - 1c"]
4275 lappend difffilestart $here
4276 add_flist [list $fname]
4277 set l [expr {(78 - [string length $fname]) / 2}]
4278 set pad [string range "----------------------------------------" 1 $l]
4279 $ctext insert end "$pad $fname $pad\n" filesep
4280 } elseif {[regexp {^@@} $line]} {
4281 $ctext insert end "$line\n" hunksep
4282 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4283 # do nothing
4284 } else {
4285 # parse the prefix - one ' ', '-' or '+' for each parent
4286 set spaces {}
4287 set minuses {}
4288 set pluses {}
4289 set isbad 0
4290 for {set j 0} {$j < $np} {incr j} {
4291 set c [string range $line $j $j]
4292 if {$c == " "} {
4293 lappend spaces $j
4294 } elseif {$c == "-"} {
4295 lappend minuses $j
4296 } elseif {$c == "+"} {
4297 lappend pluses $j
4298 } else {
4299 set isbad 1
4300 break
4303 set tags {}
4304 set num {}
4305 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4306 # line doesn't appear in result, parents in $minuses have the line
4307 set num [lindex $minuses 0]
4308 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4309 # line appears in result, parents in $pluses don't have the line
4310 lappend tags mresult
4311 set num [lindex $spaces 0]
4313 if {$num ne {}} {
4314 if {$num >= $mergemax} {
4315 set num "max"
4317 lappend tags m$num
4319 $ctext insert end "$line\n" $tags
4321 $ctext conf -state disabled
4322 if {[clock clicks -milliseconds] >= $nextupdate} {
4323 incr nextupdate 100
4324 fileevent $mdf readable {}
4325 update
4326 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4330 proc startdiff {ids} {
4331 global treediffs diffids treepending diffmergeid
4333 set diffids $ids
4334 catch {unset diffmergeid}
4335 if {![info exists treediffs($ids)]} {
4336 if {![info exists treepending]} {
4337 gettreediffs $ids
4339 } else {
4340 addtocflist $ids
4344 proc addtocflist {ids} {
4345 global treediffs cflist
4346 add_flist $treediffs($ids)
4347 getblobdiffs $ids
4350 proc gettreediffs {ids} {
4351 global treediff treepending
4352 set treepending $ids
4353 set treediff {}
4354 if {[catch \
4355 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4356 ]} return
4357 fconfigure $gdtf -blocking 0
4358 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4361 proc gettreediffline {gdtf ids} {
4362 global treediff treediffs treepending diffids diffmergeid
4363 global cmitmode
4365 set n [gets $gdtf line]
4366 if {$n < 0} {
4367 if {![eof $gdtf]} return
4368 close $gdtf
4369 set treediffs($ids) $treediff
4370 unset treepending
4371 if {$cmitmode eq "tree"} {
4372 gettree $diffids
4373 } elseif {$ids != $diffids} {
4374 if {![info exists diffmergeid]} {
4375 gettreediffs $diffids
4377 } else {
4378 addtocflist $ids
4380 return
4382 set file [lindex $line 5]
4383 lappend treediff $file
4386 proc getblobdiffs {ids} {
4387 global diffopts blobdifffd diffids env curdifftag curtagstart
4388 global nextupdate diffinhdr treediffs
4390 set env(GIT_DIFF_OPTS) $diffopts
4391 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4392 if {[catch {set bdf [open $cmd r]} err]} {
4393 puts "error getting diffs: $err"
4394 return
4396 set diffinhdr 0
4397 fconfigure $bdf -blocking 0
4398 set blobdifffd($ids) $bdf
4399 set curdifftag Comments
4400 set curtagstart 0.0
4401 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4402 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4405 proc setinlist {var i val} {
4406 global $var
4408 while {[llength [set $var]] < $i} {
4409 lappend $var {}
4411 if {[llength [set $var]] == $i} {
4412 lappend $var $val
4413 } else {
4414 lset $var $i $val
4418 proc getblobdiffline {bdf ids} {
4419 global diffids blobdifffd ctext curdifftag curtagstart
4420 global diffnexthead diffnextnote difffilestart
4421 global nextupdate diffinhdr treediffs
4423 set n [gets $bdf line]
4424 if {$n < 0} {
4425 if {[eof $bdf]} {
4426 close $bdf
4427 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4428 $ctext tag add $curdifftag $curtagstart end
4431 return
4433 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4434 return
4436 $ctext conf -state normal
4437 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4438 # start of a new file
4439 $ctext insert end "\n"
4440 $ctext tag add $curdifftag $curtagstart end
4441 set here [$ctext index "end - 1c"]
4442 set curtagstart $here
4443 set header $newname
4444 set i [lsearch -exact $treediffs($ids) $fname]
4445 if {$i >= 0} {
4446 setinlist difffilestart $i $here
4448 if {$newname ne $fname} {
4449 set i [lsearch -exact $treediffs($ids) $newname]
4450 if {$i >= 0} {
4451 setinlist difffilestart $i $here
4454 set curdifftag "f:$fname"
4455 $ctext tag delete $curdifftag
4456 set l [expr {(78 - [string length $header]) / 2}]
4457 set pad [string range "----------------------------------------" 1 $l]
4458 $ctext insert end "$pad $header $pad\n" filesep
4459 set diffinhdr 1
4460 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4461 # do nothing
4462 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4463 set diffinhdr 0
4464 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4465 $line match f1l f1c f2l f2c rest]} {
4466 $ctext insert end "$line\n" hunksep
4467 set diffinhdr 0
4468 } else {
4469 set x [string range $line 0 0]
4470 if {$x == "-" || $x == "+"} {
4471 set tag [expr {$x == "+"}]
4472 $ctext insert end "$line\n" d$tag
4473 } elseif {$x == " "} {
4474 $ctext insert end "$line\n"
4475 } elseif {$diffinhdr || $x == "\\"} {
4476 # e.g. "\ No newline at end of file"
4477 $ctext insert end "$line\n" filesep
4478 } else {
4479 # Something else we don't recognize
4480 if {$curdifftag != "Comments"} {
4481 $ctext insert end "\n"
4482 $ctext tag add $curdifftag $curtagstart end
4483 set curtagstart [$ctext index "end - 1c"]
4484 set curdifftag Comments
4486 $ctext insert end "$line\n" filesep
4489 $ctext conf -state disabled
4490 if {[clock clicks -milliseconds] >= $nextupdate} {
4491 incr nextupdate 100
4492 fileevent $bdf readable {}
4493 update
4494 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4498 proc changediffdisp {} {
4499 global ctext diffelide
4501 $ctext tag conf d0 -elide [lindex $diffelide 0]
4502 $ctext tag conf d1 -elide [lindex $diffelide 1]
4505 proc prevfile {} {
4506 global difffilestart ctext
4507 set prev [lindex $difffilestart 0]
4508 set here [$ctext index @0,0]
4509 foreach loc $difffilestart {
4510 if {[$ctext compare $loc >= $here]} {
4511 $ctext yview $prev
4512 return
4514 set prev $loc
4516 $ctext yview $prev
4519 proc nextfile {} {
4520 global difffilestart ctext
4521 set here [$ctext index @0,0]
4522 foreach loc $difffilestart {
4523 if {[$ctext compare $loc > $here]} {
4524 $ctext yview $loc
4525 return
4530 proc clear_ctext {{first 1.0}} {
4531 global ctext smarktop smarkbot
4533 set l [lindex [split $first .] 0]
4534 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4535 set smarktop $l
4537 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4538 set smarkbot $l
4540 $ctext delete $first end
4543 proc incrsearch {name ix op} {
4544 global ctext searchstring searchdirn
4546 $ctext tag remove found 1.0 end
4547 if {[catch {$ctext index anchor}]} {
4548 # no anchor set, use start of selection, or of visible area
4549 set sel [$ctext tag ranges sel]
4550 if {$sel ne {}} {
4551 $ctext mark set anchor [lindex $sel 0]
4552 } elseif {$searchdirn eq "-forwards"} {
4553 $ctext mark set anchor @0,0
4554 } else {
4555 $ctext mark set anchor @0,[winfo height $ctext]
4558 if {$searchstring ne {}} {
4559 set here [$ctext search $searchdirn -- $searchstring anchor]
4560 if {$here ne {}} {
4561 $ctext see $here
4563 searchmarkvisible 1
4567 proc dosearch {} {
4568 global sstring ctext searchstring searchdirn
4570 focus $sstring
4571 $sstring icursor end
4572 set searchdirn -forwards
4573 if {$searchstring ne {}} {
4574 set sel [$ctext tag ranges sel]
4575 if {$sel ne {}} {
4576 set start "[lindex $sel 0] + 1c"
4577 } elseif {[catch {set start [$ctext index anchor]}]} {
4578 set start "@0,0"
4580 set match [$ctext search -count mlen -- $searchstring $start]
4581 $ctext tag remove sel 1.0 end
4582 if {$match eq {}} {
4583 bell
4584 return
4586 $ctext see $match
4587 set mend "$match + $mlen c"
4588 $ctext tag add sel $match $mend
4589 $ctext mark unset anchor
4593 proc dosearchback {} {
4594 global sstring ctext searchstring searchdirn
4596 focus $sstring
4597 $sstring icursor end
4598 set searchdirn -backwards
4599 if {$searchstring ne {}} {
4600 set sel [$ctext tag ranges sel]
4601 if {$sel ne {}} {
4602 set start [lindex $sel 0]
4603 } elseif {[catch {set start [$ctext index anchor]}]} {
4604 set start @0,[winfo height $ctext]
4606 set match [$ctext search -backwards -count ml -- $searchstring $start]
4607 $ctext tag remove sel 1.0 end
4608 if {$match eq {}} {
4609 bell
4610 return
4612 $ctext see $match
4613 set mend "$match + $ml c"
4614 $ctext tag add sel $match $mend
4615 $ctext mark unset anchor
4619 proc searchmark {first last} {
4620 global ctext searchstring
4622 set mend $first.0
4623 while {1} {
4624 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4625 if {$match eq {}} break
4626 set mend "$match + $mlen c"
4627 $ctext tag add found $match $mend
4631 proc searchmarkvisible {doall} {
4632 global ctext smarktop smarkbot
4634 set topline [lindex [split [$ctext index @0,0] .] 0]
4635 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4636 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4637 # no overlap with previous
4638 searchmark $topline $botline
4639 set smarktop $topline
4640 set smarkbot $botline
4641 } else {
4642 if {$topline < $smarktop} {
4643 searchmark $topline [expr {$smarktop-1}]
4644 set smarktop $topline
4646 if {$botline > $smarkbot} {
4647 searchmark [expr {$smarkbot+1}] $botline
4648 set smarkbot $botline
4653 proc scrolltext {f0 f1} {
4654 global searchstring
4656 .bleft.sb set $f0 $f1
4657 if {$searchstring ne {}} {
4658 searchmarkvisible 0
4662 proc setcoords {} {
4663 global linespc charspc canvx0 canvy0 mainfont
4664 global xspc1 xspc2 lthickness
4666 set linespc [font metrics $mainfont -linespace]
4667 set charspc [font measure $mainfont "m"]
4668 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4669 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4670 set lthickness [expr {int($linespc / 9) + 1}]
4671 set xspc1(0) $linespc
4672 set xspc2 $linespc
4675 proc redisplay {} {
4676 global canv
4677 global selectedline
4679 set ymax [lindex [$canv cget -scrollregion] 3]
4680 if {$ymax eq {} || $ymax == 0} return
4681 set span [$canv yview]
4682 clear_display
4683 setcanvscroll
4684 allcanvs yview moveto [lindex $span 0]
4685 drawvisible
4686 if {[info exists selectedline]} {
4687 selectline $selectedline 0
4688 allcanvs yview moveto [lindex $span 0]
4692 proc incrfont {inc} {
4693 global mainfont textfont ctext canv phase
4694 global stopped entries
4695 unmarkmatches
4696 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4697 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4698 setcoords
4699 $ctext conf -font $textfont
4700 $ctext tag conf filesep -font [concat $textfont bold]
4701 foreach e $entries {
4702 $e conf -font $mainfont
4704 if {$phase eq "getcommits"} {
4705 $canv itemconf textitems -font $mainfont
4707 redisplay
4710 proc clearsha1 {} {
4711 global sha1entry sha1string
4712 if {[string length $sha1string] == 40} {
4713 $sha1entry delete 0 end
4717 proc sha1change {n1 n2 op} {
4718 global sha1string currentid sha1but
4719 if {$sha1string == {}
4720 || ([info exists currentid] && $sha1string == $currentid)} {
4721 set state disabled
4722 } else {
4723 set state normal
4725 if {[$sha1but cget -state] == $state} return
4726 if {$state == "normal"} {
4727 $sha1but conf -state normal -relief raised -text "Goto: "
4728 } else {
4729 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4733 proc gotocommit {} {
4734 global sha1string currentid commitrow tagids headids
4735 global displayorder numcommits curview
4737 if {$sha1string == {}
4738 || ([info exists currentid] && $sha1string == $currentid)} return
4739 if {[info exists tagids($sha1string)]} {
4740 set id $tagids($sha1string)
4741 } elseif {[info exists headids($sha1string)]} {
4742 set id $headids($sha1string)
4743 } else {
4744 set id [string tolower $sha1string]
4745 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4746 set matches {}
4747 foreach i $displayorder {
4748 if {[string match $id* $i]} {
4749 lappend matches $i
4752 if {$matches ne {}} {
4753 if {[llength $matches] > 1} {
4754 error_popup "Short SHA1 id $id is ambiguous"
4755 return
4757 set id [lindex $matches 0]
4761 if {[info exists commitrow($curview,$id)]} {
4762 selectline $commitrow($curview,$id) 1
4763 return
4765 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4766 set type "SHA1 id"
4767 } else {
4768 set type "Tag/Head"
4770 error_popup "$type $sha1string is not known"
4773 proc lineenter {x y id} {
4774 global hoverx hovery hoverid hovertimer
4775 global commitinfo canv
4777 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4778 set hoverx $x
4779 set hovery $y
4780 set hoverid $id
4781 if {[info exists hovertimer]} {
4782 after cancel $hovertimer
4784 set hovertimer [after 500 linehover]
4785 $canv delete hover
4788 proc linemotion {x y id} {
4789 global hoverx hovery hoverid hovertimer
4791 if {[info exists hoverid] && $id == $hoverid} {
4792 set hoverx $x
4793 set hovery $y
4794 if {[info exists hovertimer]} {
4795 after cancel $hovertimer
4797 set hovertimer [after 500 linehover]
4801 proc lineleave {id} {
4802 global hoverid hovertimer canv
4804 if {[info exists hoverid] && $id == $hoverid} {
4805 $canv delete hover
4806 if {[info exists hovertimer]} {
4807 after cancel $hovertimer
4808 unset hovertimer
4810 unset hoverid
4814 proc linehover {} {
4815 global hoverx hovery hoverid hovertimer
4816 global canv linespc lthickness
4817 global commitinfo mainfont
4819 set text [lindex $commitinfo($hoverid) 0]
4820 set ymax [lindex [$canv cget -scrollregion] 3]
4821 if {$ymax == {}} return
4822 set yfrac [lindex [$canv yview] 0]
4823 set x [expr {$hoverx + 2 * $linespc}]
4824 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4825 set x0 [expr {$x - 2 * $lthickness}]
4826 set y0 [expr {$y - 2 * $lthickness}]
4827 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4828 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4829 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4830 -fill \#ffff80 -outline black -width 1 -tags hover]
4831 $canv raise $t
4832 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4833 -font $mainfont]
4834 $canv raise $t
4837 proc clickisonarrow {id y} {
4838 global lthickness
4840 set ranges [rowranges $id]
4841 set thresh [expr {2 * $lthickness + 6}]
4842 set n [expr {[llength $ranges] - 1}]
4843 for {set i 1} {$i < $n} {incr i} {
4844 set row [lindex $ranges $i]
4845 if {abs([yc $row] - $y) < $thresh} {
4846 return $i
4849 return {}
4852 proc arrowjump {id n y} {
4853 global canv
4855 # 1 <-> 2, 3 <-> 4, etc...
4856 set n [expr {(($n - 1) ^ 1) + 1}]
4857 set row [lindex [rowranges $id] $n]
4858 set yt [yc $row]
4859 set ymax [lindex [$canv cget -scrollregion] 3]
4860 if {$ymax eq {} || $ymax <= 0} return
4861 set view [$canv yview]
4862 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4863 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4864 if {$yfrac < 0} {
4865 set yfrac 0
4867 allcanvs yview moveto $yfrac
4870 proc lineclick {x y id isnew} {
4871 global ctext commitinfo children canv thickerline curview
4873 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4874 unmarkmatches
4875 unselectline
4876 normalline
4877 $canv delete hover
4878 # draw this line thicker than normal
4879 set thickerline $id
4880 drawlines $id
4881 if {$isnew} {
4882 set ymax [lindex [$canv cget -scrollregion] 3]
4883 if {$ymax eq {}} return
4884 set yfrac [lindex [$canv yview] 0]
4885 set y [expr {$y + $yfrac * $ymax}]
4887 set dirn [clickisonarrow $id $y]
4888 if {$dirn ne {}} {
4889 arrowjump $id $dirn $y
4890 return
4893 if {$isnew} {
4894 addtohistory [list lineclick $x $y $id 0]
4896 # fill the details pane with info about this line
4897 $ctext conf -state normal
4898 clear_ctext
4899 $ctext tag conf link -foreground blue -underline 1
4900 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4901 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4902 $ctext insert end "Parent:\t"
4903 $ctext insert end $id [list link link0]
4904 $ctext tag bind link0 <1> [list selbyid $id]
4905 set info $commitinfo($id)
4906 $ctext insert end "\n\t[lindex $info 0]\n"
4907 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4908 set date [formatdate [lindex $info 2]]
4909 $ctext insert end "\tDate:\t$date\n"
4910 set kids $children($curview,$id)
4911 if {$kids ne {}} {
4912 $ctext insert end "\nChildren:"
4913 set i 0
4914 foreach child $kids {
4915 incr i
4916 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4917 set info $commitinfo($child)
4918 $ctext insert end "\n\t"
4919 $ctext insert end $child [list link link$i]
4920 $ctext tag bind link$i <1> [list selbyid $child]
4921 $ctext insert end "\n\t[lindex $info 0]"
4922 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4923 set date [formatdate [lindex $info 2]]
4924 $ctext insert end "\n\tDate:\t$date\n"
4927 $ctext conf -state disabled
4928 init_flist {}
4931 proc normalline {} {
4932 global thickerline
4933 if {[info exists thickerline]} {
4934 set id $thickerline
4935 unset thickerline
4936 drawlines $id
4940 proc selbyid {id} {
4941 global commitrow curview
4942 if {[info exists commitrow($curview,$id)]} {
4943 selectline $commitrow($curview,$id) 1
4947 proc mstime {} {
4948 global startmstime
4949 if {![info exists startmstime]} {
4950 set startmstime [clock clicks -milliseconds]
4952 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4955 proc rowmenu {x y id} {
4956 global rowctxmenu commitrow selectedline rowmenuid curview
4958 if {![info exists selectedline]
4959 || $commitrow($curview,$id) eq $selectedline} {
4960 set state disabled
4961 } else {
4962 set state normal
4964 $rowctxmenu entryconfigure "Diff this*" -state $state
4965 $rowctxmenu entryconfigure "Diff selected*" -state $state
4966 $rowctxmenu entryconfigure "Make patch" -state $state
4967 set rowmenuid $id
4968 tk_popup $rowctxmenu $x $y
4971 proc diffvssel {dirn} {
4972 global rowmenuid selectedline displayorder
4974 if {![info exists selectedline]} return
4975 if {$dirn} {
4976 set oldid [lindex $displayorder $selectedline]
4977 set newid $rowmenuid
4978 } else {
4979 set oldid $rowmenuid
4980 set newid [lindex $displayorder $selectedline]
4982 addtohistory [list doseldiff $oldid $newid]
4983 doseldiff $oldid $newid
4986 proc doseldiff {oldid newid} {
4987 global ctext
4988 global commitinfo
4990 $ctext conf -state normal
4991 clear_ctext
4992 init_flist "Top"
4993 $ctext insert end "From "
4994 $ctext tag conf link -foreground blue -underline 1
4995 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4996 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4997 $ctext tag bind link0 <1> [list selbyid $oldid]
4998 $ctext insert end $oldid [list link link0]
4999 $ctext insert end "\n "
5000 $ctext insert end [lindex $commitinfo($oldid) 0]
5001 $ctext insert end "\n\nTo "
5002 $ctext tag bind link1 <1> [list selbyid $newid]
5003 $ctext insert end $newid [list link link1]
5004 $ctext insert end "\n "
5005 $ctext insert end [lindex $commitinfo($newid) 0]
5006 $ctext insert end "\n"
5007 $ctext conf -state disabled
5008 $ctext tag delete Comments
5009 $ctext tag remove found 1.0 end
5010 startdiff [list $oldid $newid]
5013 proc mkpatch {} {
5014 global rowmenuid currentid commitinfo patchtop patchnum
5016 if {![info exists currentid]} return
5017 set oldid $currentid
5018 set oldhead [lindex $commitinfo($oldid) 0]
5019 set newid $rowmenuid
5020 set newhead [lindex $commitinfo($newid) 0]
5021 set top .patch
5022 set patchtop $top
5023 catch {destroy $top}
5024 toplevel $top
5025 label $top.title -text "Generate patch"
5026 grid $top.title - -pady 10
5027 label $top.from -text "From:"
5028 entry $top.fromsha1 -width 40 -relief flat
5029 $top.fromsha1 insert 0 $oldid
5030 $top.fromsha1 conf -state readonly
5031 grid $top.from $top.fromsha1 -sticky w
5032 entry $top.fromhead -width 60 -relief flat
5033 $top.fromhead insert 0 $oldhead
5034 $top.fromhead conf -state readonly
5035 grid x $top.fromhead -sticky w
5036 label $top.to -text "To:"
5037 entry $top.tosha1 -width 40 -relief flat
5038 $top.tosha1 insert 0 $newid
5039 $top.tosha1 conf -state readonly
5040 grid $top.to $top.tosha1 -sticky w
5041 entry $top.tohead -width 60 -relief flat
5042 $top.tohead insert 0 $newhead
5043 $top.tohead conf -state readonly
5044 grid x $top.tohead -sticky w
5045 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5046 grid $top.rev x -pady 10
5047 label $top.flab -text "Output file:"
5048 entry $top.fname -width 60
5049 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5050 incr patchnum
5051 grid $top.flab $top.fname -sticky w
5052 frame $top.buts
5053 button $top.buts.gen -text "Generate" -command mkpatchgo
5054 button $top.buts.can -text "Cancel" -command mkpatchcan
5055 grid $top.buts.gen $top.buts.can
5056 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5057 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5058 grid $top.buts - -pady 10 -sticky ew
5059 focus $top.fname
5062 proc mkpatchrev {} {
5063 global patchtop
5065 set oldid [$patchtop.fromsha1 get]
5066 set oldhead [$patchtop.fromhead get]
5067 set newid [$patchtop.tosha1 get]
5068 set newhead [$patchtop.tohead get]
5069 foreach e [list fromsha1 fromhead tosha1 tohead] \
5070 v [list $newid $newhead $oldid $oldhead] {
5071 $patchtop.$e conf -state normal
5072 $patchtop.$e delete 0 end
5073 $patchtop.$e insert 0 $v
5074 $patchtop.$e conf -state readonly
5078 proc mkpatchgo {} {
5079 global patchtop
5081 set oldid [$patchtop.fromsha1 get]
5082 set newid [$patchtop.tosha1 get]
5083 set fname [$patchtop.fname get]
5084 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5085 error_popup "Error creating patch: $err"
5087 catch {destroy $patchtop}
5088 unset patchtop
5091 proc mkpatchcan {} {
5092 global patchtop
5094 catch {destroy $patchtop}
5095 unset patchtop
5098 proc mktag {} {
5099 global rowmenuid mktagtop commitinfo
5101 set top .maketag
5102 set mktagtop $top
5103 catch {destroy $top}
5104 toplevel $top
5105 label $top.title -text "Create tag"
5106 grid $top.title - -pady 10
5107 label $top.id -text "ID:"
5108 entry $top.sha1 -width 40 -relief flat
5109 $top.sha1 insert 0 $rowmenuid
5110 $top.sha1 conf -state readonly
5111 grid $top.id $top.sha1 -sticky w
5112 entry $top.head -width 60 -relief flat
5113 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5114 $top.head conf -state readonly
5115 grid x $top.head -sticky w
5116 label $top.tlab -text "Tag name:"
5117 entry $top.tag -width 60
5118 grid $top.tlab $top.tag -sticky w
5119 frame $top.buts
5120 button $top.buts.gen -text "Create" -command mktaggo
5121 button $top.buts.can -text "Cancel" -command mktagcan
5122 grid $top.buts.gen $top.buts.can
5123 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5124 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5125 grid $top.buts - -pady 10 -sticky ew
5126 focus $top.tag
5129 proc domktag {} {
5130 global mktagtop env tagids idtags
5132 set id [$mktagtop.sha1 get]
5133 set tag [$mktagtop.tag get]
5134 if {$tag == {}} {
5135 error_popup "No tag name specified"
5136 return
5138 if {[info exists tagids($tag)]} {
5139 error_popup "Tag \"$tag\" already exists"
5140 return
5142 if {[catch {
5143 set dir [gitdir]
5144 set fname [file join $dir "refs/tags" $tag]
5145 set f [open $fname w]
5146 puts $f $id
5147 close $f
5148 } err]} {
5149 error_popup "Error creating tag: $err"
5150 return
5153 set tagids($tag) $id
5154 lappend idtags($id) $tag
5155 redrawtags $id
5156 addedtag $id
5159 proc redrawtags {id} {
5160 global canv linehtag commitrow idpos selectedline curview
5161 global mainfont canvxmax
5163 if {![info exists commitrow($curview,$id)]} return
5164 drawcmitrow $commitrow($curview,$id)
5165 $canv delete tag.$id
5166 set xt [eval drawtags $id $idpos($id)]
5167 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5168 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5169 set xr [expr {$xt + [font measure $mainfont $text]}]
5170 if {$xr > $canvxmax} {
5171 set canvxmax $xr
5172 setcanvscroll
5174 if {[info exists selectedline]
5175 && $selectedline == $commitrow($curview,$id)} {
5176 selectline $selectedline 0
5180 proc mktagcan {} {
5181 global mktagtop
5183 catch {destroy $mktagtop}
5184 unset mktagtop
5187 proc mktaggo {} {
5188 domktag
5189 mktagcan
5192 proc writecommit {} {
5193 global rowmenuid wrcomtop commitinfo wrcomcmd
5195 set top .writecommit
5196 set wrcomtop $top
5197 catch {destroy $top}
5198 toplevel $top
5199 label $top.title -text "Write commit to file"
5200 grid $top.title - -pady 10
5201 label $top.id -text "ID:"
5202 entry $top.sha1 -width 40 -relief flat
5203 $top.sha1 insert 0 $rowmenuid
5204 $top.sha1 conf -state readonly
5205 grid $top.id $top.sha1 -sticky w
5206 entry $top.head -width 60 -relief flat
5207 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5208 $top.head conf -state readonly
5209 grid x $top.head -sticky w
5210 label $top.clab -text "Command:"
5211 entry $top.cmd -width 60 -textvariable wrcomcmd
5212 grid $top.clab $top.cmd -sticky w -pady 10
5213 label $top.flab -text "Output file:"
5214 entry $top.fname -width 60
5215 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5216 grid $top.flab $top.fname -sticky w
5217 frame $top.buts
5218 button $top.buts.gen -text "Write" -command wrcomgo
5219 button $top.buts.can -text "Cancel" -command wrcomcan
5220 grid $top.buts.gen $top.buts.can
5221 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5222 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5223 grid $top.buts - -pady 10 -sticky ew
5224 focus $top.fname
5227 proc wrcomgo {} {
5228 global wrcomtop
5230 set id [$wrcomtop.sha1 get]
5231 set cmd "echo $id | [$wrcomtop.cmd get]"
5232 set fname [$wrcomtop.fname get]
5233 if {[catch {exec sh -c $cmd >$fname &} err]} {
5234 error_popup "Error writing commit: $err"
5236 catch {destroy $wrcomtop}
5237 unset wrcomtop
5240 proc wrcomcan {} {
5241 global wrcomtop
5243 catch {destroy $wrcomtop}
5244 unset wrcomtop
5247 proc mkbranch {} {
5248 global rowmenuid mkbrtop
5250 set top .makebranch
5251 catch {destroy $top}
5252 toplevel $top
5253 label $top.title -text "Create new branch"
5254 grid $top.title - -pady 10
5255 label $top.id -text "ID:"
5256 entry $top.sha1 -width 40 -relief flat
5257 $top.sha1 insert 0 $rowmenuid
5258 $top.sha1 conf -state readonly
5259 grid $top.id $top.sha1 -sticky w
5260 label $top.nlab -text "Name:"
5261 entry $top.name -width 40
5262 grid $top.nlab $top.name -sticky w
5263 frame $top.buts
5264 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5265 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5266 grid $top.buts.go $top.buts.can
5267 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5268 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5269 grid $top.buts - -pady 10 -sticky ew
5270 focus $top.name
5273 proc mkbrgo {top} {
5274 global headids idheads
5276 set name [$top.name get]
5277 set id [$top.sha1 get]
5278 if {$name eq {}} {
5279 error_popup "Please specify a name for the new branch"
5280 return
5282 catch {destroy $top}
5283 nowbusy newbranch
5284 update
5285 if {[catch {
5286 exec git branch $name $id
5287 } err]} {
5288 notbusy newbranch
5289 error_popup $err
5290 } else {
5291 addedhead $id $name
5292 # XXX should update list of heads displayed for selected commit
5293 notbusy newbranch
5294 redrawtags $id
5298 proc cherrypick {} {
5299 global rowmenuid curview commitrow
5300 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5302 if {[info exists desc_heads($rowmenuid)]
5303 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5304 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5305 included in branch $mainhead -- really re-apply it?"]
5306 if {!$ok} return
5308 nowbusy cherrypick
5309 update
5310 set oldhead [exec git rev-parse HEAD]
5311 # Unfortunately git-cherry-pick writes stuff to stderr even when
5312 # no error occurs, and exec takes that as an indication of error...
5313 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5314 notbusy cherrypick
5315 error_popup $err
5316 return
5318 set newhead [exec git rev-parse HEAD]
5319 if {$newhead eq $oldhead} {
5320 notbusy cherrypick
5321 error_popup "No changes committed"
5322 return
5324 set allparents($newhead) $oldhead
5325 lappend allchildren($oldhead) $newhead
5326 set desc_heads($newhead) $mainhead
5327 if {[info exists anc_tags($oldhead)]} {
5328 set anc_tags($newhead) $anc_tags($oldhead)
5330 set desc_tags($newhead) {}
5331 if {[info exists commitrow($curview,$oldhead)]} {
5332 insertrow $commitrow($curview,$oldhead) $newhead
5333 if {$mainhead ne {}} {
5334 movedhead $newhead $mainhead
5336 redrawtags $oldhead
5337 redrawtags $newhead
5339 notbusy cherrypick
5342 # context menu for a head
5343 proc headmenu {x y id head} {
5344 global headmenuid headmenuhead headctxmenu
5346 set headmenuid $id
5347 set headmenuhead $head
5348 tk_popup $headctxmenu $x $y
5351 proc cobranch {} {
5352 global headmenuid headmenuhead mainhead headids
5354 # check the tree is clean first??
5355 set oldmainhead $mainhead
5356 nowbusy checkout
5357 update
5358 if {[catch {
5359 exec git checkout $headmenuhead
5360 } err]} {
5361 notbusy checkout
5362 error_popup $err
5363 } else {
5364 notbusy checkout
5365 set mainhead $headmenuhead
5366 if {[info exists headids($oldmainhead)]} {
5367 redrawtags $headids($oldmainhead)
5369 redrawtags $headmenuid
5373 proc rmbranch {} {
5374 global desc_heads headmenuid headmenuhead mainhead
5375 global headids idheads
5377 set head $headmenuhead
5378 set id $headmenuid
5379 if {$head eq $mainhead} {
5380 error_popup "Cannot delete the currently checked-out branch"
5381 return
5383 if {$desc_heads($id) eq $head} {
5384 # the stuff on this branch isn't on any other branch
5385 if {![confirm_popup "The commits on branch $head aren't on any other\
5386 branch.\nReally delete branch $head?"]} return
5388 nowbusy rmbranch
5389 update
5390 if {[catch {exec git branch -D $head} err]} {
5391 notbusy rmbranch
5392 error_popup $err
5393 return
5395 removedhead $id $head
5396 redrawtags $id
5397 notbusy rmbranch
5400 # Stuff for finding nearby tags
5401 proc getallcommits {} {
5402 global allcstart allcommits allcfd allids
5404 set allids {}
5405 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5406 set allcfd $fd
5407 fconfigure $fd -blocking 0
5408 set allcommits "reading"
5409 nowbusy allcommits
5410 restartgetall $fd
5413 proc discardallcommits {} {
5414 global allparents allchildren allcommits allcfd
5415 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5417 if {![info exists allcommits]} return
5418 if {$allcommits eq "reading"} {
5419 catch {close $allcfd}
5421 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5422 alldtags tagisdesc desc_heads} {
5423 catch {unset $v}
5427 proc restartgetall {fd} {
5428 global allcstart
5430 fileevent $fd readable [list getallclines $fd]
5431 set allcstart [clock clicks -milliseconds]
5434 proc combine_dtags {l1 l2} {
5435 global tagisdesc notfirstd
5437 set res [lsort -unique [concat $l1 $l2]]
5438 for {set i 0} {$i < [llength $res]} {incr i} {
5439 set x [lindex $res $i]
5440 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5441 set y [lindex $res $j]
5442 if {[info exists tagisdesc($x,$y)]} {
5443 if {$tagisdesc($x,$y) > 0} {
5444 # x is a descendent of y, exclude x
5445 set res [lreplace $res $i $i]
5446 incr i -1
5447 break
5448 } else {
5449 # y is a descendent of x, exclude y
5450 set res [lreplace $res $j $j]
5452 } else {
5453 # no relation, keep going
5454 incr j
5458 return $res
5461 proc combine_atags {l1 l2} {
5462 global tagisdesc
5464 set res [lsort -unique [concat $l1 $l2]]
5465 for {set i 0} {$i < [llength $res]} {incr i} {
5466 set x [lindex $res $i]
5467 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5468 set y [lindex $res $j]
5469 if {[info exists tagisdesc($x,$y)]} {
5470 if {$tagisdesc($x,$y) < 0} {
5471 # x is an ancestor of y, exclude x
5472 set res [lreplace $res $i $i]
5473 incr i -1
5474 break
5475 } else {
5476 # y is an ancestor of x, exclude y
5477 set res [lreplace $res $j $j]
5479 } else {
5480 # no relation, keep going
5481 incr j
5485 return $res
5488 proc forward_pass {id children} {
5489 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5491 set dtags {}
5492 set dheads {}
5493 foreach child $children {
5494 if {[info exists idtags($child)]} {
5495 set ctags [list $child]
5496 } else {
5497 set ctags $desc_tags($child)
5499 if {$dtags eq {}} {
5500 set dtags $ctags
5501 } elseif {$ctags ne $dtags} {
5502 set dtags [combine_dtags $dtags $ctags]
5504 set cheads $desc_heads($child)
5505 if {$dheads eq {}} {
5506 set dheads $cheads
5507 } elseif {$cheads ne $dheads} {
5508 set dheads [lsort -unique [concat $dheads $cheads]]
5511 set desc_tags($id) $dtags
5512 if {[info exists idtags($id)]} {
5513 set adt $dtags
5514 foreach tag $dtags {
5515 set adt [concat $adt $alldtags($tag)]
5517 set adt [lsort -unique $adt]
5518 set alldtags($id) $adt
5519 foreach tag $adt {
5520 set tagisdesc($id,$tag) -1
5521 set tagisdesc($tag,$id) 1
5524 if {[info exists idheads($id)]} {
5525 set dheads [concat $dheads $idheads($id)]
5527 set desc_heads($id) $dheads
5530 proc getallclines {fd} {
5531 global allparents allchildren allcommits allcstart
5532 global desc_tags anc_tags idtags tagisdesc allids
5533 global idheads travindex
5535 while {[gets $fd line] >= 0} {
5536 set id [lindex $line 0]
5537 lappend allids $id
5538 set olds [lrange $line 1 end]
5539 set allparents($id) $olds
5540 if {![info exists allchildren($id)]} {
5541 set allchildren($id) {}
5543 foreach p $olds {
5544 lappend allchildren($p) $id
5546 # compute nearest tagged descendents as we go
5547 # also compute descendent heads
5548 forward_pass $id $allchildren($id)
5549 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5550 fileevent $fd readable {}
5551 after idle restartgetall $fd
5552 return
5555 if {[eof $fd]} {
5556 set travindex [llength $allids]
5557 set allcommits "traversing"
5558 after idle restartatags
5559 if {[catch {close $fd} err]} {
5560 error_popup "Error reading full commit graph: $err.\n\
5561 Results may be incomplete."
5566 # walk backward through the tree and compute nearest tagged ancestors
5567 proc restartatags {} {
5568 global allids allparents idtags anc_tags travindex
5570 set t0 [clock clicks -milliseconds]
5571 set i $travindex
5572 while {[incr i -1] >= 0} {
5573 set id [lindex $allids $i]
5574 set atags {}
5575 foreach p $allparents($id) {
5576 if {[info exists idtags($p)]} {
5577 set ptags [list $p]
5578 } else {
5579 set ptags $anc_tags($p)
5581 if {$atags eq {}} {
5582 set atags $ptags
5583 } elseif {$ptags ne $atags} {
5584 set atags [combine_atags $atags $ptags]
5587 set anc_tags($id) $atags
5588 if {[clock clicks -milliseconds] - $t0 >= 50} {
5589 set travindex $i
5590 after idle restartatags
5591 return
5594 set allcommits "done"
5595 set travindex 0
5596 notbusy allcommits
5597 dispneartags
5600 # update the desc_tags and anc_tags arrays for a new tag just added
5601 proc addedtag {id} {
5602 global desc_tags anc_tags allparents allchildren allcommits
5603 global idtags tagisdesc alldtags
5605 if {![info exists desc_tags($id)]} return
5606 set adt $desc_tags($id)
5607 foreach t $desc_tags($id) {
5608 set adt [concat $adt $alldtags($t)]
5610 set adt [lsort -unique $adt]
5611 set alldtags($id) $adt
5612 foreach t $adt {
5613 set tagisdesc($id,$t) -1
5614 set tagisdesc($t,$id) 1
5616 if {[info exists anc_tags($id)]} {
5617 set todo $anc_tags($id)
5618 while {$todo ne {}} {
5619 set do [lindex $todo 0]
5620 set todo [lrange $todo 1 end]
5621 if {[info exists tagisdesc($id,$do)]} continue
5622 set tagisdesc($do,$id) -1
5623 set tagisdesc($id,$do) 1
5624 if {[info exists anc_tags($do)]} {
5625 set todo [concat $todo $anc_tags($do)]
5630 set lastold $desc_tags($id)
5631 set lastnew [list $id]
5632 set nup 0
5633 set nch 0
5634 set todo $allparents($id)
5635 while {$todo ne {}} {
5636 set do [lindex $todo 0]
5637 set todo [lrange $todo 1 end]
5638 if {![info exists desc_tags($do)]} continue
5639 if {$desc_tags($do) ne $lastold} {
5640 set lastold $desc_tags($do)
5641 set lastnew [combine_dtags $lastold [list $id]]
5642 incr nch
5644 if {$lastold eq $lastnew} continue
5645 set desc_tags($do) $lastnew
5646 incr nup
5647 if {![info exists idtags($do)]} {
5648 set todo [concat $todo $allparents($do)]
5652 if {![info exists anc_tags($id)]} return
5653 set lastold $anc_tags($id)
5654 set lastnew [list $id]
5655 set nup 0
5656 set nch 0
5657 set todo $allchildren($id)
5658 while {$todo ne {}} {
5659 set do [lindex $todo 0]
5660 set todo [lrange $todo 1 end]
5661 if {![info exists anc_tags($do)]} continue
5662 if {$anc_tags($do) ne $lastold} {
5663 set lastold $anc_tags($do)
5664 set lastnew [combine_atags $lastold [list $id]]
5665 incr nch
5667 if {$lastold eq $lastnew} continue
5668 set anc_tags($do) $lastnew
5669 incr nup
5670 if {![info exists idtags($do)]} {
5671 set todo [concat $todo $allchildren($do)]
5676 # update the desc_heads array for a new head just added
5677 proc addedhead {hid head} {
5678 global desc_heads allparents headids idheads
5680 set headids($head) $hid
5681 lappend idheads($hid) $head
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)] ||
5688 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5689 set oldheads $desc_heads($do)
5690 lappend desc_heads($do) $head
5691 set heads $desc_heads($do)
5692 while {1} {
5693 set p $allparents($do)
5694 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5695 $desc_heads($p) ne $oldheads} break
5696 set do $p
5697 set desc_heads($do) $heads
5699 set todo [concat $todo $p]
5703 # update the desc_heads array for a head just removed
5704 proc removedhead {hid head} {
5705 global desc_heads allparents headids idheads
5707 unset headids($head)
5708 if {$idheads($hid) eq $head} {
5709 unset idheads($hid)
5710 } else {
5711 set i [lsearch -exact $idheads($hid) $head]
5712 if {$i >= 0} {
5713 set idheads($hid) [lreplace $idheads($hid) $i $i]
5717 set todo [list $hid]
5718 while {$todo ne {}} {
5719 set do [lindex $todo 0]
5720 set todo [lrange $todo 1 end]
5721 if {![info exists desc_heads($do)]} continue
5722 set i [lsearch -exact $desc_heads($do) $head]
5723 if {$i < 0} continue
5724 set oldheads $desc_heads($do)
5725 set heads [lreplace $desc_heads($do) $i $i]
5726 while {1} {
5727 set desc_heads($do) $heads
5728 set p $allparents($do)
5729 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5730 $desc_heads($p) ne $oldheads} break
5731 set do $p
5733 set todo [concat $todo $p]
5737 # update things for a head moved to a child of its previous location
5738 proc movedhead {id name} {
5739 global headids idheads
5741 set oldid $headids($name)
5742 set headids($name) $id
5743 if {$idheads($oldid) eq $name} {
5744 unset idheads($oldid)
5745 } else {
5746 set i [lsearch -exact $idheads($oldid) $name]
5747 if {$i >= 0} {
5748 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5751 lappend idheads($id) $name
5754 proc changedrefs {} {
5755 global desc_heads desc_tags anc_tags allcommits allids
5756 global allchildren allparents idtags travindex
5758 if {![info exists allcommits]} return
5759 catch {unset desc_heads}
5760 catch {unset desc_tags}
5761 catch {unset anc_tags}
5762 catch {unset alldtags}
5763 catch {unset tagisdesc}
5764 foreach id $allids {
5765 forward_pass $id $allchildren($id)
5767 if {$allcommits ne "reading"} {
5768 set travindex [llength $allids]
5769 if {$allcommits ne "traversing"} {
5770 set allcommits "traversing"
5771 after idle restartatags
5776 proc rereadrefs {} {
5777 global idtags idheads idotherrefs mainhead
5779 set refids [concat [array names idtags] \
5780 [array names idheads] [array names idotherrefs]]
5781 foreach id $refids {
5782 if {![info exists ref($id)]} {
5783 set ref($id) [listrefs $id]
5786 set oldmainhead $mainhead
5787 readrefs
5788 changedrefs
5789 set refids [lsort -unique [concat $refids [array names idtags] \
5790 [array names idheads] [array names idotherrefs]]]
5791 foreach id $refids {
5792 set v [listrefs $id]
5793 if {![info exists ref($id)] || $ref($id) != $v ||
5794 ($id eq $oldmainhead && $id ne $mainhead) ||
5795 ($id eq $mainhead && $id ne $oldmainhead)} {
5796 redrawtags $id
5801 proc listrefs {id} {
5802 global idtags idheads idotherrefs
5804 set x {}
5805 if {[info exists idtags($id)]} {
5806 set x $idtags($id)
5808 set y {}
5809 if {[info exists idheads($id)]} {
5810 set y $idheads($id)
5812 set z {}
5813 if {[info exists idotherrefs($id)]} {
5814 set z $idotherrefs($id)
5816 return [list $x $y $z]
5819 proc showtag {tag isnew} {
5820 global ctext tagcontents tagids linknum
5822 if {$isnew} {
5823 addtohistory [list showtag $tag 0]
5825 $ctext conf -state normal
5826 clear_ctext
5827 set linknum 0
5828 if {[info exists tagcontents($tag)]} {
5829 set text $tagcontents($tag)
5830 } else {
5831 set text "Tag: $tag\nId: $tagids($tag)"
5833 appendwithlinks $text {}
5834 $ctext conf -state disabled
5835 init_flist {}
5838 proc doquit {} {
5839 global stopped
5840 set stopped 100
5841 savestuff .
5842 destroy .
5845 proc doprefs {} {
5846 global maxwidth maxgraphpct diffopts
5847 global oldprefs prefstop showneartags
5848 global bgcolor fgcolor ctext diffcolors
5849 global uifont
5851 set top .gitkprefs
5852 set prefstop $top
5853 if {[winfo exists $top]} {
5854 raise $top
5855 return
5857 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5858 set oldprefs($v) [set $v]
5860 toplevel $top
5861 wm title $top "Gitk preferences"
5862 label $top.ldisp -text "Commit list display options"
5863 $top.ldisp configure -font $uifont
5864 grid $top.ldisp - -sticky w -pady 10
5865 label $top.spacer -text " "
5866 label $top.maxwidthl -text "Maximum graph width (lines)" \
5867 -font optionfont
5868 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5869 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5870 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5871 -font optionfont
5872 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5873 grid x $top.maxpctl $top.maxpct -sticky w
5875 label $top.ddisp -text "Diff display options"
5876 $top.ddisp configure -font $uifont
5877 grid $top.ddisp - -sticky w -pady 10
5878 label $top.diffoptl -text "Options for diff program" \
5879 -font optionfont
5880 entry $top.diffopt -width 20 -textvariable diffopts
5881 grid x $top.diffoptl $top.diffopt -sticky w
5882 frame $top.ntag
5883 label $top.ntag.l -text "Display nearby tags" -font optionfont
5884 checkbutton $top.ntag.b -variable showneartags
5885 pack $top.ntag.b $top.ntag.l -side left
5886 grid x $top.ntag -sticky w
5888 label $top.cdisp -text "Colors: press to choose"
5889 $top.cdisp configure -font $uifont
5890 grid $top.cdisp - -sticky w -pady 10
5891 label $top.bg -padx 40 -relief sunk -background $bgcolor
5892 button $top.bgbut -text "Background" -font optionfont \
5893 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5894 grid x $top.bgbut $top.bg -sticky w
5895 label $top.fg -padx 40 -relief sunk -background $fgcolor
5896 button $top.fgbut -text "Foreground" -font optionfont \
5897 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5898 grid x $top.fgbut $top.fg -sticky w
5899 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5900 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5901 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5902 [list $ctext tag conf d0 -foreground]]
5903 grid x $top.diffoldbut $top.diffold -sticky w
5904 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5905 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5906 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5907 [list $ctext tag conf d1 -foreground]]
5908 grid x $top.diffnewbut $top.diffnew -sticky w
5909 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5910 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5911 -command [list choosecolor diffcolors 2 $top.hunksep \
5912 "diff hunk header" \
5913 [list $ctext tag conf hunksep -foreground]]
5914 grid x $top.hunksepbut $top.hunksep -sticky w
5916 frame $top.buts
5917 button $top.buts.ok -text "OK" -command prefsok -default active
5918 $top.buts.ok configure -font $uifont
5919 button $top.buts.can -text "Cancel" -command prefscan -default normal
5920 $top.buts.can configure -font $uifont
5921 grid $top.buts.ok $top.buts.can
5922 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5923 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5924 grid $top.buts - - -pady 10 -sticky ew
5925 bind $top <Visibility> "focus $top.buts.ok"
5928 proc choosecolor {v vi w x cmd} {
5929 global $v
5931 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5932 -title "Gitk: choose color for $x"]
5933 if {$c eq {}} return
5934 $w conf -background $c
5935 lset $v $vi $c
5936 eval $cmd $c
5939 proc setbg {c} {
5940 global bglist
5942 foreach w $bglist {
5943 $w conf -background $c
5947 proc setfg {c} {
5948 global fglist canv
5950 foreach w $fglist {
5951 $w conf -foreground $c
5953 allcanvs itemconf text -fill $c
5954 $canv itemconf circle -outline $c
5957 proc prefscan {} {
5958 global maxwidth maxgraphpct diffopts
5959 global oldprefs prefstop showneartags
5961 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5962 set $v $oldprefs($v)
5964 catch {destroy $prefstop}
5965 unset prefstop
5968 proc prefsok {} {
5969 global maxwidth maxgraphpct
5970 global oldprefs prefstop showneartags
5972 catch {destroy $prefstop}
5973 unset prefstop
5974 if {$maxwidth != $oldprefs(maxwidth)
5975 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5976 redisplay
5977 } elseif {$showneartags != $oldprefs(showneartags)} {
5978 reselectline
5982 proc formatdate {d} {
5983 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5986 # This list of encoding names and aliases is distilled from
5987 # http://www.iana.org/assignments/character-sets.
5988 # Not all of them are supported by Tcl.
5989 set encoding_aliases {
5990 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5991 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5992 { ISO-10646-UTF-1 csISO10646UTF1 }
5993 { ISO_646.basic:1983 ref csISO646basic1983 }
5994 { INVARIANT csINVARIANT }
5995 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5996 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5997 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5998 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5999 { NATS-DANO iso-ir-9-1 csNATSDANO }
6000 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6001 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6002 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6003 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6004 { ISO-2022-KR csISO2022KR }
6005 { EUC-KR csEUCKR }
6006 { ISO-2022-JP csISO2022JP }
6007 { ISO-2022-JP-2 csISO2022JP2 }
6008 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6009 csISO13JISC6220jp }
6010 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6011 { IT iso-ir-15 ISO646-IT csISO15Italian }
6012 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6013 { ES iso-ir-17 ISO646-ES csISO17Spanish }
6014 { greek7-old iso-ir-18 csISO18Greek7Old }
6015 { latin-greek iso-ir-19 csISO19LatinGreek }
6016 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6017 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6018 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6019 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6020 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6021 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6022 { INIS iso-ir-49 csISO49INIS }
6023 { INIS-8 iso-ir-50 csISO50INIS8 }
6024 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6025 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6026 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6027 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6028 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6029 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6030 csISO60Norwegian1 }
6031 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6032 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6033 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6034 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6035 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6036 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6037 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6038 { greek7 iso-ir-88 csISO88Greek7 }
6039 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6040 { iso-ir-90 csISO90 }
6041 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6042 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6043 csISO92JISC62991984b }
6044 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6045 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6046 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6047 csISO95JIS62291984handadd }
6048 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6049 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6050 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6051 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6052 CP819 csISOLatin1 }
6053 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6054 { T.61-7bit iso-ir-102 csISO102T617bit }
6055 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6056 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6057 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6058 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6059 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6060 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6061 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6062 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6063 arabic csISOLatinArabic }
6064 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6065 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6066 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6067 greek greek8 csISOLatinGreek }
6068 { T.101-G2 iso-ir-128 csISO128T101G2 }
6069 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6070 csISOLatinHebrew }
6071 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6072 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6073 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6074 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6075 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6076 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6077 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6078 csISOLatinCyrillic }
6079 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6080 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6081 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6082 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6083 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6084 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6085 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6086 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6087 { ISO_10367-box iso-ir-155 csISO10367Box }
6088 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6089 { latin-lap lap iso-ir-158 csISO158Lap }
6090 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6091 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6092 { us-dk csUSDK }
6093 { dk-us csDKUS }
6094 { JIS_X0201 X0201 csHalfWidthKatakana }
6095 { KSC5636 ISO646-KR csKSC5636 }
6096 { ISO-10646-UCS-2 csUnicode }
6097 { ISO-10646-UCS-4 csUCS4 }
6098 { DEC-MCS dec csDECMCS }
6099 { hp-roman8 roman8 r8 csHPRoman8 }
6100 { macintosh mac csMacintosh }
6101 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6102 csIBM037 }
6103 { IBM038 EBCDIC-INT cp038 csIBM038 }
6104 { IBM273 CP273 csIBM273 }
6105 { IBM274 EBCDIC-BE CP274 csIBM274 }
6106 { IBM275 EBCDIC-BR cp275 csIBM275 }
6107 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6108 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6109 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6110 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6111 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6112 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6113 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6114 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6115 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6116 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6117 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6118 { IBM437 cp437 437 csPC8CodePage437 }
6119 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6120 { IBM775 cp775 csPC775Baltic }
6121 { IBM850 cp850 850 csPC850Multilingual }
6122 { IBM851 cp851 851 csIBM851 }
6123 { IBM852 cp852 852 csPCp852 }
6124 { IBM855 cp855 855 csIBM855 }
6125 { IBM857 cp857 857 csIBM857 }
6126 { IBM860 cp860 860 csIBM860 }
6127 { IBM861 cp861 861 cp-is csIBM861 }
6128 { IBM862 cp862 862 csPC862LatinHebrew }
6129 { IBM863 cp863 863 csIBM863 }
6130 { IBM864 cp864 csIBM864 }
6131 { IBM865 cp865 865 csIBM865 }
6132 { IBM866 cp866 866 csIBM866 }
6133 { IBM868 CP868 cp-ar csIBM868 }
6134 { IBM869 cp869 869 cp-gr csIBM869 }
6135 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6136 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6137 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6138 { IBM891 cp891 csIBM891 }
6139 { IBM903 cp903 csIBM903 }
6140 { IBM904 cp904 904 csIBBM904 }
6141 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6142 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6143 { IBM1026 CP1026 csIBM1026 }
6144 { EBCDIC-AT-DE csIBMEBCDICATDE }
6145 { EBCDIC-AT-DE-A csEBCDICATDEA }
6146 { EBCDIC-CA-FR csEBCDICCAFR }
6147 { EBCDIC-DK-NO csEBCDICDKNO }
6148 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6149 { EBCDIC-FI-SE csEBCDICFISE }
6150 { EBCDIC-FI-SE-A csEBCDICFISEA }
6151 { EBCDIC-FR csEBCDICFR }
6152 { EBCDIC-IT csEBCDICIT }
6153 { EBCDIC-PT csEBCDICPT }
6154 { EBCDIC-ES csEBCDICES }
6155 { EBCDIC-ES-A csEBCDICESA }
6156 { EBCDIC-ES-S csEBCDICESS }
6157 { EBCDIC-UK csEBCDICUK }
6158 { EBCDIC-US csEBCDICUS }
6159 { UNKNOWN-8BIT csUnknown8BiT }
6160 { MNEMONIC csMnemonic }
6161 { MNEM csMnem }
6162 { VISCII csVISCII }
6163 { VIQR csVIQR }
6164 { KOI8-R csKOI8R }
6165 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6166 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6167 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6168 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6169 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6170 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6171 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6172 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6173 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6174 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6175 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6176 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6177 { IBM1047 IBM-1047 }
6178 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6179 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6180 { UNICODE-1-1 csUnicode11 }
6181 { CESU-8 csCESU-8 }
6182 { BOCU-1 csBOCU-1 }
6183 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6184 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6185 l8 }
6186 { ISO-8859-15 ISO_8859-15 Latin-9 }
6187 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6188 { GBK CP936 MS936 windows-936 }
6189 { JIS_Encoding csJISEncoding }
6190 { Shift_JIS MS_Kanji csShiftJIS }
6191 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6192 EUC-JP }
6193 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6194 { ISO-10646-UCS-Basic csUnicodeASCII }
6195 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6196 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6197 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6198 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6199 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6200 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6201 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6202 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6203 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6204 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6205 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6206 { Ventura-US csVenturaUS }
6207 { Ventura-International csVenturaInternational }
6208 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6209 { PC8-Turkish csPC8Turkish }
6210 { IBM-Symbols csIBMSymbols }
6211 { IBM-Thai csIBMThai }
6212 { HP-Legal csHPLegal }
6213 { HP-Pi-font csHPPiFont }
6214 { HP-Math8 csHPMath8 }
6215 { Adobe-Symbol-Encoding csHPPSMath }
6216 { HP-DeskTop csHPDesktop }
6217 { Ventura-Math csVenturaMath }
6218 { Microsoft-Publishing csMicrosoftPublishing }
6219 { Windows-31J csWindows31J }
6220 { GB2312 csGB2312 }
6221 { Big5 csBig5 }
6224 proc tcl_encoding {enc} {
6225 global encoding_aliases
6226 set names [encoding names]
6227 set lcnames [string tolower $names]
6228 set enc [string tolower $enc]
6229 set i [lsearch -exact $lcnames $enc]
6230 if {$i < 0} {
6231 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6232 if {[regsub {^iso[-_]} $enc iso encx]} {
6233 set i [lsearch -exact $lcnames $encx]
6236 if {$i < 0} {
6237 foreach l $encoding_aliases {
6238 set ll [string tolower $l]
6239 if {[lsearch -exact $ll $enc] < 0} continue
6240 # look through the aliases for one that tcl knows about
6241 foreach e $ll {
6242 set i [lsearch -exact $lcnames $e]
6243 if {$i < 0} {
6244 if {[regsub {^iso[-_]} $e iso ex]} {
6245 set i [lsearch -exact $lcnames $ex]
6248 if {$i >= 0} break
6250 break
6253 if {$i >= 0} {
6254 return [lindex $names $i]
6256 return {}
6259 # defaults...
6260 set datemode 0
6261 set diffopts "-U 5 -p"
6262 set wrcomcmd "git diff-tree --stdin -p --pretty"
6264 set gitencoding {}
6265 catch {
6266 set gitencoding [exec git config --get i18n.commitencoding]
6268 if {$gitencoding == ""} {
6269 set gitencoding "utf-8"
6271 set tclencoding [tcl_encoding $gitencoding]
6272 if {$tclencoding == {}} {
6273 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6276 set mainfont {Helvetica 9}
6277 set textfont {Courier 9}
6278 set uifont {Helvetica 9 bold}
6279 set findmergefiles 0
6280 set maxgraphpct 50
6281 set maxwidth 16
6282 set revlistorder 0
6283 set fastdate 0
6284 set uparrowlen 7
6285 set downarrowlen 7
6286 set mingaplen 30
6287 set cmitmode "patch"
6288 set wrapcomment "none"
6289 set showneartags 1
6291 set colors {green red blue magenta darkgrey brown orange}
6292 set bgcolor white
6293 set fgcolor black
6294 set diffcolors {red "#00a000" blue}
6296 catch {source ~/.gitk}
6298 font create optionfont -family sans-serif -size -12
6300 set revtreeargs {}
6301 foreach arg $argv {
6302 switch -regexp -- $arg {
6303 "^$" { }
6304 "^-d" { set datemode 1 }
6305 default {
6306 lappend revtreeargs $arg
6311 # check that we can find a .git directory somewhere...
6312 set gitdir [gitdir]
6313 if {![file isdirectory $gitdir]} {
6314 show_error {} . "Cannot find the git directory \"$gitdir\"."
6315 exit 1
6318 set cmdline_files {}
6319 set i [lsearch -exact $revtreeargs "--"]
6320 if {$i >= 0} {
6321 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6322 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6323 } elseif {$revtreeargs ne {}} {
6324 if {[catch {
6325 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6326 set cmdline_files [split $f "\n"]
6327 set n [llength $cmdline_files]
6328 set revtreeargs [lrange $revtreeargs 0 end-$n]
6329 } err]} {
6330 # unfortunately we get both stdout and stderr in $err,
6331 # so look for "fatal:".
6332 set i [string first "fatal:" $err]
6333 if {$i > 0} {
6334 set err [string range $err [expr {$i + 6}] end]
6336 show_error {} . "Bad arguments to gitk:\n$err"
6337 exit 1
6341 set history {}
6342 set historyindex 0
6343 set fh_serial 0
6344 set nhl_names {}
6345 set highlight_paths {}
6346 set searchdirn -forwards
6347 set boldrows {}
6348 set boldnamerows {}
6349 set diffelide {0 0}
6351 set optim_delay 16
6353 set nextviewnum 1
6354 set curview 0
6355 set selectedview 0
6356 set selectedhlview None
6357 set viewfiles(0) {}
6358 set viewperm(0) 0
6359 set viewargs(0) {}
6361 set cmdlineok 0
6362 set stopped 0
6363 set stuffsaved 0
6364 set patchnum 0
6365 setcoords
6366 makewindow
6367 wm title . "[file tail $argv0]: [file tail [pwd]]"
6368 readrefs
6370 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6371 # create a view for the files/dirs specified on the command line
6372 set curview 1
6373 set selectedview 1
6374 set nextviewnum 2
6375 set viewname(1) "Command line"
6376 set viewfiles(1) $cmdline_files
6377 set viewargs(1) $revtreeargs
6378 set viewperm(1) 0
6379 addviewmenu 1
6380 .bar.view entryconf Edit* -state normal
6381 .bar.view entryconf Delete* -state normal
6384 if {[info exists permviews]} {
6385 foreach v $permviews {
6386 set n $nextviewnum
6387 incr nextviewnum
6388 set viewname($n) [lindex $v 0]
6389 set viewfiles($n) [lindex $v 1]
6390 set viewargs($n) [lindex $v 2]
6391 set viewperm($n) 1
6392 addviewmenu $n
6395 getcommits