Code

gitk: Improve the behaviour of the initial selection
[git.git] / gitk
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]
16     }
17 }
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)]
30     }
31     set order "--topo-order"
32     if {$datemode} {
33         set order "--date-order"
34     }
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
41     }
42     set commfd($view) $fd
43     set leftover($view) {}
44     fconfigure $fd -blocking 0 -translation lf
45     if {$tclencoding != {}} {
46         fconfigure $fd -encoding $tclencoding
47     }
48     fileevent $fd readable [list getcommitlines $fd $view]
49     nowbusy $view
50 }
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
60     }
61     catch {close $fd}
62     unset commfd($curview)
63 }
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..."
72 }
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"
93             }
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.)"
101                 }
102             } else {
103                 set err "Error reading commits$fv: $err"
104             }
105             error_popup $err
106         }
107         if {$view == $curview} {
108             after idle finishcommits
109         }
110         return
111     }
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
119         }
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}]]
126         }
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]
136             }
137             set ok 1
138             foreach id $ids {
139                 if {[string length $id] != 40} {
140                     set ok 0
141                     break
142                 }
143             }
144         }
145         if {!$ok} {
146             set shortcmit $cmit
147             if {[string length $shortcmit] > 80} {
148                 set shortcmit "[string range $shortcmit 0 80]..."
149             }
150             error_popup "Can't parse git rev-list output: {$shortcmit}"
151             exit 1
152         }
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
160                 }
161                 incr i
162             }
163         } else {
164             set olds {}
165         }
166         if {![info exists children($view,$id)]} {
167             set children($view,$id) {}
168         }
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
182         }
183         set gotsome 1
184     }
185     if {$gotsome} {
186         if {$view == $curview} {
187             while {[layoutmore $nextupdate]} doupdate
188         } elseif {[info exists hlview] && $view == $hlview} {
189             vhighlightmore
190         }
191     }
192     if {[clock clicks -milliseconds] >= $nextupdate} {
193         doupdate
194     }
197 proc doupdate {} {
198     global commfd nextupdate numcommits
200     foreach v [array names commfd] {
201         fileevent $commfd($v) readable {}
202     }
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]
208     }
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 {}
223     }
224     set n $curview
225     foreach id $displayorder {
226         catch {unset children($n,$id)}
227         catch {unset commitrow($n,$id)}
228     }
229     set curview -1
230     catch {unset selectedline}
231     catch {unset thickerline}
232     catch {unset viewdata($n)}
233     readrefs
234     changedrefs
235     regetallcommits
236     showview $n
239 proc parsecommit {id contents listed} {
240     global commitinfo cdate
242     set inhdr 1
243     set comment {}
244     set headline {}
245     set auname {}
246     set audate {}
247     set comname {}
248     set comdate {}
249     set hdrend [string first "\n\n" $contents]
250     if {$hdrend < 0} {
251         # should never happen...
252         set hdrend [string length $contents]
253     }
254     set header [string range $contents 0 [expr {$hdrend - 1}]]
255     set comment [string range $contents [expr {$hdrend + 2}] end]
256     foreach line [split $header "\n"] {
257         set tag [lindex $line 0]
258         if {$tag == "author"} {
259             set audate [lindex $line end-1]
260             set auname [lrange $line 1 end-2]
261         } elseif {$tag == "committer"} {
262             set comdate [lindex $line end-1]
263             set comname [lrange $line 1 end-2]
264         }
265     }
266     set headline {}
267     # take the first line of the comment as the headline
268     set i [string first "\n" $comment]
269     if {$i >= 0} {
270         set headline [string trim [string range $comment 0 $i]]
271     } else {
272         set headline $comment
273     }
274     if {!$listed} {
275         # git rev-list indents the comment by 4 spaces;
276         # if we got this via git cat-file, add the indentation
277         set newcomment {}
278         foreach line [split $comment "\n"] {
279             append newcomment "    "
280             append newcomment $line
281             append newcomment "\n"
282         }
283         set comment $newcomment
284     }
285     if {$comdate != {}} {
286         set cdate($id) $comdate
287     }
288     set commitinfo($id) [list $headline $auname $audate \
289                              $comname $comdate $comment]
292 proc getcommit {id} {
293     global commitdata commitinfo
295     if {[info exists commitdata($id)]} {
296         parsecommit $id $commitdata($id) 1
297     } else {
298         readcommit $id
299         if {![info exists commitinfo($id)]} {
300             set commitinfo($id) {"No commit information available"}
301         }
302     }
303     return 1
306 proc readrefs {} {
307     global tagids idtags headids idheads tagcontents
308     global otherrefids idotherrefs mainhead
310     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
311         catch {unset $v}
312     }
313     set refd [open [list | git show-ref] r]
314     while {0 <= [set n [gets $refd line]]} {
315         if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
316             match id path]} {
317             continue
318         }
319         if {[regexp {^remotes/.*/HEAD$} $path match]} {
320             continue
321         }
322         if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
323             set type others
324             set name $path
325         }
326         if {[regexp {^remotes/} $path match]} {
327             set type heads
328         }
329         if {$type == "tags"} {
330             set tagids($name) $id
331             lappend idtags($id) $name
332             set obj {}
333             set type {}
334             set tag {}
335             catch {
336                 set commit [exec git rev-parse "$id^0"]
337                 if {$commit != $id} {
338                     set tagids($name) $commit
339                     lappend idtags($commit) $name
340                 }
341             }           
342             catch {
343                 set tagcontents($name) [exec git cat-file tag $id]
344             }
345         } elseif { $type == "heads" } {
346             set headids($name) $id
347             lappend idheads($id) $name
348         } else {
349             set otherrefids($name) $id
350             lappend idotherrefs($id) $name
351         }
352     }
353     close $refd
354     set mainhead {}
355     catch {
356         set thehead [exec git symbolic-ref HEAD]
357         if {[string match "refs/heads/*" $thehead]} {
358             set mainhead [string range $thehead 11 end]
359         }
360     }
363 # update things for a head moved to a child of its previous location
364 proc movehead {id name} {
365     global headids idheads
367     removehead $headids($name) $name
368     set headids($name) $id
369     lappend idheads($id) $name
372 # update things when a head has been removed
373 proc removehead {id name} {
374     global headids idheads
376     if {$idheads($id) eq $name} {
377         unset idheads($id)
378     } else {
379         set i [lsearch -exact $idheads($id) $name]
380         if {$i >= 0} {
381             set idheads($id) [lreplace $idheads($id) $i $i]
382         }
383     }
384     unset headids($name)
387 proc show_error {w top msg} {
388     message $w.m -text $msg -justify center -aspect 400
389     pack $w.m -side top -fill x -padx 20 -pady 20
390     button $w.ok -text OK -command "destroy $top"
391     pack $w.ok -side bottom -fill x
392     bind $top <Visibility> "grab $top; focus $top"
393     bind $top <Key-Return> "destroy $top"
394     tkwait window $top
397 proc error_popup msg {
398     set w .error
399     toplevel $w
400     wm transient $w .
401     show_error $w $w $msg
404 proc confirm_popup msg {
405     global confirm_ok
406     set confirm_ok 0
407     set w .confirm
408     toplevel $w
409     wm transient $w .
410     message $w.m -text $msg -justify center -aspect 400
411     pack $w.m -side top -fill x -padx 20 -pady 20
412     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
413     pack $w.ok -side left -fill x
414     button $w.cancel -text Cancel -command "destroy $w"
415     pack $w.cancel -side right -fill x
416     bind $w <Visibility> "grab $w; focus $w"
417     tkwait window $w
418     return $confirm_ok
421 proc makewindow {} {
422     global canv canv2 canv3 linespc charspc ctext cflist
423     global textfont mainfont uifont tabstop
424     global findtype findtypemenu findloc findstring fstring geometry
425     global entries sha1entry sha1string sha1but
426     global maincursor textcursor curtextcursor
427     global rowctxmenu mergemax wrapcomment
428     global highlight_files gdttype
429     global searchstring sstring
430     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
431     global headctxmenu
433     menu .bar
434     .bar add cascade -label "File" -menu .bar.file
435     .bar configure -font $uifont
436     menu .bar.file
437     .bar.file add command -label "Update" -command updatecommits
438     .bar.file add command -label "Reread references" -command rereadrefs
439     .bar.file add command -label "Quit" -command doquit
440     .bar.file configure -font $uifont
441     menu .bar.edit
442     .bar add cascade -label "Edit" -menu .bar.edit
443     .bar.edit add command -label "Preferences" -command doprefs
444     .bar.edit configure -font $uifont
446     menu .bar.view -font $uifont
447     .bar add cascade -label "View" -menu .bar.view
448     .bar.view add command -label "New view..." -command {newview 0}
449     .bar.view add command -label "Edit view..." -command editview \
450         -state disabled
451     .bar.view add command -label "Delete view" -command delview -state disabled
452     .bar.view add separator
453     .bar.view add radiobutton -label "All files" -command {showview 0} \
454         -variable selectedview -value 0
456     menu .bar.help
457     .bar add cascade -label "Help" -menu .bar.help
458     .bar.help add command -label "About gitk" -command about
459     .bar.help add command -label "Key bindings" -command keys
460     .bar.help configure -font $uifont
461     . configure -menu .bar
463     # the gui has upper and lower half, parts of a paned window.
464     panedwindow .ctop -orient vertical
466     # possibly use assumed geometry
467     if {![info exists geometry(pwsash0)]} {
468         set geometry(topheight) [expr {15 * $linespc}]
469         set geometry(topwidth) [expr {80 * $charspc}]
470         set geometry(botheight) [expr {15 * $linespc}]
471         set geometry(botwidth) [expr {50 * $charspc}]
472         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
473         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
474     }
476     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
477     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
478     frame .tf.histframe
479     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
481     # create three canvases
482     set cscroll .tf.histframe.csb
483     set canv .tf.histframe.pwclist.canv
484     canvas $canv \
485         -selectbackground $selectbgcolor \
486         -background $bgcolor -bd 0 \
487         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
488     .tf.histframe.pwclist add $canv
489     set canv2 .tf.histframe.pwclist.canv2
490     canvas $canv2 \
491         -selectbackground $selectbgcolor \
492         -background $bgcolor -bd 0 -yscrollincr $linespc
493     .tf.histframe.pwclist add $canv2
494     set canv3 .tf.histframe.pwclist.canv3
495     canvas $canv3 \
496         -selectbackground $selectbgcolor \
497         -background $bgcolor -bd 0 -yscrollincr $linespc
498     .tf.histframe.pwclist add $canv3
499     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
500     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
502     # a scroll bar to rule them
503     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
504     pack $cscroll -side right -fill y
505     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
506     lappend bglist $canv $canv2 $canv3
507     pack .tf.histframe.pwclist -fill both -expand 1 -side left
509     # we have two button bars at bottom of top frame. Bar 1
510     frame .tf.bar
511     frame .tf.lbar -height 15
513     set sha1entry .tf.bar.sha1
514     set entries $sha1entry
515     set sha1but .tf.bar.sha1label
516     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
517         -command gotocommit -width 8 -font $uifont
518     $sha1but conf -disabledforeground [$sha1but cget -foreground]
519     pack .tf.bar.sha1label -side left
520     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
521     trace add variable sha1string write sha1change
522     pack $sha1entry -side left -pady 2
524     image create bitmap bm-left -data {
525         #define left_width 16
526         #define left_height 16
527         static unsigned char left_bits[] = {
528         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
529         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
530         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
531     }
532     image create bitmap bm-right -data {
533         #define right_width 16
534         #define right_height 16
535         static unsigned char right_bits[] = {
536         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
537         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
538         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
539     }
540     button .tf.bar.leftbut -image bm-left -command goback \
541         -state disabled -width 26
542     pack .tf.bar.leftbut -side left -fill y
543     button .tf.bar.rightbut -image bm-right -command goforw \
544         -state disabled -width 26
545     pack .tf.bar.rightbut -side left -fill y
547     button .tf.bar.findbut -text "Find" -command dofind -font $uifont
548     pack .tf.bar.findbut -side left
549     set findstring {}
550     set fstring .tf.bar.findstring
551     lappend entries $fstring
552     entry $fstring -width 30 -font $textfont -textvariable findstring
553     trace add variable findstring write find_change
554     pack $fstring -side left -expand 1 -fill x -in .tf.bar
555     set findtype Exact
556     set findtypemenu [tk_optionMenu .tf.bar.findtype \
557                       findtype Exact IgnCase Regexp]
558     trace add variable findtype write find_change
559     .tf.bar.findtype configure -font $uifont
560     .tf.bar.findtype.menu configure -font $uifont
561     set findloc "All fields"
562     tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
563         Comments Author Committer
564     trace add variable findloc write find_change
565     .tf.bar.findloc configure -font $uifont
566     .tf.bar.findloc.menu configure -font $uifont
567     pack .tf.bar.findloc -side right
568     pack .tf.bar.findtype -side right
570     # build up the bottom bar of upper window
571     label .tf.lbar.flabel -text "Highlight:  Commits " \
572     -font $uifont
573     pack .tf.lbar.flabel -side left -fill y
574     set gdttype "touching paths:"
575     set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
576         "adding/removing string:"]
577     trace add variable gdttype write hfiles_change
578     $gm conf -font $uifont
579     .tf.lbar.gdttype conf -font $uifont
580     pack .tf.lbar.gdttype -side left -fill y
581     entry .tf.lbar.fent -width 25 -font $textfont \
582         -textvariable highlight_files
583     trace add variable highlight_files write hfiles_change
584     lappend entries .tf.lbar.fent
585     pack .tf.lbar.fent -side left -fill x -expand 1
586     label .tf.lbar.vlabel -text " OR in view" -font $uifont
587     pack .tf.lbar.vlabel -side left -fill y
588     global viewhlmenu selectedhlview
589     set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
590     $viewhlmenu entryconf None -command delvhighlight
591     $viewhlmenu conf -font $uifont
592     .tf.lbar.vhl conf -font $uifont
593     pack .tf.lbar.vhl -side left -fill y
594     label .tf.lbar.rlabel -text " OR " -font $uifont
595     pack .tf.lbar.rlabel -side left -fill y
596     global highlight_related
597     set m [tk_optionMenu .tf.lbar.relm highlight_related None \
598         "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
599     $m conf -font $uifont
600     .tf.lbar.relm conf -font $uifont
601     trace add variable highlight_related write vrel_change
602     pack .tf.lbar.relm -side left -fill y
604     # Finish putting the upper half of the viewer together
605     pack .tf.lbar -in .tf -side bottom -fill x
606     pack .tf.bar -in .tf -side bottom -fill x
607     pack .tf.histframe -fill both -side top -expand 1
608     .ctop add .tf
609     .ctop paneconfigure .tf -height $geometry(topheight)
610     .ctop paneconfigure .tf -width $geometry(topwidth)
612     # now build up the bottom
613     panedwindow .pwbottom -orient horizontal
615     # lower left, a text box over search bar, scroll bar to the right
616     # if we know window height, then that will set the lower text height, otherwise
617     # we set lower text height which will drive window height
618     if {[info exists geometry(main)]} {
619         frame .bleft -width $geometry(botwidth)
620     } else {
621         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
622     }
623     frame .bleft.top
624     frame .bleft.mid
626     button .bleft.top.search -text "Search" -command dosearch \
627         -font $uifont
628     pack .bleft.top.search -side left -padx 5
629     set sstring .bleft.top.sstring
630     entry $sstring -width 20 -font $textfont -textvariable searchstring
631     lappend entries $sstring
632     trace add variable searchstring write incrsearch
633     pack $sstring -side left -expand 1 -fill x
634     radiobutton .bleft.mid.diff -text "Diff" \
635         -command changediffdisp -variable diffelide -value {0 0}
636     radiobutton .bleft.mid.old -text "Old version" \
637         -command changediffdisp -variable diffelide -value {0 1}
638     radiobutton .bleft.mid.new -text "New version" \
639         -command changediffdisp -variable diffelide -value {1 0}
640     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
641     set ctext .bleft.ctext
642     text $ctext -background $bgcolor -foreground $fgcolor \
643         -tabs "[expr {$tabstop * $charspc}]" \
644         -state disabled -font $textfont \
645         -yscrollcommand scrolltext -wrap none
646     scrollbar .bleft.sb -command "$ctext yview"
647     pack .bleft.top -side top -fill x
648     pack .bleft.mid -side top -fill x
649     pack .bleft.sb -side right -fill y
650     pack $ctext -side left -fill both -expand 1
651     lappend bglist $ctext
652     lappend fglist $ctext
654     $ctext tag conf comment -wrap $wrapcomment
655     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
656     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
657     $ctext tag conf d0 -fore [lindex $diffcolors 0]
658     $ctext tag conf d1 -fore [lindex $diffcolors 1]
659     $ctext tag conf m0 -fore red
660     $ctext tag conf m1 -fore blue
661     $ctext tag conf m2 -fore green
662     $ctext tag conf m3 -fore purple
663     $ctext tag conf m4 -fore brown
664     $ctext tag conf m5 -fore "#009090"
665     $ctext tag conf m6 -fore magenta
666     $ctext tag conf m7 -fore "#808000"
667     $ctext tag conf m8 -fore "#009000"
668     $ctext tag conf m9 -fore "#ff0080"
669     $ctext tag conf m10 -fore cyan
670     $ctext tag conf m11 -fore "#b07070"
671     $ctext tag conf m12 -fore "#70b0f0"
672     $ctext tag conf m13 -fore "#70f0b0"
673     $ctext tag conf m14 -fore "#f0b070"
674     $ctext tag conf m15 -fore "#ff70b0"
675     $ctext tag conf mmax -fore darkgrey
676     set mergemax 16
677     $ctext tag conf mresult -font [concat $textfont bold]
678     $ctext tag conf msep -font [concat $textfont bold]
679     $ctext tag conf found -back yellow
681     .pwbottom add .bleft
682     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
684     # lower right
685     frame .bright
686     frame .bright.mode
687     radiobutton .bright.mode.patch -text "Patch" \
688         -command reselectline -variable cmitmode -value "patch"
689     .bright.mode.patch configure -font $uifont
690     radiobutton .bright.mode.tree -text "Tree" \
691         -command reselectline -variable cmitmode -value "tree"
692     .bright.mode.tree configure -font $uifont
693     grid .bright.mode.patch .bright.mode.tree -sticky ew
694     pack .bright.mode -side top -fill x
695     set cflist .bright.cfiles
696     set indent [font measure $mainfont "nn"]
697     text $cflist \
698         -selectbackground $selectbgcolor \
699         -background $bgcolor -foreground $fgcolor \
700         -font $mainfont \
701         -tabs [list $indent [expr {2 * $indent}]] \
702         -yscrollcommand ".bright.sb set" \
703         -cursor [. cget -cursor] \
704         -spacing1 1 -spacing3 1
705     lappend bglist $cflist
706     lappend fglist $cflist
707     scrollbar .bright.sb -command "$cflist yview"
708     pack .bright.sb -side right -fill y
709     pack $cflist -side left -fill both -expand 1
710     $cflist tag configure highlight \
711         -background [$cflist cget -selectbackground]
712     $cflist tag configure bold -font [concat $mainfont bold]
714     .pwbottom add .bright
715     .ctop add .pwbottom
717     # restore window position if known
718     if {[info exists geometry(main)]} {
719         wm geometry . "$geometry(main)"
720     }
722     bind .pwbottom <Configure> {resizecdetpanes %W %w}
723     pack .ctop -fill both -expand 1
724     bindall <1> {selcanvline %W %x %y}
725     #bindall <B1-Motion> {selcanvline %W %x %y}
726     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
727     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
728     bindall <2> "canvscan mark %W %x %y"
729     bindall <B2-Motion> "canvscan dragto %W %x %y"
730     bindkey <Home> selfirstline
731     bindkey <End> sellastline
732     bind . <Key-Up> "selnextline -1"
733     bind . <Key-Down> "selnextline 1"
734     bind . <Shift-Key-Up> "next_highlight -1"
735     bind . <Shift-Key-Down> "next_highlight 1"
736     bindkey <Key-Right> "goforw"
737     bindkey <Key-Left> "goback"
738     bind . <Key-Prior> "selnextpage -1"
739     bind . <Key-Next> "selnextpage 1"
740     bind . <Control-Home> "allcanvs yview moveto 0.0"
741     bind . <Control-End> "allcanvs yview moveto 1.0"
742     bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
743     bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
744     bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
745     bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
746     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
747     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
748     bindkey <Key-space> "$ctext yview scroll 1 pages"
749     bindkey p "selnextline -1"
750     bindkey n "selnextline 1"
751     bindkey z "goback"
752     bindkey x "goforw"
753     bindkey i "selnextline -1"
754     bindkey k "selnextline 1"
755     bindkey j "goback"
756     bindkey l "goforw"
757     bindkey b "$ctext yview scroll -1 pages"
758     bindkey d "$ctext yview scroll 18 units"
759     bindkey u "$ctext yview scroll -18 units"
760     bindkey / {findnext 1}
761     bindkey <Key-Return> {findnext 0}
762     bindkey ? findprev
763     bindkey f nextfile
764     bindkey <F5> updatecommits
765     bind . <Control-q> doquit
766     bind . <Control-f> dofind
767     bind . <Control-g> {findnext 0}
768     bind . <Control-r> dosearchback
769     bind . <Control-s> dosearch
770     bind . <Control-equal> {incrfont 1}
771     bind . <Control-KP_Add> {incrfont 1}
772     bind . <Control-minus> {incrfont -1}
773     bind . <Control-KP_Subtract> {incrfont -1}
774     wm protocol . WM_DELETE_WINDOW doquit
775     bind . <Button-1> "click %W"
776     bind $fstring <Key-Return> dofind
777     bind $sha1entry <Key-Return> gotocommit
778     bind $sha1entry <<PasteSelection>> clearsha1
779     bind $cflist <1> {sel_flist %W %x %y; break}
780     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
781     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
783     set maincursor [. cget -cursor]
784     set textcursor [$ctext cget -cursor]
785     set curtextcursor $textcursor
787     set rowctxmenu .rowctxmenu
788     menu $rowctxmenu -tearoff 0
789     $rowctxmenu add command -label "Diff this -> selected" \
790         -command {diffvssel 0}
791     $rowctxmenu add command -label "Diff selected -> this" \
792         -command {diffvssel 1}
793     $rowctxmenu add command -label "Make patch" -command mkpatch
794     $rowctxmenu add command -label "Create tag" -command mktag
795     $rowctxmenu add command -label "Write commit to file" -command writecommit
796     $rowctxmenu add command -label "Create new branch" -command mkbranch
797     $rowctxmenu add command -label "Cherry-pick this commit" \
798         -command cherrypick
800     set headctxmenu .headctxmenu
801     menu $headctxmenu -tearoff 0
802     $headctxmenu add command -label "Check out this branch" \
803         -command cobranch
804     $headctxmenu add command -label "Remove this branch" \
805         -command rmbranch
808 # mouse-2 makes all windows scan vertically, but only the one
809 # the cursor is in scans horizontally
810 proc canvscan {op w x y} {
811     global canv canv2 canv3
812     foreach c [list $canv $canv2 $canv3] {
813         if {$c == $w} {
814             $c scan $op $x $y
815         } else {
816             $c scan $op 0 $y
817         }
818     }
821 proc scrollcanv {cscroll f0 f1} {
822     $cscroll set $f0 $f1
823     drawfrac $f0 $f1
824     flushhighlights
827 # when we make a key binding for the toplevel, make sure
828 # it doesn't get triggered when that key is pressed in the
829 # find string entry widget.
830 proc bindkey {ev script} {
831     global entries
832     bind . $ev $script
833     set escript [bind Entry $ev]
834     if {$escript == {}} {
835         set escript [bind Entry <Key>]
836     }
837     foreach e $entries {
838         bind $e $ev "$escript; break"
839     }
842 # set the focus back to the toplevel for any click outside
843 # the entry widgets
844 proc click {w} {
845     global entries
846     foreach e $entries {
847         if {$w == $e} return
848     }
849     focus .
852 proc savestuff {w} {
853     global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
854     global stuffsaved findmergefiles maxgraphpct
855     global maxwidth showneartags
856     global viewname viewfiles viewargs viewperm nextviewnum
857     global cmitmode wrapcomment
858     global colors bgcolor fgcolor diffcolors selectbgcolor
860     if {$stuffsaved} return
861     if {![winfo viewable .]} return
862     catch {
863         set f [open "~/.gitk-new" w]
864         puts $f [list set mainfont $mainfont]
865         puts $f [list set textfont $textfont]
866         puts $f [list set uifont $uifont]
867         puts $f [list set tabstop $tabstop]
868         puts $f [list set findmergefiles $findmergefiles]
869         puts $f [list set maxgraphpct $maxgraphpct]
870         puts $f [list set maxwidth $maxwidth]
871         puts $f [list set cmitmode $cmitmode]
872         puts $f [list set wrapcomment $wrapcomment]
873         puts $f [list set showneartags $showneartags]
874         puts $f [list set bgcolor $bgcolor]
875         puts $f [list set fgcolor $fgcolor]
876         puts $f [list set colors $colors]
877         puts $f [list set diffcolors $diffcolors]
878         puts $f [list set selectbgcolor $selectbgcolor]
880         puts $f "set geometry(main) [wm geometry .]"
881         puts $f "set geometry(topwidth) [winfo width .tf]"
882         puts $f "set geometry(topheight) [winfo height .tf]"
883         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
884         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
885         puts $f "set geometry(botwidth) [winfo width .bleft]"
886         puts $f "set geometry(botheight) [winfo height .bleft]"
888         puts -nonewline $f "set permviews {"
889         for {set v 0} {$v < $nextviewnum} {incr v} {
890             if {$viewperm($v)} {
891                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
892             }
893         }
894         puts $f "}"
895         close $f
896         file rename -force "~/.gitk-new" "~/.gitk"
897     }
898     set stuffsaved 1
901 proc resizeclistpanes {win w} {
902     global oldwidth
903     if {[info exists oldwidth($win)]} {
904         set s0 [$win sash coord 0]
905         set s1 [$win sash coord 1]
906         if {$w < 60} {
907             set sash0 [expr {int($w/2 - 2)}]
908             set sash1 [expr {int($w*5/6 - 2)}]
909         } else {
910             set factor [expr {1.0 * $w / $oldwidth($win)}]
911             set sash0 [expr {int($factor * [lindex $s0 0])}]
912             set sash1 [expr {int($factor * [lindex $s1 0])}]
913             if {$sash0 < 30} {
914                 set sash0 30
915             }
916             if {$sash1 < $sash0 + 20} {
917                 set sash1 [expr {$sash0 + 20}]
918             }
919             if {$sash1 > $w - 10} {
920                 set sash1 [expr {$w - 10}]
921                 if {$sash0 > $sash1 - 20} {
922                     set sash0 [expr {$sash1 - 20}]
923                 }
924             }
925         }
926         $win sash place 0 $sash0 [lindex $s0 1]
927         $win sash place 1 $sash1 [lindex $s1 1]
928     }
929     set oldwidth($win) $w
932 proc resizecdetpanes {win w} {
933     global oldwidth
934     if {[info exists oldwidth($win)]} {
935         set s0 [$win sash coord 0]
936         if {$w < 60} {
937             set sash0 [expr {int($w*3/4 - 2)}]
938         } else {
939             set factor [expr {1.0 * $w / $oldwidth($win)}]
940             set sash0 [expr {int($factor * [lindex $s0 0])}]
941             if {$sash0 < 45} {
942                 set sash0 45
943             }
944             if {$sash0 > $w - 15} {
945                 set sash0 [expr {$w - 15}]
946             }
947         }
948         $win sash place 0 $sash0 [lindex $s0 1]
949     }
950     set oldwidth($win) $w
953 proc allcanvs args {
954     global canv canv2 canv3
955     eval $canv $args
956     eval $canv2 $args
957     eval $canv3 $args
960 proc bindall {event action} {
961     global canv canv2 canv3
962     bind $canv $event $action
963     bind $canv2 $event $action
964     bind $canv3 $event $action
967 proc about {} {
968     global uifont
969     set w .about
970     if {[winfo exists $w]} {
971         raise $w
972         return
973     }
974     toplevel $w
975     wm title $w "About gitk"
976     message $w.m -text {
977 Gitk - a commit viewer for git
979 Copyright Â© 2005-2006 Paul Mackerras
981 Use and redistribute under the terms of the GNU General Public License} \
982             -justify center -aspect 400 -border 2 -bg white -relief groove
983     pack $w.m -side top -fill x -padx 2 -pady 2
984     $w.m configure -font $uifont
985     button $w.ok -text Close -command "destroy $w" -default active
986     pack $w.ok -side bottom
987     $w.ok configure -font $uifont
988     bind $w <Visibility> "focus $w.ok"
989     bind $w <Key-Escape> "destroy $w"
990     bind $w <Key-Return> "destroy $w"
993 proc keys {} {
994     global uifont
995     set w .keys
996     if {[winfo exists $w]} {
997         raise $w
998         return
999     }
1000     toplevel $w
1001     wm title $w "Gitk key bindings"
1002     message $w.m -text {
1003 Gitk key bindings:
1005 <Ctrl-Q>                Quit
1006 <Home>          Move to first commit
1007 <End>           Move to last commit
1008 <Up>, p, i      Move up one commit
1009 <Down>, n, k    Move down one commit
1010 <Left>, z, j    Go back in history list
1011 <Right>, x, l   Go forward in history list
1012 <PageUp>        Move up one page in commit list
1013 <PageDown>      Move down one page in commit list
1014 <Ctrl-Home>     Scroll to top of commit list
1015 <Ctrl-End>      Scroll to bottom of commit list
1016 <Ctrl-Up>       Scroll commit list up one line
1017 <Ctrl-Down>     Scroll commit list down one line
1018 <Ctrl-PageUp>   Scroll commit list up one page
1019 <Ctrl-PageDown> Scroll commit list down one page
1020 <Shift-Up>      Move to previous highlighted line
1021 <Shift-Down>    Move to next highlighted line
1022 <Delete>, b     Scroll diff view up one page
1023 <Backspace>     Scroll diff view up one page
1024 <Space>         Scroll diff view down one page
1025 u               Scroll diff view up 18 lines
1026 d               Scroll diff view down 18 lines
1027 <Ctrl-F>                Find
1028 <Ctrl-G>                Move to next find hit
1029 <Return>        Move to next find hit
1030 /               Move to next find hit, or redo find
1031 ?               Move to previous find hit
1032 f               Scroll diff view to next file
1033 <Ctrl-S>                Search for next hit in diff view
1034 <Ctrl-R>                Search for previous hit in diff view
1035 <Ctrl-KP+>      Increase font size
1036 <Ctrl-plus>     Increase font size
1037 <Ctrl-KP->      Decrease font size
1038 <Ctrl-minus>    Decrease font size
1039 <F5>            Update
1040 } \
1041             -justify left -bg white -border 2 -relief groove
1042     pack $w.m -side top -fill both -padx 2 -pady 2
1043     $w.m configure -font $uifont
1044     button $w.ok -text Close -command "destroy $w" -default active
1045     pack $w.ok -side bottom
1046     $w.ok configure -font $uifont
1047     bind $w <Visibility> "focus $w.ok"
1048     bind $w <Key-Escape> "destroy $w"
1049     bind $w <Key-Return> "destroy $w"
1052 # Procedures for manipulating the file list window at the
1053 # bottom right of the overall window.
1055 proc treeview {w l openlevs} {
1056     global treecontents treediropen treeheight treeparent treeindex
1058     set ix 0
1059     set treeindex() 0
1060     set lev 0
1061     set prefix {}
1062     set prefixend -1
1063     set prefendstack {}
1064     set htstack {}
1065     set ht 0
1066     set treecontents() {}
1067     $w conf -state normal
1068     foreach f $l {
1069         while {[string range $f 0 $prefixend] ne $prefix} {
1070             if {$lev <= $openlevs} {
1071                 $w mark set e:$treeindex($prefix) "end -1c"
1072                 $w mark gravity e:$treeindex($prefix) left
1073             }
1074             set treeheight($prefix) $ht
1075             incr ht [lindex $htstack end]
1076             set htstack [lreplace $htstack end end]
1077             set prefixend [lindex $prefendstack end]
1078             set prefendstack [lreplace $prefendstack end end]
1079             set prefix [string range $prefix 0 $prefixend]
1080             incr lev -1
1081         }
1082         set tail [string range $f [expr {$prefixend+1}] end]
1083         while {[set slash [string first "/" $tail]] >= 0} {
1084             lappend htstack $ht
1085             set ht 0
1086             lappend prefendstack $prefixend
1087             incr prefixend [expr {$slash + 1}]
1088             set d [string range $tail 0 $slash]
1089             lappend treecontents($prefix) $d
1090             set oldprefix $prefix
1091             append prefix $d
1092             set treecontents($prefix) {}
1093             set treeindex($prefix) [incr ix]
1094             set treeparent($prefix) $oldprefix
1095             set tail [string range $tail [expr {$slash+1}] end]
1096             if {$lev <= $openlevs} {
1097                 set ht 1
1098                 set treediropen($prefix) [expr {$lev < $openlevs}]
1099                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1100                 $w mark set d:$ix "end -1c"
1101                 $w mark gravity d:$ix left
1102                 set str "\n"
1103                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1104                 $w insert end $str
1105                 $w image create end -align center -image $bm -padx 1 \
1106                     -name a:$ix
1107                 $w insert end $d [highlight_tag $prefix]
1108                 $w mark set s:$ix "end -1c"
1109                 $w mark gravity s:$ix left
1110             }
1111             incr lev
1112         }
1113         if {$tail ne {}} {
1114             if {$lev <= $openlevs} {
1115                 incr ht
1116                 set str "\n"
1117                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1118                 $w insert end $str
1119                 $w insert end $tail [highlight_tag $f]
1120             }
1121             lappend treecontents($prefix) $tail
1122         }
1123     }
1124     while {$htstack ne {}} {
1125         set treeheight($prefix) $ht
1126         incr ht [lindex $htstack end]
1127         set htstack [lreplace $htstack end end]
1128     }
1129     $w conf -state disabled
1132 proc linetoelt {l} {
1133     global treeheight treecontents
1135     set y 2
1136     set prefix {}
1137     while {1} {
1138         foreach e $treecontents($prefix) {
1139             if {$y == $l} {
1140                 return "$prefix$e"
1141             }
1142             set n 1
1143             if {[string index $e end] eq "/"} {
1144                 set n $treeheight($prefix$e)
1145                 if {$y + $n > $l} {
1146                     append prefix $e
1147                     incr y
1148                     break
1149                 }
1150             }
1151             incr y $n
1152         }
1153     }
1156 proc highlight_tree {y prefix} {
1157     global treeheight treecontents cflist
1159     foreach e $treecontents($prefix) {
1160         set path $prefix$e
1161         if {[highlight_tag $path] ne {}} {
1162             $cflist tag add bold $y.0 "$y.0 lineend"
1163         }
1164         incr y
1165         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1166             set y [highlight_tree $y $path]
1167         }
1168     }
1169     return $y
1172 proc treeclosedir {w dir} {
1173     global treediropen treeheight treeparent treeindex
1175     set ix $treeindex($dir)
1176     $w conf -state normal
1177     $w delete s:$ix e:$ix
1178     set treediropen($dir) 0
1179     $w image configure a:$ix -image tri-rt
1180     $w conf -state disabled
1181     set n [expr {1 - $treeheight($dir)}]
1182     while {$dir ne {}} {
1183         incr treeheight($dir) $n
1184         set dir $treeparent($dir)
1185     }
1188 proc treeopendir {w dir} {
1189     global treediropen treeheight treeparent treecontents treeindex
1191     set ix $treeindex($dir)
1192     $w conf -state normal
1193     $w image configure a:$ix -image tri-dn
1194     $w mark set e:$ix s:$ix
1195     $w mark gravity e:$ix right
1196     set lev 0
1197     set str "\n"
1198     set n [llength $treecontents($dir)]
1199     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1200         incr lev
1201         append str "\t"
1202         incr treeheight($x) $n
1203     }
1204     foreach e $treecontents($dir) {
1205         set de $dir$e
1206         if {[string index $e end] eq "/"} {
1207             set iy $treeindex($de)
1208             $w mark set d:$iy e:$ix
1209             $w mark gravity d:$iy left
1210             $w insert e:$ix $str
1211             set treediropen($de) 0
1212             $w image create e:$ix -align center -image tri-rt -padx 1 \
1213                 -name a:$iy
1214             $w insert e:$ix $e [highlight_tag $de]
1215             $w mark set s:$iy e:$ix
1216             $w mark gravity s:$iy left
1217             set treeheight($de) 1
1218         } else {
1219             $w insert e:$ix $str
1220             $w insert e:$ix $e [highlight_tag $de]
1221         }
1222     }
1223     $w mark gravity e:$ix left
1224     $w conf -state disabled
1225     set treediropen($dir) 1
1226     set top [lindex [split [$w index @0,0] .] 0]
1227     set ht [$w cget -height]
1228     set l [lindex [split [$w index s:$ix] .] 0]
1229     if {$l < $top} {
1230         $w yview $l.0
1231     } elseif {$l + $n + 1 > $top + $ht} {
1232         set top [expr {$l + $n + 2 - $ht}]
1233         if {$l < $top} {
1234             set top $l
1235         }
1236         $w yview $top.0
1237     }
1240 proc treeclick {w x y} {
1241     global treediropen cmitmode ctext cflist cflist_top
1243     if {$cmitmode ne "tree"} return
1244     if {![info exists cflist_top]} return
1245     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1246     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1247     $cflist tag add highlight $l.0 "$l.0 lineend"
1248     set cflist_top $l
1249     if {$l == 1} {
1250         $ctext yview 1.0
1251         return
1252     }
1253     set e [linetoelt $l]
1254     if {[string index $e end] ne "/"} {
1255         showfile $e
1256     } elseif {$treediropen($e)} {
1257         treeclosedir $w $e
1258     } else {
1259         treeopendir $w $e
1260     }
1263 proc setfilelist {id} {
1264     global treefilelist cflist
1266     treeview $cflist $treefilelist($id) 0
1269 image create bitmap tri-rt -background black -foreground blue -data {
1270     #define tri-rt_width 13
1271     #define tri-rt_height 13
1272     static unsigned char tri-rt_bits[] = {
1273        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1274        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1275        0x00, 0x00};
1276 } -maskdata {
1277     #define tri-rt-mask_width 13
1278     #define tri-rt-mask_height 13
1279     static unsigned char tri-rt-mask_bits[] = {
1280        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1281        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1282        0x08, 0x00};
1284 image create bitmap tri-dn -background black -foreground blue -data {
1285     #define tri-dn_width 13
1286     #define tri-dn_height 13
1287     static unsigned char tri-dn_bits[] = {
1288        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1289        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1290        0x00, 0x00};
1291 } -maskdata {
1292     #define tri-dn-mask_width 13
1293     #define tri-dn-mask_height 13
1294     static unsigned char tri-dn-mask_bits[] = {
1295        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1296        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1297        0x00, 0x00};
1300 proc init_flist {first} {
1301     global cflist cflist_top selectedline difffilestart
1303     $cflist conf -state normal
1304     $cflist delete 0.0 end
1305     if {$first ne {}} {
1306         $cflist insert end $first
1307         set cflist_top 1
1308         $cflist tag add highlight 1.0 "1.0 lineend"
1309     } else {
1310         catch {unset cflist_top}
1311     }
1312     $cflist conf -state disabled
1313     set difffilestart {}
1316 proc highlight_tag {f} {
1317     global highlight_paths
1319     foreach p $highlight_paths {
1320         if {[string match $p $f]} {
1321             return "bold"
1322         }
1323     }
1324     return {}
1327 proc highlight_filelist {} {
1328     global cmitmode cflist
1330     $cflist conf -state normal
1331     if {$cmitmode ne "tree"} {
1332         set end [lindex [split [$cflist index end] .] 0]
1333         for {set l 2} {$l < $end} {incr l} {
1334             set line [$cflist get $l.0 "$l.0 lineend"]
1335             if {[highlight_tag $line] ne {}} {
1336                 $cflist tag add bold $l.0 "$l.0 lineend"
1337             }
1338         }
1339     } else {
1340         highlight_tree 2 {}
1341     }
1342     $cflist conf -state disabled
1345 proc unhighlight_filelist {} {
1346     global cflist
1348     $cflist conf -state normal
1349     $cflist tag remove bold 1.0 end
1350     $cflist conf -state disabled
1353 proc add_flist {fl} {
1354     global cflist
1356     $cflist conf -state normal
1357     foreach f $fl {
1358         $cflist insert end "\n"
1359         $cflist insert end $f [highlight_tag $f]
1360     }
1361     $cflist conf -state disabled
1364 proc sel_flist {w x y} {
1365     global ctext difffilestart cflist cflist_top cmitmode
1367     if {$cmitmode eq "tree"} return
1368     if {![info exists cflist_top]} return
1369     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1370     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1371     $cflist tag add highlight $l.0 "$l.0 lineend"
1372     set cflist_top $l
1373     if {$l == 1} {
1374         $ctext yview 1.0
1375     } else {
1376         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1377     }
1380 # Functions for adding and removing shell-type quoting
1382 proc shellquote {str} {
1383     if {![string match "*\['\"\\ \t]*" $str]} {
1384         return $str
1385     }
1386     if {![string match "*\['\"\\]*" $str]} {
1387         return "\"$str\""
1388     }
1389     if {![string match "*'*" $str]} {
1390         return "'$str'"
1391     }
1392     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1395 proc shellarglist {l} {
1396     set str {}
1397     foreach a $l {
1398         if {$str ne {}} {
1399             append str " "
1400         }
1401         append str [shellquote $a]
1402     }
1403     return $str
1406 proc shelldequote {str} {
1407     set ret {}
1408     set used -1
1409     while {1} {
1410         incr used
1411         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1412             append ret [string range $str $used end]
1413             set used [string length $str]
1414             break
1415         }
1416         set first [lindex $first 0]
1417         set ch [string index $str $first]
1418         if {$first > $used} {
1419             append ret [string range $str $used [expr {$first - 1}]]
1420             set used $first
1421         }
1422         if {$ch eq " " || $ch eq "\t"} break
1423         incr used
1424         if {$ch eq "'"} {
1425             set first [string first "'" $str $used]
1426             if {$first < 0} {
1427                 error "unmatched single-quote"
1428             }
1429             append ret [string range $str $used [expr {$first - 1}]]
1430             set used $first
1431             continue
1432         }
1433         if {$ch eq "\\"} {
1434             if {$used >= [string length $str]} {
1435                 error "trailing backslash"
1436             }
1437             append ret [string index $str $used]
1438             continue
1439         }
1440         # here ch == "\""
1441         while {1} {
1442             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1443                 error "unmatched double-quote"
1444             }
1445             set first [lindex $first 0]
1446             set ch [string index $str $first]
1447             if {$first > $used} {
1448                 append ret [string range $str $used [expr {$first - 1}]]
1449                 set used $first
1450             }
1451             if {$ch eq "\""} break
1452             incr used
1453             append ret [string index $str $used]
1454             incr used
1455         }
1456     }
1457     return [list $used $ret]
1460 proc shellsplit {str} {
1461     set l {}
1462     while {1} {
1463         set str [string trimleft $str]
1464         if {$str eq {}} break
1465         set dq [shelldequote $str]
1466         set n [lindex $dq 0]
1467         set word [lindex $dq 1]
1468         set str [string range $str $n end]
1469         lappend l $word
1470     }
1471     return $l
1474 # Code to implement multiple views
1476 proc newview {ishighlight} {
1477     global nextviewnum newviewname newviewperm uifont newishighlight
1478     global newviewargs revtreeargs
1480     set newishighlight $ishighlight
1481     set top .gitkview
1482     if {[winfo exists $top]} {
1483         raise $top
1484         return
1485     }
1486     set newviewname($nextviewnum) "View $nextviewnum"
1487     set newviewperm($nextviewnum) 0
1488     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1489     vieweditor $top $nextviewnum "Gitk view definition"
1492 proc editview {} {
1493     global curview
1494     global viewname viewperm newviewname newviewperm
1495     global viewargs newviewargs
1497     set top .gitkvedit-$curview
1498     if {[winfo exists $top]} {
1499         raise $top
1500         return
1501     }
1502     set newviewname($curview) $viewname($curview)
1503     set newviewperm($curview) $viewperm($curview)
1504     set newviewargs($curview) [shellarglist $viewargs($curview)]
1505     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1508 proc vieweditor {top n title} {
1509     global newviewname newviewperm viewfiles
1510     global uifont
1512     toplevel $top
1513     wm title $top $title
1514     label $top.nl -text "Name" -font $uifont
1515     entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1516     grid $top.nl $top.name -sticky w -pady 5
1517     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1518         -font $uifont
1519     grid $top.perm - -pady 5 -sticky w
1520     message $top.al -aspect 1000 -font $uifont \
1521         -text "Commits to include (arguments to git rev-list):"
1522     grid $top.al - -sticky w -pady 5
1523     entry $top.args -width 50 -textvariable newviewargs($n) \
1524         -background white -font $uifont
1525     grid $top.args - -sticky ew -padx 5
1526     message $top.l -aspect 1000 -font $uifont \
1527         -text "Enter files and directories to include, one per line:"
1528     grid $top.l - -sticky w
1529     text $top.t -width 40 -height 10 -background white -font $uifont
1530     if {[info exists viewfiles($n)]} {
1531         foreach f $viewfiles($n) {
1532             $top.t insert end $f
1533             $top.t insert end "\n"
1534         }
1535         $top.t delete {end - 1c} end
1536         $top.t mark set insert 0.0
1537     }
1538     grid $top.t - -sticky ew -padx 5
1539     frame $top.buts
1540     button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1541         -font $uifont
1542     button $top.buts.can -text "Cancel" -command [list destroy $top] \
1543         -font $uifont
1544     grid $top.buts.ok $top.buts.can
1545     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1546     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1547     grid $top.buts - -pady 10 -sticky ew
1548     focus $top.t
1551 proc doviewmenu {m first cmd op argv} {
1552     set nmenu [$m index end]
1553     for {set i $first} {$i <= $nmenu} {incr i} {
1554         if {[$m entrycget $i -command] eq $cmd} {
1555             eval $m $op $i $argv
1556             break
1557         }
1558     }
1561 proc allviewmenus {n op args} {
1562     global viewhlmenu
1564     doviewmenu .bar.view 5 [list showview $n] $op $args
1565     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1568 proc newviewok {top n} {
1569     global nextviewnum newviewperm newviewname newishighlight
1570     global viewname viewfiles viewperm selectedview curview
1571     global viewargs newviewargs viewhlmenu
1573     if {[catch {
1574         set newargs [shellsplit $newviewargs($n)]
1575     } err]} {
1576         error_popup "Error in commit selection arguments: $err"
1577         wm raise $top
1578         focus $top
1579         return
1580     }
1581     set files {}
1582     foreach f [split [$top.t get 0.0 end] "\n"] {
1583         set ft [string trim $f]
1584         if {$ft ne {}} {
1585             lappend files $ft
1586         }
1587     }
1588     if {![info exists viewfiles($n)]} {
1589         # creating a new view
1590         incr nextviewnum
1591         set viewname($n) $newviewname($n)
1592         set viewperm($n) $newviewperm($n)
1593         set viewfiles($n) $files
1594         set viewargs($n) $newargs
1595         addviewmenu $n
1596         if {!$newishighlight} {
1597             after idle showview $n
1598         } else {
1599             after idle addvhighlight $n
1600         }
1601     } else {
1602         # editing an existing view
1603         set viewperm($n) $newviewperm($n)
1604         if {$newviewname($n) ne $viewname($n)} {
1605             set viewname($n) $newviewname($n)
1606             doviewmenu .bar.view 5 [list showview $n] \
1607                 entryconf [list -label $viewname($n)]
1608             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1609                 entryconf [list -label $viewname($n) -value $viewname($n)]
1610         }
1611         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1612             set viewfiles($n) $files
1613             set viewargs($n) $newargs
1614             if {$curview == $n} {
1615                 after idle updatecommits
1616             }
1617         }
1618     }
1619     catch {destroy $top}
1622 proc delview {} {
1623     global curview viewdata viewperm hlview selectedhlview
1625     if {$curview == 0} return
1626     if {[info exists hlview] && $hlview == $curview} {
1627         set selectedhlview None
1628         unset hlview
1629     }
1630     allviewmenus $curview delete
1631     set viewdata($curview) {}
1632     set viewperm($curview) 0
1633     showview 0
1636 proc addviewmenu {n} {
1637     global viewname viewhlmenu
1639     .bar.view add radiobutton -label $viewname($n) \
1640         -command [list showview $n] -variable selectedview -value $n
1641     $viewhlmenu add radiobutton -label $viewname($n) \
1642         -command [list addvhighlight $n] -variable selectedhlview
1645 proc flatten {var} {
1646     global $var
1648     set ret {}
1649     foreach i [array names $var] {
1650         lappend ret $i [set $var\($i\)]
1651     }
1652     return $ret
1655 proc unflatten {var l} {
1656     global $var
1658     catch {unset $var}
1659     foreach {i v} $l {
1660         set $var\($i\) $v
1661     }
1664 proc showview {n} {
1665     global curview viewdata viewfiles
1666     global displayorder parentlist childlist rowidlist rowoffsets
1667     global colormap rowtextx commitrow nextcolor canvxmax
1668     global numcommits rowrangelist commitlisted idrowranges
1669     global selectedline currentid canv canvy0
1670     global matchinglines treediffs
1671     global pending_select phase
1672     global commitidx rowlaidout rowoptim linesegends
1673     global commfd nextupdate
1674     global selectedview selectfirst
1675     global vparentlist vchildlist vdisporder vcmitlisted
1676     global hlview selectedhlview
1678     if {$n == $curview} return
1679     set selid {}
1680     if {[info exists selectedline]} {
1681         set selid $currentid
1682         set y [yc $selectedline]
1683         set ymax [lindex [$canv cget -scrollregion] 3]
1684         set span [$canv yview]
1685         set ytop [expr {[lindex $span 0] * $ymax}]
1686         set ybot [expr {[lindex $span 1] * $ymax}]
1687         if {$ytop < $y && $y < $ybot} {
1688             set yscreen [expr {$y - $ytop}]
1689         } else {
1690             set yscreen [expr {($ybot - $ytop) / 2}]
1691         }
1692     } elseif {[info exists pending_select]} {
1693         set selid $pending_select
1694         unset pending_select
1695     }
1696     unselectline
1697     normalline
1698     stopfindproc
1699     if {$curview >= 0} {
1700         set vparentlist($curview) $parentlist
1701         set vchildlist($curview) $childlist
1702         set vdisporder($curview) $displayorder
1703         set vcmitlisted($curview) $commitlisted
1704         if {$phase ne {}} {
1705             set viewdata($curview) \
1706                 [list $phase $rowidlist $rowoffsets $rowrangelist \
1707                      [flatten idrowranges] [flatten idinlist] \
1708                      $rowlaidout $rowoptim $numcommits $linesegends]
1709         } elseif {![info exists viewdata($curview)]
1710                   || [lindex $viewdata($curview) 0] ne {}} {
1711             set viewdata($curview) \
1712                 [list {} $rowidlist $rowoffsets $rowrangelist]
1713         }
1714     }
1715     catch {unset matchinglines}
1716     catch {unset treediffs}
1717     clear_display
1718     if {[info exists hlview] && $hlview == $n} {
1719         unset hlview
1720         set selectedhlview None
1721     }
1723     set curview $n
1724     set selectedview $n
1725     .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1726     .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1728     if {![info exists viewdata($n)]} {
1729         if {$selid ne {}} {
1730             set pending_select $selid
1731         }
1732         getcommits
1733         return
1734     }
1736     set v $viewdata($n)
1737     set phase [lindex $v 0]
1738     set displayorder $vdisporder($n)
1739     set parentlist $vparentlist($n)
1740     set childlist $vchildlist($n)
1741     set commitlisted $vcmitlisted($n)
1742     set rowidlist [lindex $v 1]
1743     set rowoffsets [lindex $v 2]
1744     set rowrangelist [lindex $v 3]
1745     if {$phase eq {}} {
1746         set numcommits [llength $displayorder]
1747         catch {unset idrowranges}
1748     } else {
1749         unflatten idrowranges [lindex $v 4]
1750         unflatten idinlist [lindex $v 5]
1751         set rowlaidout [lindex $v 6]
1752         set rowoptim [lindex $v 7]
1753         set numcommits [lindex $v 8]
1754         set linesegends [lindex $v 9]
1755     }
1757     catch {unset colormap}
1758     catch {unset rowtextx}
1759     set nextcolor 0
1760     set canvxmax [$canv cget -width]
1761     set curview $n
1762     set row 0
1763     setcanvscroll
1764     set yf 0
1765     set row {}
1766     set selectfirst 0
1767     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1768         set row $commitrow($n,$selid)
1769         # try to get the selected row in the same position on the screen
1770         set ymax [lindex [$canv cget -scrollregion] 3]
1771         set ytop [expr {[yc $row] - $yscreen}]
1772         if {$ytop < 0} {
1773             set ytop 0
1774         }
1775         set yf [expr {$ytop * 1.0 / $ymax}]
1776     }
1777     allcanvs yview moveto $yf
1778     drawvisible
1779     if {$row ne {}} {
1780         selectline $row 0
1781     } elseif {$selid ne {}} {
1782         set pending_select $selid
1783     } else {
1784         if {$numcommits > 0} {
1785             selectline 0 0
1786         } else {
1787             set selectfirst 1
1788         }
1789     }
1790     if {$phase ne {}} {
1791         if {$phase eq "getcommits"} {
1792             show_status "Reading commits..."
1793         }
1794         if {[info exists commfd($n)]} {
1795             layoutmore {}
1796         } else {
1797             finishcommits
1798         }
1799     } elseif {$numcommits == 0} {
1800         show_status "No commits selected"
1801     }
1804 # Stuff relating to the highlighting facility
1806 proc ishighlighted {row} {
1807     global vhighlights fhighlights nhighlights rhighlights
1809     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1810         return $nhighlights($row)
1811     }
1812     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1813         return $vhighlights($row)
1814     }
1815     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1816         return $fhighlights($row)
1817     }
1818     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1819         return $rhighlights($row)
1820     }
1821     return 0
1824 proc bolden {row font} {
1825     global canv linehtag selectedline boldrows
1827     lappend boldrows $row
1828     $canv itemconf $linehtag($row) -font $font
1829     if {[info exists selectedline] && $row == $selectedline} {
1830         $canv delete secsel
1831         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1832                    -outline {{}} -tags secsel \
1833                    -fill [$canv cget -selectbackground]]
1834         $canv lower $t
1835     }
1838 proc bolden_name {row font} {
1839     global canv2 linentag selectedline boldnamerows
1841     lappend boldnamerows $row
1842     $canv2 itemconf $linentag($row) -font $font
1843     if {[info exists selectedline] && $row == $selectedline} {
1844         $canv2 delete secsel
1845         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1846                    -outline {{}} -tags secsel \
1847                    -fill [$canv2 cget -selectbackground]]
1848         $canv2 lower $t
1849     }
1852 proc unbolden {} {
1853     global mainfont boldrows
1855     set stillbold {}
1856     foreach row $boldrows {
1857         if {![ishighlighted $row]} {
1858             bolden $row $mainfont
1859         } else {
1860             lappend stillbold $row
1861         }
1862     }
1863     set boldrows $stillbold
1866 proc addvhighlight {n} {
1867     global hlview curview viewdata vhl_done vhighlights commitidx
1869     if {[info exists hlview]} {
1870         delvhighlight
1871     }
1872     set hlview $n
1873     if {$n != $curview && ![info exists viewdata($n)]} {
1874         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1875         set vparentlist($n) {}
1876         set vchildlist($n) {}
1877         set vdisporder($n) {}
1878         set vcmitlisted($n) {}
1879         start_rev_list $n
1880     }
1881     set vhl_done $commitidx($hlview)
1882     if {$vhl_done > 0} {
1883         drawvisible
1884     }
1887 proc delvhighlight {} {
1888     global hlview vhighlights
1890     if {![info exists hlview]} return
1891     unset hlview
1892     catch {unset vhighlights}
1893     unbolden
1896 proc vhighlightmore {} {
1897     global hlview vhl_done commitidx vhighlights
1898     global displayorder vdisporder curview mainfont
1900     set font [concat $mainfont bold]
1901     set max $commitidx($hlview)
1902     if {$hlview == $curview} {
1903         set disp $displayorder
1904     } else {
1905         set disp $vdisporder($hlview)
1906     }
1907     set vr [visiblerows]
1908     set r0 [lindex $vr 0]
1909     set r1 [lindex $vr 1]
1910     for {set i $vhl_done} {$i < $max} {incr i} {
1911         set id [lindex $disp $i]
1912         if {[info exists commitrow($curview,$id)]} {
1913             set row $commitrow($curview,$id)
1914             if {$r0 <= $row && $row <= $r1} {
1915                 if {![highlighted $row]} {
1916                     bolden $row $font
1917                 }
1918                 set vhighlights($row) 1
1919             }
1920         }
1921     }
1922     set vhl_done $max
1925 proc askvhighlight {row id} {
1926     global hlview vhighlights commitrow iddrawn mainfont
1928     if {[info exists commitrow($hlview,$id)]} {
1929         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1930             bolden $row [concat $mainfont bold]
1931         }
1932         set vhighlights($row) 1
1933     } else {
1934         set vhighlights($row) 0
1935     }
1938 proc hfiles_change {name ix op} {
1939     global highlight_files filehighlight fhighlights fh_serial
1940     global mainfont highlight_paths
1942     if {[info exists filehighlight]} {
1943         # delete previous highlights
1944         catch {close $filehighlight}
1945         unset filehighlight
1946         catch {unset fhighlights}
1947         unbolden
1948         unhighlight_filelist
1949     }
1950     set highlight_paths {}
1951     after cancel do_file_hl $fh_serial
1952     incr fh_serial
1953     if {$highlight_files ne {}} {
1954         after 300 do_file_hl $fh_serial
1955     }
1958 proc makepatterns {l} {
1959     set ret {}
1960     foreach e $l {
1961         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1962         if {[string index $ee end] eq "/"} {
1963             lappend ret "$ee*"
1964         } else {
1965             lappend ret $ee
1966             lappend ret "$ee/*"
1967         }
1968     }
1969     return $ret
1972 proc do_file_hl {serial} {
1973     global highlight_files filehighlight highlight_paths gdttype fhl_list
1975     if {$gdttype eq "touching paths:"} {
1976         if {[catch {set paths [shellsplit $highlight_files]}]} return
1977         set highlight_paths [makepatterns $paths]
1978         highlight_filelist
1979         set gdtargs [concat -- $paths]
1980     } else {
1981         set gdtargs [list "-S$highlight_files"]
1982     }
1983     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1984     set filehighlight [open $cmd r+]
1985     fconfigure $filehighlight -blocking 0
1986     fileevent $filehighlight readable readfhighlight
1987     set fhl_list {}
1988     drawvisible
1989     flushhighlights
1992 proc flushhighlights {} {
1993     global filehighlight fhl_list
1995     if {[info exists filehighlight]} {
1996         lappend fhl_list {}
1997         puts $filehighlight ""
1998         flush $filehighlight
1999     }
2002 proc askfilehighlight {row id} {
2003     global filehighlight fhighlights fhl_list
2005     lappend fhl_list $id
2006     set fhighlights($row) -1
2007     puts $filehighlight $id
2010 proc readfhighlight {} {
2011     global filehighlight fhighlights commitrow curview mainfont iddrawn
2012     global fhl_list
2014     while {[gets $filehighlight line] >= 0} {
2015         set line [string trim $line]
2016         set i [lsearch -exact $fhl_list $line]
2017         if {$i < 0} continue
2018         for {set j 0} {$j < $i} {incr j} {
2019             set id [lindex $fhl_list $j]
2020             if {[info exists commitrow($curview,$id)]} {
2021                 set fhighlights($commitrow($curview,$id)) 0
2022             }
2023         }
2024         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2025         if {$line eq {}} continue
2026         if {![info exists commitrow($curview,$line)]} continue
2027         set row $commitrow($curview,$line)
2028         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2029             bolden $row [concat $mainfont bold]
2030         }
2031         set fhighlights($row) 1
2032     }
2033     if {[eof $filehighlight]} {
2034         # strange...
2035         puts "oops, git diff-tree died"
2036         catch {close $filehighlight}
2037         unset filehighlight
2038     }
2039     next_hlcont
2042 proc find_change {name ix op} {
2043     global nhighlights mainfont boldnamerows
2044     global findstring findpattern findtype
2046     # delete previous highlights, if any
2047     foreach row $boldnamerows {
2048         bolden_name $row $mainfont
2049     }
2050     set boldnamerows {}
2051     catch {unset nhighlights}
2052     unbolden
2053     if {$findtype ne "Regexp"} {
2054         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2055                    $findstring]
2056         set findpattern "*$e*"
2057     }
2058     drawvisible
2061 proc askfindhighlight {row id} {
2062     global nhighlights commitinfo iddrawn mainfont
2063     global findstring findtype findloc findpattern
2065     if {![info exists commitinfo($id)]} {
2066         getcommit $id
2067     }
2068     set info $commitinfo($id)
2069     set isbold 0
2070     set fldtypes {Headline Author Date Committer CDate Comments}
2071     foreach f $info ty $fldtypes {
2072         if {$findloc ne "All fields" && $findloc ne $ty} {
2073             continue
2074         }
2075         if {$findtype eq "Regexp"} {
2076             set doesmatch [regexp $findstring $f]
2077         } elseif {$findtype eq "IgnCase"} {
2078             set doesmatch [string match -nocase $findpattern $f]
2079         } else {
2080             set doesmatch [string match $findpattern $f]
2081         }
2082         if {$doesmatch} {
2083             if {$ty eq "Author"} {
2084                 set isbold 2
2085             } else {
2086                 set isbold 1
2087             }
2088         }
2089     }
2090     if {[info exists iddrawn($id)]} {
2091         if {$isbold && ![ishighlighted $row]} {
2092             bolden $row [concat $mainfont bold]
2093         }
2094         if {$isbold >= 2} {
2095             bolden_name $row [concat $mainfont bold]
2096         }
2097     }
2098     set nhighlights($row) $isbold
2101 proc vrel_change {name ix op} {
2102     global highlight_related
2104     rhighlight_none
2105     if {$highlight_related ne "None"} {
2106         after idle drawvisible
2107     }
2110 # prepare for testing whether commits are descendents or ancestors of a
2111 proc rhighlight_sel {a} {
2112     global descendent desc_todo ancestor anc_todo
2113     global highlight_related rhighlights
2115     catch {unset descendent}
2116     set desc_todo [list $a]
2117     catch {unset ancestor}
2118     set anc_todo [list $a]
2119     if {$highlight_related ne "None"} {
2120         rhighlight_none
2121         after idle drawvisible
2122     }
2125 proc rhighlight_none {} {
2126     global rhighlights
2128     catch {unset rhighlights}
2129     unbolden
2132 proc is_descendent {a} {
2133     global curview children commitrow descendent desc_todo
2135     set v $curview
2136     set la $commitrow($v,$a)
2137     set todo $desc_todo
2138     set leftover {}
2139     set done 0
2140     for {set i 0} {$i < [llength $todo]} {incr i} {
2141         set do [lindex $todo $i]
2142         if {$commitrow($v,$do) < $la} {
2143             lappend leftover $do
2144             continue
2145         }
2146         foreach nk $children($v,$do) {
2147             if {![info exists descendent($nk)]} {
2148                 set descendent($nk) 1
2149                 lappend todo $nk
2150                 if {$nk eq $a} {
2151                     set done 1
2152                 }
2153             }
2154         }
2155         if {$done} {
2156             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2157             return
2158         }
2159     }
2160     set descendent($a) 0
2161     set desc_todo $leftover
2164 proc is_ancestor {a} {
2165     global curview parentlist commitrow ancestor anc_todo
2167     set v $curview
2168     set la $commitrow($v,$a)
2169     set todo $anc_todo
2170     set leftover {}
2171     set done 0
2172     for {set i 0} {$i < [llength $todo]} {incr i} {
2173         set do [lindex $todo $i]
2174         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2175             lappend leftover $do
2176             continue
2177         }
2178         foreach np [lindex $parentlist $commitrow($v,$do)] {
2179             if {![info exists ancestor($np)]} {
2180                 set ancestor($np) 1
2181                 lappend todo $np
2182                 if {$np eq $a} {
2183                     set done 1
2184                 }
2185             }
2186         }
2187         if {$done} {
2188             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2189             return
2190         }
2191     }
2192     set ancestor($a) 0
2193     set anc_todo $leftover
2196 proc askrelhighlight {row id} {
2197     global descendent highlight_related iddrawn mainfont rhighlights
2198     global selectedline ancestor
2200     if {![info exists selectedline]} return
2201     set isbold 0
2202     if {$highlight_related eq "Descendent" ||
2203         $highlight_related eq "Not descendent"} {
2204         if {![info exists descendent($id)]} {
2205             is_descendent $id
2206         }
2207         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2208             set isbold 1
2209         }
2210     } elseif {$highlight_related eq "Ancestor" ||
2211               $highlight_related eq "Not ancestor"} {
2212         if {![info exists ancestor($id)]} {
2213             is_ancestor $id
2214         }
2215         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2216             set isbold 1
2217         }
2218     }
2219     if {[info exists iddrawn($id)]} {
2220         if {$isbold && ![ishighlighted $row]} {
2221             bolden $row [concat $mainfont bold]
2222         }
2223     }
2224     set rhighlights($row) $isbold
2227 proc next_hlcont {} {
2228     global fhl_row fhl_dirn displayorder numcommits
2229     global vhighlights fhighlights nhighlights rhighlights
2230     global hlview filehighlight findstring highlight_related
2232     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2233     set row $fhl_row
2234     while {1} {
2235         if {$row < 0 || $row >= $numcommits} {
2236             bell
2237             set fhl_dirn 0
2238             return
2239         }
2240         set id [lindex $displayorder $row]
2241         if {[info exists hlview]} {
2242             if {![info exists vhighlights($row)]} {
2243                 askvhighlight $row $id
2244             }
2245             if {$vhighlights($row) > 0} break
2246         }
2247         if {$findstring ne {}} {
2248             if {![info exists nhighlights($row)]} {
2249                 askfindhighlight $row $id
2250             }
2251             if {$nhighlights($row) > 0} break
2252         }
2253         if {$highlight_related ne "None"} {
2254             if {![info exists rhighlights($row)]} {
2255                 askrelhighlight $row $id
2256             }
2257             if {$rhighlights($row) > 0} break
2258         }
2259         if {[info exists filehighlight]} {
2260             if {![info exists fhighlights($row)]} {
2261                 # ask for a few more while we're at it...
2262                 set r $row
2263                 for {set n 0} {$n < 100} {incr n} {
2264                     if {![info exists fhighlights($r)]} {
2265                         askfilehighlight $r [lindex $displayorder $r]
2266                     }
2267                     incr r $fhl_dirn
2268                     if {$r < 0 || $r >= $numcommits} break
2269                 }
2270                 flushhighlights
2271             }
2272             if {$fhighlights($row) < 0} {
2273                 set fhl_row $row
2274                 return
2275             }
2276             if {$fhighlights($row) > 0} break
2277         }
2278         incr row $fhl_dirn
2279     }
2280     set fhl_dirn 0
2281     selectline $row 1
2284 proc next_highlight {dirn} {
2285     global selectedline fhl_row fhl_dirn
2286     global hlview filehighlight findstring highlight_related
2288     if {![info exists selectedline]} return
2289     if {!([info exists hlview] || $findstring ne {} ||
2290           $highlight_related ne "None" || [info exists filehighlight])} return
2291     set fhl_row [expr {$selectedline + $dirn}]
2292     set fhl_dirn $dirn
2293     next_hlcont
2296 proc cancel_next_highlight {} {
2297     global fhl_dirn
2299     set fhl_dirn 0
2302 # Graph layout functions
2304 proc shortids {ids} {
2305     set res {}
2306     foreach id $ids {
2307         if {[llength $id] > 1} {
2308             lappend res [shortids $id]
2309         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2310             lappend res [string range $id 0 7]
2311         } else {
2312             lappend res $id
2313         }
2314     }
2315     return $res
2318 proc incrange {l x o} {
2319     set n [llength $l]
2320     while {$x < $n} {
2321         set e [lindex $l $x]
2322         if {$e ne {}} {
2323             lset l $x [expr {$e + $o}]
2324         }
2325         incr x
2326     }
2327     return $l
2330 proc ntimes {n o} {
2331     set ret {}
2332     for {} {$n > 0} {incr n -1} {
2333         lappend ret $o
2334     }
2335     return $ret
2338 proc usedinrange {id l1 l2} {
2339     global children commitrow childlist curview
2341     if {[info exists commitrow($curview,$id)]} {
2342         set r $commitrow($curview,$id)
2343         if {$l1 <= $r && $r <= $l2} {
2344             return [expr {$r - $l1 + 1}]
2345         }
2346         set kids [lindex $childlist $r]
2347     } else {
2348         set kids $children($curview,$id)
2349     }
2350     foreach c $kids {
2351         set r $commitrow($curview,$c)
2352         if {$l1 <= $r && $r <= $l2} {
2353             return [expr {$r - $l1 + 1}]
2354         }
2355     }
2356     return 0
2359 proc sanity {row {full 0}} {
2360     global rowidlist rowoffsets
2362     set col -1
2363     set ids [lindex $rowidlist $row]
2364     foreach id $ids {
2365         incr col
2366         if {$id eq {}} continue
2367         if {$col < [llength $ids] - 1 &&
2368             [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2369             puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2370         }
2371         set o [lindex $rowoffsets $row $col]
2372         set y $row
2373         set x $col
2374         while {$o ne {}} {
2375             incr y -1
2376             incr x $o
2377             if {[lindex $rowidlist $y $x] != $id} {
2378                 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2379                 puts "  id=[shortids $id] check started at row $row"
2380                 for {set i $row} {$i >= $y} {incr i -1} {
2381                     puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2382                 }
2383                 break
2384             }
2385             if {!$full} break
2386             set o [lindex $rowoffsets $y $x]
2387         }
2388     }
2391 proc makeuparrow {oid x y z} {
2392     global rowidlist rowoffsets uparrowlen idrowranges
2394     for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2395         incr y -1
2396         incr x $z
2397         set off0 [lindex $rowoffsets $y]
2398         for {set x0 $x} {1} {incr x0} {
2399             if {$x0 >= [llength $off0]} {
2400                 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2401                 break
2402             }
2403             set z [lindex $off0 $x0]
2404             if {$z ne {}} {
2405                 incr x0 $z
2406                 break
2407             }
2408         }
2409         set z [expr {$x0 - $x}]
2410         lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2411         lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2412     }
2413     set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2414     lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2415     lappend idrowranges($oid) $y
2418 proc initlayout {} {
2419     global rowidlist rowoffsets displayorder commitlisted
2420     global rowlaidout rowoptim
2421     global idinlist rowchk rowrangelist idrowranges
2422     global numcommits canvxmax canv
2423     global nextcolor
2424     global parentlist childlist children
2425     global colormap rowtextx
2426     global linesegends selectfirst
2428     set numcommits 0
2429     set displayorder {}
2430     set commitlisted {}
2431     set parentlist {}
2432     set childlist {}
2433     set rowrangelist {}
2434     set nextcolor 0
2435     set rowidlist {{}}
2436     set rowoffsets {{}}
2437     catch {unset idinlist}
2438     catch {unset rowchk}
2439     set rowlaidout 0
2440     set rowoptim 0
2441     set canvxmax [$canv cget -width]
2442     catch {unset colormap}
2443     catch {unset rowtextx}
2444     catch {unset idrowranges}
2445     set linesegends {}
2446     set selectfirst 1
2449 proc setcanvscroll {} {
2450     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2452     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2453     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2454     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2455     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2458 proc visiblerows {} {
2459     global canv numcommits linespc
2461     set ymax [lindex [$canv cget -scrollregion] 3]
2462     if {$ymax eq {} || $ymax == 0} return
2463     set f [$canv yview]
2464     set y0 [expr {int([lindex $f 0] * $ymax)}]
2465     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2466     if {$r0 < 0} {
2467         set r0 0
2468     }
2469     set y1 [expr {int([lindex $f 1] * $ymax)}]
2470     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2471     if {$r1 >= $numcommits} {
2472         set r1 [expr {$numcommits - 1}]
2473     }
2474     return [list $r0 $r1]
2477 proc layoutmore {tmax} {
2478     global rowlaidout rowoptim commitidx numcommits optim_delay
2479     global uparrowlen curview
2481     while {1} {
2482         if {$rowoptim - $optim_delay > $numcommits} {
2483             showstuff [expr {$rowoptim - $optim_delay}]
2484         } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2485             set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2486             if {$nr > 100} {
2487                 set nr 100
2488             }
2489             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2490             incr rowoptim $nr
2491         } elseif {$commitidx($curview) > $rowlaidout} {
2492             set nr [expr {$commitidx($curview) - $rowlaidout}]
2493             # may need to increase this threshold if uparrowlen or
2494             # mingaplen are increased...
2495             if {$nr > 150} {
2496                 set nr 150
2497             }
2498             set row $rowlaidout
2499             set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2500             if {$rowlaidout == $row} {
2501                 return 0
2502             }
2503         } else {
2504             return 0
2505         }
2506         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2507             return 1
2508         }
2509     }
2512 proc showstuff {canshow} {
2513     global numcommits commitrow pending_select selectedline
2514     global linesegends idrowranges idrangedrawn curview
2515     global displayorder selectfirst
2517     if {$numcommits == 0} {
2518         global phase
2519         set phase "incrdraw"
2520         allcanvs delete all
2521     }
2522     set row $numcommits
2523     set numcommits $canshow
2524     setcanvscroll
2525     set rows [visiblerows]
2526     set r0 [lindex $rows 0]
2527     set r1 [lindex $rows 1]
2528     set selrow -1
2529     for {set r $row} {$r < $canshow} {incr r} {
2530         foreach id [lindex $linesegends [expr {$r+1}]] {
2531             set i -1
2532             foreach {s e} [rowranges $id] {
2533                 incr i
2534                 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2535                     && ![info exists idrangedrawn($id,$i)]} {
2536                     drawlineseg $id $i
2537                     set idrangedrawn($id,$i) 1
2538                 }
2539             }
2540         }
2541     }
2542     if {$canshow > $r1} {
2543         set canshow $r1
2544     }
2545     while {$row < $canshow} {
2546         drawcmitrow $row
2547         incr row
2548     }
2549     if {[info exists pending_select] &&
2550         [info exists commitrow($curview,$pending_select)] &&
2551         $commitrow($curview,$pending_select) < $numcommits} {
2552         selectline $commitrow($curview,$pending_select) 1
2553     }
2554     if {$selectfirst} {
2555         if {[info exists selectedline] || [info exists pending_select]} {
2556             set selectfirst 0
2557         } else {
2558             selectline 0 1
2559             set selectfirst 0
2560         }
2561     }
2564 proc layoutrows {row endrow last} {
2565     global rowidlist rowoffsets displayorder
2566     global uparrowlen downarrowlen maxwidth mingaplen
2567     global childlist parentlist
2568     global idrowranges linesegends
2569     global commitidx curview
2570     global idinlist rowchk rowrangelist
2572     set idlist [lindex $rowidlist $row]
2573     set offs [lindex $rowoffsets $row]
2574     while {$row < $endrow} {
2575         set id [lindex $displayorder $row]
2576         set oldolds {}
2577         set newolds {}
2578         foreach p [lindex $parentlist $row] {
2579             if {![info exists idinlist($p)]} {
2580                 lappend newolds $p
2581             } elseif {!$idinlist($p)} {
2582                 lappend oldolds $p
2583             }
2584         }
2585         set lse {}
2586         set nev [expr {[llength $idlist] + [llength $newolds]
2587                        + [llength $oldolds] - $maxwidth + 1}]
2588         if {$nev > 0} {
2589             if {!$last &&
2590                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2591             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2592                 set i [lindex $idlist $x]
2593                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2594                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2595                                [expr {$row + $uparrowlen + $mingaplen}]]
2596                     if {$r == 0} {
2597                         set idlist [lreplace $idlist $x $x]
2598                         set offs [lreplace $offs $x $x]
2599                         set offs [incrange $offs $x 1]
2600                         set idinlist($i) 0
2601                         set rm1 [expr {$row - 1}]
2602                         lappend lse $i
2603                         lappend idrowranges($i) $rm1
2604                         if {[incr nev -1] <= 0} break
2605                         continue
2606                     }
2607                     set rowchk($id) [expr {$row + $r}]
2608                 }
2609             }
2610             lset rowidlist $row $idlist
2611             lset rowoffsets $row $offs
2612         }
2613         lappend linesegends $lse
2614         set col [lsearch -exact $idlist $id]
2615         if {$col < 0} {
2616             set col [llength $idlist]
2617             lappend idlist $id
2618             lset rowidlist $row $idlist
2619             set z {}
2620             if {[lindex $childlist $row] ne {}} {
2621                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2622                 unset idinlist($id)
2623             }
2624             lappend offs $z
2625             lset rowoffsets $row $offs
2626             if {$z ne {}} {
2627                 makeuparrow $id $col $row $z
2628             }
2629         } else {
2630             unset idinlist($id)
2631         }
2632         set ranges {}
2633         if {[info exists idrowranges($id)]} {
2634             set ranges $idrowranges($id)
2635             lappend ranges $row
2636             unset idrowranges($id)
2637         }
2638         lappend rowrangelist $ranges
2639         incr row
2640         set offs [ntimes [llength $idlist] 0]
2641         set l [llength $newolds]
2642         set idlist [eval lreplace \$idlist $col $col $newolds]
2643         set o 0
2644         if {$l != 1} {
2645             set offs [lrange $offs 0 [expr {$col - 1}]]
2646             foreach x $newolds {
2647                 lappend offs {}
2648                 incr o -1
2649             }
2650             incr o
2651             set tmp [expr {[llength $idlist] - [llength $offs]}]
2652             if {$tmp > 0} {
2653                 set offs [concat $offs [ntimes $tmp $o]]
2654             }
2655         } else {
2656             lset offs $col {}
2657         }
2658         foreach i $newolds {
2659             set idinlist($i) 1
2660             set idrowranges($i) $row
2661         }
2662         incr col $l
2663         foreach oid $oldolds {
2664             set idinlist($oid) 1
2665             set idlist [linsert $idlist $col $oid]
2666             set offs [linsert $offs $col $o]
2667             makeuparrow $oid $col $row $o
2668             incr col
2669         }
2670         lappend rowidlist $idlist
2671         lappend rowoffsets $offs
2672     }
2673     return $row
2676 proc addextraid {id row} {
2677     global displayorder commitrow commitinfo
2678     global commitidx commitlisted
2679     global parentlist childlist children curview
2681     incr commitidx($curview)
2682     lappend displayorder $id
2683     lappend commitlisted 0
2684     lappend parentlist {}
2685     set commitrow($curview,$id) $row
2686     readcommit $id
2687     if {![info exists commitinfo($id)]} {
2688         set commitinfo($id) {"No commit information available"}
2689     }
2690     if {![info exists children($curview,$id)]} {
2691         set children($curview,$id) {}
2692     }
2693     lappend childlist $children($curview,$id)
2696 proc layouttail {} {
2697     global rowidlist rowoffsets idinlist commitidx curview
2698     global idrowranges rowrangelist
2700     set row $commitidx($curview)
2701     set idlist [lindex $rowidlist $row]
2702     while {$idlist ne {}} {
2703         set col [expr {[llength $idlist] - 1}]
2704         set id [lindex $idlist $col]
2705         addextraid $id $row
2706         unset idinlist($id)
2707         lappend idrowranges($id) $row
2708         lappend rowrangelist $idrowranges($id)
2709         unset idrowranges($id)
2710         incr row
2711         set offs [ntimes $col 0]
2712         set idlist [lreplace $idlist $col $col]
2713         lappend rowidlist $idlist
2714         lappend rowoffsets $offs
2715     }
2717     foreach id [array names idinlist] {
2718         addextraid $id $row
2719         lset rowidlist $row [list $id]
2720         lset rowoffsets $row 0
2721         makeuparrow $id 0 $row 0
2722         lappend idrowranges($id) $row
2723         lappend rowrangelist $idrowranges($id)
2724         unset idrowranges($id)
2725         incr row
2726         lappend rowidlist {}
2727         lappend rowoffsets {}
2728     }
2731 proc insert_pad {row col npad} {
2732     global rowidlist rowoffsets
2734     set pad [ntimes $npad {}]
2735     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2736     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2737     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2740 proc optimize_rows {row col endrow} {
2741     global rowidlist rowoffsets idrowranges displayorder
2743     for {} {$row < $endrow} {incr row} {
2744         set idlist [lindex $rowidlist $row]
2745         set offs [lindex $rowoffsets $row]
2746         set haspad 0
2747         for {} {$col < [llength $offs]} {incr col} {
2748             if {[lindex $idlist $col] eq {}} {
2749                 set haspad 1
2750                 continue
2751             }
2752             set z [lindex $offs $col]
2753             if {$z eq {}} continue
2754             set isarrow 0
2755             set x0 [expr {$col + $z}]
2756             set y0 [expr {$row - 1}]
2757             set z0 [lindex $rowoffsets $y0 $x0]
2758             if {$z0 eq {}} {
2759                 set id [lindex $idlist $col]
2760                 set ranges [rowranges $id]
2761                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2762                     set isarrow 1
2763                 }
2764             }
2765             # Looking at lines from this row to the previous row,
2766             # make them go straight up if they end in an arrow on
2767             # the previous row; otherwise make them go straight up
2768             # or at 45 degrees.
2769             if {$z < -1 || ($z < 0 && $isarrow)} {
2770                 # Line currently goes left too much;
2771                 # insert pads in the previous row, then optimize it
2772                 set npad [expr {-1 - $z + $isarrow}]
2773                 set offs [incrange $offs $col $npad]
2774                 insert_pad $y0 $x0 $npad
2775                 if {$y0 > 0} {
2776                     optimize_rows $y0 $x0 $row
2777                 }
2778                 set z [lindex $offs $col]
2779                 set x0 [expr {$col + $z}]
2780                 set z0 [lindex $rowoffsets $y0 $x0]
2781             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2782                 # Line currently goes right too much;
2783                 # insert pads in this line and adjust the next's rowoffsets
2784                 set npad [expr {$z - 1 + $isarrow}]
2785                 set y1 [expr {$row + 1}]
2786                 set offs2 [lindex $rowoffsets $y1]
2787                 set x1 -1
2788                 foreach z $offs2 {
2789                     incr x1
2790                     if {$z eq {} || $x1 + $z < $col} continue
2791                     if {$x1 + $z > $col} {
2792                         incr npad
2793                     }
2794                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2795                     break
2796                 }
2797                 set pad [ntimes $npad {}]
2798                 set idlist [eval linsert \$idlist $col $pad]
2799                 set tmp [eval linsert \$offs $col $pad]
2800                 incr col $npad
2801                 set offs [incrange $tmp $col [expr {-$npad}]]
2802                 set z [lindex $offs $col]
2803                 set haspad 1
2804             }
2805             if {$z0 eq {} && !$isarrow} {
2806                 # this line links to its first child on row $row-2
2807                 set rm2 [expr {$row - 2}]
2808                 set id [lindex $displayorder $rm2]
2809                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2810                 if {$xc >= 0} {
2811                     set z0 [expr {$xc - $x0}]
2812                 }
2813             }
2814             # avoid lines jigging left then immediately right
2815             if {$z0 ne {} && $z < 0 && $z0 > 0} {
2816                 insert_pad $y0 $x0 1
2817                 set offs [incrange $offs $col 1]
2818                 optimize_rows $y0 [expr {$x0 + 1}] $row
2819             }
2820         }
2821         if {!$haspad} {
2822             set o {}
2823             # Find the first column that doesn't have a line going right
2824             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2825                 set o [lindex $offs $col]
2826                 if {$o eq {}} {
2827                     # check if this is the link to the first child
2828                     set id [lindex $idlist $col]
2829                     set ranges [rowranges $id]
2830                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
2831                         # it is, work out offset to child
2832                         set y0 [expr {$row - 1}]
2833                         set id [lindex $displayorder $y0]
2834                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2835                         if {$x0 >= 0} {
2836                             set o [expr {$x0 - $col}]
2837                         }
2838                     }
2839                 }
2840                 if {$o eq {} || $o <= 0} break
2841             }
2842             # Insert a pad at that column as long as it has a line and
2843             # isn't the last column, and adjust the next row' offsets
2844             if {$o ne {} && [incr col] < [llength $idlist]} {
2845                 set y1 [expr {$row + 1}]
2846                 set offs2 [lindex $rowoffsets $y1]
2847                 set x1 -1
2848                 foreach z $offs2 {
2849                     incr x1
2850                     if {$z eq {} || $x1 + $z < $col} continue
2851                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
2852                     break
2853                 }
2854                 set idlist [linsert $idlist $col {}]
2855                 set tmp [linsert $offs $col {}]
2856                 incr col
2857                 set offs [incrange $tmp $col -1]
2858             }
2859         }
2860         lset rowidlist $row $idlist
2861         lset rowoffsets $row $offs
2862         set col 0
2863     }
2866 proc xc {row col} {
2867     global canvx0 linespc
2868     return [expr {$canvx0 + $col * $linespc}]
2871 proc yc {row} {
2872     global canvy0 linespc
2873     return [expr {$canvy0 + $row * $linespc}]
2876 proc linewidth {id} {
2877     global thickerline lthickness
2879     set wid $lthickness
2880     if {[info exists thickerline] && $id eq $thickerline} {
2881         set wid [expr {2 * $lthickness}]
2882     }
2883     return $wid
2886 proc rowranges {id} {
2887     global phase idrowranges commitrow rowlaidout rowrangelist curview
2889     set ranges {}
2890     if {$phase eq {} ||
2891         ([info exists commitrow($curview,$id)]
2892          && $commitrow($curview,$id) < $rowlaidout)} {
2893         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2894     } elseif {[info exists idrowranges($id)]} {
2895         set ranges $idrowranges($id)
2896     }
2897     return $ranges
2900 proc drawlineseg {id i} {
2901     global rowoffsets rowidlist
2902     global displayorder
2903     global canv colormap linespc
2904     global numcommits commitrow curview
2906     set ranges [rowranges $id]
2907     set downarrow 1
2908     if {[info exists commitrow($curview,$id)]
2909         && $commitrow($curview,$id) < $numcommits} {
2910         set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2911     } else {
2912         set downarrow 1
2913     }
2914     set startrow [lindex $ranges [expr {2 * $i}]]
2915     set row [lindex $ranges [expr {2 * $i + 1}]]
2916     if {$startrow == $row} return
2917     assigncolor $id
2918     set coords {}
2919     set col [lsearch -exact [lindex $rowidlist $row] $id]
2920     if {$col < 0} {
2921         puts "oops: drawline: id $id not on row $row"
2922         return
2923     }
2924     set lasto {}
2925     set ns 0
2926     while {1} {
2927         set o [lindex $rowoffsets $row $col]
2928         if {$o eq {}} break
2929         if {$o ne $lasto} {
2930             # changing direction
2931             set x [xc $row $col]
2932             set y [yc $row]
2933             lappend coords $x $y
2934             set lasto $o
2935         }
2936         incr col $o
2937         incr row -1
2938     }
2939     set x [xc $row $col]
2940     set y [yc $row]
2941     lappend coords $x $y
2942     if {$i == 0} {
2943         # draw the link to the first child as part of this line
2944         incr row -1
2945         set child [lindex $displayorder $row]
2946         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2947         if {$ccol >= 0} {
2948             set x [xc $row $ccol]
2949             set y [yc $row]
2950             if {$ccol < $col - 1} {
2951                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2952             } elseif {$ccol > $col + 1} {
2953                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2954             }
2955             lappend coords $x $y
2956         }
2957     }
2958     if {[llength $coords] < 4} return
2959     if {$downarrow} {
2960         # This line has an arrow at the lower end: check if the arrow is
2961         # on a diagonal segment, and if so, work around the Tk 8.4
2962         # refusal to draw arrows on diagonal lines.
2963         set x0 [lindex $coords 0]
2964         set x1 [lindex $coords 2]
2965         if {$x0 != $x1} {
2966             set y0 [lindex $coords 1]
2967             set y1 [lindex $coords 3]
2968             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2969                 # we have a nearby vertical segment, just trim off the diag bit
2970                 set coords [lrange $coords 2 end]
2971             } else {
2972                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2973                 set xi [expr {$x0 - $slope * $linespc / 2}]
2974                 set yi [expr {$y0 - $linespc / 2}]
2975                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2976             }
2977         }
2978     }
2979     set arrow [expr {2 * ($i > 0) + $downarrow}]
2980     set arrow [lindex {none first last both} $arrow]
2981     set t [$canv create line $coords -width [linewidth $id] \
2982                -fill $colormap($id) -tags lines.$id -arrow $arrow]
2983     $canv lower $t
2984     bindline $t $id
2987 proc drawparentlinks {id row col olds} {
2988     global rowidlist canv colormap
2990     set row2 [expr {$row + 1}]
2991     set x [xc $row $col]
2992     set y [yc $row]
2993     set y2 [yc $row2]
2994     set ids [lindex $rowidlist $row2]
2995     # rmx = right-most X coord used
2996     set rmx 0
2997     foreach p $olds {
2998         set i [lsearch -exact $ids $p]
2999         if {$i < 0} {
3000             puts "oops, parent $p of $id not in list"
3001             continue
3002         }
3003         set x2 [xc $row2 $i]
3004         if {$x2 > $rmx} {
3005             set rmx $x2
3006         }
3007         set ranges [rowranges $p]
3008         if {$ranges ne {} && $row2 == [lindex $ranges 0]
3009             && $row2 < [lindex $ranges 1]} {
3010             # drawlineseg will do this one for us
3011             continue
3012         }
3013         assigncolor $p
3014         # should handle duplicated parents here...
3015         set coords [list $x $y]
3016         if {$i < $col - 1} {
3017             lappend coords [xc $row [expr {$i + 1}]] $y
3018         } elseif {$i > $col + 1} {
3019             lappend coords [xc $row [expr {$i - 1}]] $y
3020         }
3021         lappend coords $x2 $y2
3022         set t [$canv create line $coords -width [linewidth $p] \
3023                    -fill $colormap($p) -tags lines.$p]
3024         $canv lower $t
3025         bindline $t $p
3026     }
3027     return $rmx
3030 proc drawlines {id} {
3031     global colormap canv
3032     global idrangedrawn
3033     global children iddrawn commitrow rowidlist curview
3035     $canv delete lines.$id
3036     set nr [expr {[llength [rowranges $id]] / 2}]
3037     for {set i 0} {$i < $nr} {incr i} {
3038         if {[info exists idrangedrawn($id,$i)]} {
3039             drawlineseg $id $i
3040         }
3041     }
3042     foreach child $children($curview,$id) {
3043         if {[info exists iddrawn($child)]} {
3044             set row $commitrow($curview,$child)
3045             set col [lsearch -exact [lindex $rowidlist $row] $child]
3046             if {$col >= 0} {
3047                 drawparentlinks $child $row $col [list $id]
3048             }
3049         }
3050     }
3053 proc drawcmittext {id row col rmx} {
3054     global linespc canv canv2 canv3 canvy0 fgcolor
3055     global commitlisted commitinfo rowidlist
3056     global rowtextx idpos idtags idheads idotherrefs
3057     global linehtag linentag linedtag
3058     global mainfont canvxmax boldrows boldnamerows fgcolor
3060     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3061     set x [xc $row $col]
3062     set y [yc $row]
3063     set orad [expr {$linespc / 3}]
3064     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3065                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3066                -fill $ofill -outline $fgcolor -width 1 -tags circle]
3067     $canv raise $t
3068     $canv bind $t <1> {selcanvline {} %x %y}
3069     set xt [xc $row [llength [lindex $rowidlist $row]]]
3070     if {$xt < $rmx} {
3071         set xt $rmx
3072     }
3073     set rowtextx($row) $xt
3074     set idpos($id) [list $x $xt $y]
3075     if {[info exists idtags($id)] || [info exists idheads($id)]
3076         || [info exists idotherrefs($id)]} {
3077         set xt [drawtags $id $x $xt $y]
3078     }
3079     set headline [lindex $commitinfo($id) 0]
3080     set name [lindex $commitinfo($id) 1]
3081     set date [lindex $commitinfo($id) 2]
3082     set date [formatdate $date]
3083     set font $mainfont
3084     set nfont $mainfont
3085     set isbold [ishighlighted $row]
3086     if {$isbold > 0} {
3087         lappend boldrows $row
3088         lappend font bold
3089         if {$isbold > 1} {
3090             lappend boldnamerows $row
3091             lappend nfont bold
3092         }
3093     }
3094     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3095                             -text $headline -font $font -tags text]
3096     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3097     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3098                             -text $name -font $nfont -tags text]
3099     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3100                             -text $date -font $mainfont -tags text]
3101     set xr [expr {$xt + [font measure $mainfont $headline]}]
3102     if {$xr > $canvxmax} {
3103         set canvxmax $xr
3104         setcanvscroll
3105     }
3108 proc drawcmitrow {row} {
3109     global displayorder rowidlist
3110     global idrangedrawn iddrawn
3111     global commitinfo parentlist numcommits
3112     global filehighlight fhighlights findstring nhighlights
3113     global hlview vhighlights
3114     global highlight_related rhighlights
3116     if {$row >= $numcommits} return
3117     foreach id [lindex $rowidlist $row] {
3118         if {$id eq {}} continue
3119         set i -1
3120         foreach {s e} [rowranges $id] {
3121             incr i
3122             if {$row < $s} continue
3123             if {$e eq {}} break
3124             if {$row <= $e} {
3125                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3126                     drawlineseg $id $i
3127                     set idrangedrawn($id,$i) 1
3128                 }
3129                 break
3130             }
3131         }
3132     }
3134     set id [lindex $displayorder $row]
3135     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3136         askvhighlight $row $id
3137     }
3138     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3139         askfilehighlight $row $id
3140     }
3141     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3142         askfindhighlight $row $id
3143     }
3144     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3145         askrelhighlight $row $id
3146     }
3147     if {[info exists iddrawn($id)]} return
3148     set col [lsearch -exact [lindex $rowidlist $row] $id]
3149     if {$col < 0} {
3150         puts "oops, row $row id $id not in list"
3151         return
3152     }
3153     if {![info exists commitinfo($id)]} {
3154         getcommit $id
3155     }
3156     assigncolor $id
3157     set olds [lindex $parentlist $row]
3158     if {$olds ne {}} {
3159         set rmx [drawparentlinks $id $row $col $olds]
3160     } else {
3161         set rmx 0
3162     }
3163     drawcmittext $id $row $col $rmx
3164     set iddrawn($id) 1
3167 proc drawfrac {f0 f1} {
3168     global numcommits canv
3169     global linespc
3171     set ymax [lindex [$canv cget -scrollregion] 3]
3172     if {$ymax eq {} || $ymax == 0} return
3173     set y0 [expr {int($f0 * $ymax)}]
3174     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3175     if {$row < 0} {
3176         set row 0
3177     }
3178     set y1 [expr {int($f1 * $ymax)}]
3179     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3180     if {$endrow >= $numcommits} {
3181         set endrow [expr {$numcommits - 1}]
3182     }
3183     for {} {$row <= $endrow} {incr row} {
3184         drawcmitrow $row
3185     }
3188 proc drawvisible {} {
3189     global canv
3190     eval drawfrac [$canv yview]
3193 proc clear_display {} {
3194     global iddrawn idrangedrawn
3195     global vhighlights fhighlights nhighlights rhighlights
3197     allcanvs delete all
3198     catch {unset iddrawn}
3199     catch {unset idrangedrawn}
3200     catch {unset vhighlights}
3201     catch {unset fhighlights}
3202     catch {unset nhighlights}
3203     catch {unset rhighlights}
3206 proc findcrossings {id} {
3207     global rowidlist parentlist numcommits rowoffsets displayorder
3209     set cross {}
3210     set ccross {}
3211     foreach {s e} [rowranges $id] {
3212         if {$e >= $numcommits} {
3213             set e [expr {$numcommits - 1}]
3214         }
3215         if {$e <= $s} continue
3216         set x [lsearch -exact [lindex $rowidlist $e] $id]
3217         if {$x < 0} {
3218             puts "findcrossings: oops, no [shortids $id] in row $e"
3219             continue
3220         }
3221         for {set row $e} {[incr row -1] >= $s} {} {
3222             set olds [lindex $parentlist $row]
3223             set kid [lindex $displayorder $row]
3224             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3225             if {$kidx < 0} continue
3226             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3227             foreach p $olds {
3228                 set px [lsearch -exact $nextrow $p]
3229                 if {$px < 0} continue
3230                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3231                     if {[lsearch -exact $ccross $p] >= 0} continue
3232                     if {$x == $px + ($kidx < $px? -1: 1)} {
3233                         lappend ccross $p
3234                     } elseif {[lsearch -exact $cross $p] < 0} {
3235                         lappend cross $p
3236                     }
3237                 }
3238             }
3239             set inc [lindex $rowoffsets $row $x]
3240             if {$inc eq {}} break
3241             incr x $inc
3242         }
3243     }
3244     return [concat $ccross {{}} $cross]
3247 proc assigncolor {id} {
3248     global colormap colors nextcolor
3249     global commitrow parentlist children children curview
3251     if {[info exists colormap($id)]} return
3252     set ncolors [llength $colors]
3253     if {[info exists children($curview,$id)]} {
3254         set kids $children($curview,$id)
3255     } else {
3256         set kids {}
3257     }
3258     if {[llength $kids] == 1} {
3259         set child [lindex $kids 0]
3260         if {[info exists colormap($child)]
3261             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3262             set colormap($id) $colormap($child)
3263             return
3264         }
3265     }
3266     set badcolors {}
3267     set origbad {}
3268     foreach x [findcrossings $id] {
3269         if {$x eq {}} {
3270             # delimiter between corner crossings and other crossings
3271             if {[llength $badcolors] >= $ncolors - 1} break
3272             set origbad $badcolors
3273         }
3274         if {[info exists colormap($x)]
3275             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3276             lappend badcolors $colormap($x)
3277         }
3278     }
3279     if {[llength $badcolors] >= $ncolors} {
3280         set badcolors $origbad
3281     }
3282     set origbad $badcolors
3283     if {[llength $badcolors] < $ncolors - 1} {
3284         foreach child $kids {
3285             if {[info exists colormap($child)]
3286                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3287                 lappend badcolors $colormap($child)
3288             }
3289             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3290                 if {[info exists colormap($p)]
3291                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3292                     lappend badcolors $colormap($p)
3293                 }
3294             }
3295         }
3296         if {[llength $badcolors] >= $ncolors} {
3297             set badcolors $origbad
3298         }
3299     }
3300     for {set i 0} {$i <= $ncolors} {incr i} {
3301         set c [lindex $colors $nextcolor]
3302         if {[incr nextcolor] >= $ncolors} {
3303             set nextcolor 0
3304         }
3305         if {[lsearch -exact $badcolors $c]} break
3306     }
3307     set colormap($id) $c
3310 proc bindline {t id} {
3311     global canv
3313     $canv bind $t <Enter> "lineenter %x %y $id"
3314     $canv bind $t <Motion> "linemotion %x %y $id"
3315     $canv bind $t <Leave> "lineleave $id"
3316     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3319 proc drawtags {id x xt y1} {
3320     global idtags idheads idotherrefs mainhead
3321     global linespc lthickness
3322     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3324     set marks {}
3325     set ntags 0
3326     set nheads 0
3327     if {[info exists idtags($id)]} {
3328         set marks $idtags($id)
3329         set ntags [llength $marks]
3330     }
3331     if {[info exists idheads($id)]} {
3332         set marks [concat $marks $idheads($id)]
3333         set nheads [llength $idheads($id)]
3334     }
3335     if {[info exists idotherrefs($id)]} {
3336         set marks [concat $marks $idotherrefs($id)]
3337     }
3338     if {$marks eq {}} {
3339         return $xt
3340     }
3342     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3343     set yt [expr {$y1 - 0.5 * $linespc}]
3344     set yb [expr {$yt + $linespc - 1}]
3345     set xvals {}
3346     set wvals {}
3347     set i -1
3348     foreach tag $marks {
3349         incr i
3350         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3351             set wid [font measure [concat $mainfont bold] $tag]
3352         } else {
3353             set wid [font measure $mainfont $tag]
3354         }
3355         lappend xvals $xt
3356         lappend wvals $wid
3357         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3358     }
3359     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3360                -width $lthickness -fill black -tags tag.$id]
3361     $canv lower $t
3362     foreach tag $marks x $xvals wid $wvals {
3363         set xl [expr {$x + $delta}]
3364         set xr [expr {$x + $delta + $wid + $lthickness}]
3365         set font $mainfont
3366         if {[incr ntags -1] >= 0} {
3367             # draw a tag
3368             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3369                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3370                        -width 1 -outline black -fill yellow -tags tag.$id]
3371             $canv bind $t <1> [list showtag $tag 1]
3372             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3373         } else {
3374             # draw a head or other ref
3375             if {[incr nheads -1] >= 0} {
3376                 set col green
3377                 if {$tag eq $mainhead} {
3378                     lappend font bold
3379                 }
3380             } else {
3381                 set col "#ddddff"
3382             }
3383             set xl [expr {$xl - $delta/2}]
3384             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3385                 -width 1 -outline black -fill $col -tags tag.$id
3386             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3387                 set rwid [font measure $mainfont $remoteprefix]
3388                 set xi [expr {$x + 1}]
3389                 set yti [expr {$yt + 1}]
3390                 set xri [expr {$x + $rwid}]
3391                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3392                         -width 0 -fill "#ffddaa" -tags tag.$id
3393             }
3394         }
3395         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3396                    -font $font -tags [list tag.$id text]]
3397         if {$ntags >= 0} {
3398             $canv bind $t <1> [list showtag $tag 1]
3399         } elseif {$nheads >= 0} {
3400             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3401         }
3402     }
3403     return $xt
3406 proc xcoord {i level ln} {
3407     global canvx0 xspc1 xspc2
3409     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3410     if {$i > 0 && $i == $level} {
3411         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3412     } elseif {$i > $level} {
3413         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3414     }
3415     return $x
3418 proc show_status {msg} {
3419     global canv mainfont fgcolor
3421     clear_display
3422     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3423         -tags text -fill $fgcolor
3426 proc finishcommits {} {
3427     global commitidx phase curview
3428     global pending_select
3430     if {$commitidx($curview) > 0} {
3431         drawrest
3432     } else {
3433         show_status "No commits selected"
3434     }
3435     set phase {}
3436     catch {unset pending_select}
3439 # Insert a new commit as the child of the commit on row $row.
3440 # The new commit will be displayed on row $row and the commits
3441 # on that row and below will move down one row.
3442 proc insertrow {row newcmit} {
3443     global displayorder parentlist childlist commitlisted
3444     global commitrow curview rowidlist rowoffsets numcommits
3445     global rowrangelist idrowranges rowlaidout rowoptim numcommits
3446     global linesegends selectedline
3448     if {$row >= $numcommits} {
3449         puts "oops, inserting new row $row but only have $numcommits rows"
3450         return
3451     }
3452     set p [lindex $displayorder $row]
3453     set displayorder [linsert $displayorder $row $newcmit]
3454     set parentlist [linsert $parentlist $row $p]
3455     set kids [lindex $childlist $row]
3456     lappend kids $newcmit
3457     lset childlist $row $kids
3458     set childlist [linsert $childlist $row {}]
3459     set commitlisted [linsert $commitlisted $row 1]
3460     set l [llength $displayorder]
3461     for {set r $row} {$r < $l} {incr r} {
3462         set id [lindex $displayorder $r]
3463         set commitrow($curview,$id) $r
3464     }
3466     set idlist [lindex $rowidlist $row]
3467     set offs [lindex $rowoffsets $row]
3468     set newoffs {}
3469     foreach x $idlist {
3470         if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3471             lappend newoffs {}
3472         } else {
3473             lappend newoffs 0
3474         }
3475     }
3476     if {[llength $kids] == 1} {
3477         set col [lsearch -exact $idlist $p]
3478         lset idlist $col $newcmit
3479     } else {
3480         set col [llength $idlist]
3481         lappend idlist $newcmit
3482         lappend offs {}
3483         lset rowoffsets $row $offs
3484     }
3485     set rowidlist [linsert $rowidlist $row $idlist]
3486     set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3488     set rowrangelist [linsert $rowrangelist $row {}]
3489     set l [llength $rowrangelist]
3490     for {set r 0} {$r < $l} {incr r} {
3491         set ranges [lindex $rowrangelist $r]
3492         if {$ranges ne {} && [lindex $ranges end] >= $row} {
3493             set newranges {}
3494             foreach x $ranges {
3495                 if {$x >= $row} {
3496                     lappend newranges [expr {$x + 1}]
3497                 } else {
3498                     lappend newranges $x
3499                 }
3500             }
3501             lset rowrangelist $r $newranges
3502         }
3503     }
3504     if {[llength $kids] > 1} {
3505         set rp1 [expr {$row + 1}]
3506         set ranges [lindex $rowrangelist $rp1]
3507         if {$ranges eq {}} {
3508             set ranges [list $row $rp1]
3509         } elseif {[lindex $ranges end-1] == $rp1} {
3510             lset ranges end-1 $row
3511         }
3512         lset rowrangelist $rp1 $ranges
3513     }
3514     foreach id [array names idrowranges] {
3515         set ranges $idrowranges($id)
3516         if {$ranges ne {} && [lindex $ranges end] >= $row} {
3517             set newranges {}
3518             foreach x $ranges {
3519                 if {$x >= $row} {
3520                     lappend newranges [expr {$x + 1}]
3521                 } else {
3522                     lappend newranges $x
3523                 }
3524             }
3525             set idrowranges($id) $newranges
3526         }
3527     }
3529     set linesegends [linsert $linesegends $row {}]
3531     incr rowlaidout
3532     incr rowoptim
3533     incr numcommits
3535     if {[info exists selectedline] && $selectedline >= $row} {
3536         incr selectedline
3537     }
3538     redisplay
3541 # Don't change the text pane cursor if it is currently the hand cursor,
3542 # showing that we are over a sha1 ID link.
3543 proc settextcursor {c} {
3544     global ctext curtextcursor
3546     if {[$ctext cget -cursor] == $curtextcursor} {
3547         $ctext config -cursor $c
3548     }
3549     set curtextcursor $c
3552 proc nowbusy {what} {
3553     global isbusy
3555     if {[array names isbusy] eq {}} {
3556         . config -cursor watch
3557         settextcursor watch
3558     }
3559     set isbusy($what) 1
3562 proc notbusy {what} {
3563     global isbusy maincursor textcursor
3565     catch {unset isbusy($what)}
3566     if {[array names isbusy] eq {}} {
3567         . config -cursor $maincursor
3568         settextcursor $textcursor
3569     }
3572 proc drawrest {} {
3573     global startmsecs
3574     global rowlaidout commitidx curview
3575     global pending_select
3577     layoutrows $rowlaidout $commitidx($curview) 1
3578     layouttail
3579     optimize_rows $row 0 $commitidx($curview)
3580     showstuff $commitidx($curview)
3581     if {[info exists pending_select]} {
3582         selectline 0 1
3583     }
3585     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3586     #global numcommits
3587     #puts "overall $drawmsecs ms for $numcommits commits"
3590 proc findmatches {f} {
3591     global findtype foundstring foundstrlen
3592     if {$findtype == "Regexp"} {
3593         set matches [regexp -indices -all -inline $foundstring $f]
3594     } else {
3595         if {$findtype == "IgnCase"} {
3596             set str [string tolower $f]
3597         } else {
3598             set str $f
3599         }
3600         set matches {}
3601         set i 0
3602         while {[set j [string first $foundstring $str $i]] >= 0} {
3603             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3604             set i [expr {$j + $foundstrlen}]
3605         }
3606     }
3607     return $matches
3610 proc dofind {} {
3611     global findtype findloc findstring markedmatches commitinfo
3612     global numcommits displayorder linehtag linentag linedtag
3613     global mainfont canv canv2 canv3 selectedline
3614     global matchinglines foundstring foundstrlen matchstring
3615     global commitdata
3617     stopfindproc
3618     unmarkmatches
3619     cancel_next_highlight
3620     focus .
3621     set matchinglines {}
3622     if {$findtype == "IgnCase"} {
3623         set foundstring [string tolower $findstring]
3624     } else {
3625         set foundstring $findstring
3626     }
3627     set foundstrlen [string length $findstring]
3628     if {$foundstrlen == 0} return
3629     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3630     set matchstring "*$matchstring*"
3631     if {![info exists selectedline]} {
3632         set oldsel -1
3633     } else {
3634         set oldsel $selectedline
3635     }
3636     set didsel 0
3637     set fldtypes {Headline Author Date Committer CDate Comments}
3638     set l -1
3639     foreach id $displayorder {
3640         set d $commitdata($id)
3641         incr l
3642         if {$findtype == "Regexp"} {
3643             set doesmatch [regexp $foundstring $d]
3644         } elseif {$findtype == "IgnCase"} {
3645             set doesmatch [string match -nocase $matchstring $d]
3646         } else {
3647             set doesmatch [string match $matchstring $d]
3648         }
3649         if {!$doesmatch} continue
3650         if {![info exists commitinfo($id)]} {
3651             getcommit $id
3652         }
3653         set info $commitinfo($id)
3654         set doesmatch 0
3655         foreach f $info ty $fldtypes {
3656             if {$findloc != "All fields" && $findloc != $ty} {
3657                 continue
3658             }
3659             set matches [findmatches $f]
3660             if {$matches == {}} continue
3661             set doesmatch 1
3662             if {$ty == "Headline"} {
3663                 drawcmitrow $l
3664                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3665             } elseif {$ty == "Author"} {
3666                 drawcmitrow $l
3667                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3668             } elseif {$ty == "Date"} {
3669                 drawcmitrow $l
3670                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3671             }
3672         }
3673         if {$doesmatch} {
3674             lappend matchinglines $l
3675             if {!$didsel && $l > $oldsel} {
3676                 findselectline $l
3677                 set didsel 1
3678             }
3679         }
3680     }
3681     if {$matchinglines == {}} {
3682         bell
3683     } elseif {!$didsel} {
3684         findselectline [lindex $matchinglines 0]
3685     }
3688 proc findselectline {l} {
3689     global findloc commentend ctext
3690     selectline $l 1
3691     if {$findloc == "All fields" || $findloc == "Comments"} {
3692         # highlight the matches in the comments
3693         set f [$ctext get 1.0 $commentend]
3694         set matches [findmatches $f]
3695         foreach match $matches {
3696             set start [lindex $match 0]
3697             set end [expr {[lindex $match 1] + 1}]
3698             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3699         }
3700     }
3703 proc findnext {restart} {
3704     global matchinglines selectedline
3705     if {![info exists matchinglines]} {
3706         if {$restart} {
3707             dofind
3708         }
3709         return
3710     }
3711     if {![info exists selectedline]} return
3712     foreach l $matchinglines {
3713         if {$l > $selectedline} {
3714             findselectline $l
3715             return
3716         }
3717     }
3718     bell
3721 proc findprev {} {
3722     global matchinglines selectedline
3723     if {![info exists matchinglines]} {
3724         dofind
3725         return
3726     }
3727     if {![info exists selectedline]} return
3728     set prev {}
3729     foreach l $matchinglines {
3730         if {$l >= $selectedline} break
3731         set prev $l
3732     }
3733     if {$prev != {}} {
3734         findselectline $prev
3735     } else {
3736         bell
3737     }
3740 proc stopfindproc {{done 0}} {
3741     global findprocpid findprocfile findids
3742     global ctext findoldcursor phase maincursor textcursor
3743     global findinprogress
3745     catch {unset findids}
3746     if {[info exists findprocpid]} {
3747         if {!$done} {
3748             catch {exec kill $findprocpid}
3749         }
3750         catch {close $findprocfile}
3751         unset findprocpid
3752     }
3753     catch {unset findinprogress}
3754     notbusy find
3757 # mark a commit as matching by putting a yellow background
3758 # behind the headline
3759 proc markheadline {l id} {
3760     global canv mainfont linehtag
3762     drawcmitrow $l
3763     set bbox [$canv bbox $linehtag($l)]
3764     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3765     $canv lower $t
3768 # mark the bits of a headline, author or date that match a find string
3769 proc markmatches {canv l str tag matches font} {
3770     set bbox [$canv bbox $tag]
3771     set x0 [lindex $bbox 0]
3772     set y0 [lindex $bbox 1]
3773     set y1 [lindex $bbox 3]
3774     foreach match $matches {
3775         set start [lindex $match 0]
3776         set end [lindex $match 1]
3777         if {$start > $end} continue
3778         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3779         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3780         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3781                    [expr {$x0+$xlen+2}] $y1 \
3782                    -outline {} -tags matches -fill yellow]
3783         $canv lower $t
3784     }
3787 proc unmarkmatches {} {
3788     global matchinglines findids
3789     allcanvs delete matches
3790     catch {unset matchinglines}
3791     catch {unset findids}
3794 proc selcanvline {w x y} {
3795     global canv canvy0 ctext linespc
3796     global rowtextx
3797     set ymax [lindex [$canv cget -scrollregion] 3]
3798     if {$ymax == {}} return
3799     set yfrac [lindex [$canv yview] 0]
3800     set y [expr {$y + $yfrac * $ymax}]
3801     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3802     if {$l < 0} {
3803         set l 0
3804     }
3805     if {$w eq $canv} {
3806         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3807     }
3808     unmarkmatches
3809     selectline $l 1
3812 proc commit_descriptor {p} {
3813     global commitinfo
3814     if {![info exists commitinfo($p)]} {
3815         getcommit $p
3816     }
3817     set l "..."
3818     if {[llength $commitinfo($p)] > 1} {
3819         set l [lindex $commitinfo($p) 0]
3820     }
3821     return "$p ($l)\n"
3824 # append some text to the ctext widget, and make any SHA1 ID
3825 # that we know about be a clickable link.
3826 proc appendwithlinks {text tags} {
3827     global ctext commitrow linknum curview
3829     set start [$ctext index "end - 1c"]
3830     $ctext insert end $text $tags
3831     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3832     foreach l $links {
3833         set s [lindex $l 0]
3834         set e [lindex $l 1]
3835         set linkid [string range $text $s $e]
3836         if {![info exists commitrow($curview,$linkid)]} continue
3837         incr e
3838         $ctext tag add link "$start + $s c" "$start + $e c"
3839         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3840         $ctext tag bind link$linknum <1> \
3841             [list selectline $commitrow($curview,$linkid) 1]
3842         incr linknum
3843     }
3844     $ctext tag conf link -foreground blue -underline 1
3845     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3846     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3849 proc viewnextline {dir} {
3850     global canv linespc
3852     $canv delete hover
3853     set ymax [lindex [$canv cget -scrollregion] 3]
3854     set wnow [$canv yview]
3855     set wtop [expr {[lindex $wnow 0] * $ymax}]
3856     set newtop [expr {$wtop + $dir * $linespc}]
3857     if {$newtop < 0} {
3858         set newtop 0
3859     } elseif {$newtop > $ymax} {
3860         set newtop $ymax
3861     }
3862     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3865 # add a list of tag or branch names at position pos
3866 # returns the number of names inserted
3867 proc appendrefs {pos ids var} {
3868     global ctext commitrow linknum curview $var maxrefs
3870     if {[catch {$ctext index $pos}]} {
3871         return 0
3872     }
3873     $ctext conf -state normal
3874     $ctext delete $pos "$pos lineend"
3875     set tags {}
3876     foreach id $ids {
3877         foreach tag [set $var\($id\)] {
3878             lappend tags [list $tag $id]
3879         }
3880     }
3881     if {[llength $tags] > $maxrefs} {
3882         $ctext insert $pos "many ([llength $tags])"
3883     } else {
3884         set tags [lsort -index 0 -decreasing $tags]
3885         set sep {}
3886         foreach ti $tags {
3887             set id [lindex $ti 1]
3888             set lk link$linknum
3889             incr linknum
3890             $ctext tag delete $lk
3891             $ctext insert $pos $sep
3892             $ctext insert $pos [lindex $ti 0] $lk
3893             if {[info exists commitrow($curview,$id)]} {
3894                 $ctext tag conf $lk -foreground blue
3895                 $ctext tag bind $lk <1> \
3896                     [list selectline $commitrow($curview,$id) 1]
3897                 $ctext tag conf $lk -underline 1
3898                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3899                 $ctext tag bind $lk <Leave> \
3900                     { %W configure -cursor $curtextcursor }
3901             }
3902             set sep ", "
3903         }
3904     }
3905     $ctext conf -state disabled
3906     return [llength $tags]
3909 # called when we have finished computing the nearby tags
3910 proc dispneartags {delay} {
3911     global selectedline currentid showneartags tagphase
3913     if {![info exists selectedline] || !$showneartags} return
3914     after cancel dispnexttag
3915     if {$delay} {
3916         after 200 dispnexttag
3917         set tagphase -1
3918     } else {
3919         after idle dispnexttag
3920         set tagphase 0
3921     }
3924 proc dispnexttag {} {
3925     global selectedline currentid showneartags tagphase ctext
3927     if {![info exists selectedline] || !$showneartags} return
3928     switch -- $tagphase {
3929         0 {
3930             set dtags [desctags $currentid]
3931             if {$dtags ne {}} {
3932                 appendrefs precedes $dtags idtags
3933             }
3934         }
3935         1 {
3936             set atags [anctags $currentid]
3937             if {$atags ne {}} {
3938                 appendrefs follows $atags idtags
3939             }
3940         }
3941         2 {
3942             set dheads [descheads $currentid]
3943             if {$dheads ne {}} {
3944                 if {[appendrefs branch $dheads idheads] > 1
3945                     && [$ctext get "branch -3c"] eq "h"} {
3946                     # turn "Branch" into "Branches"
3947                     $ctext conf -state normal
3948                     $ctext insert "branch -2c" "es"
3949                     $ctext conf -state disabled
3950                 }
3951             }
3952         }
3953     }
3954     if {[incr tagphase] <= 2} {
3955         after idle dispnexttag
3956     }
3959 proc selectline {l isnew} {
3960     global canv canv2 canv3 ctext commitinfo selectedline
3961     global displayorder linehtag linentag linedtag
3962     global canvy0 linespc parentlist childlist
3963     global currentid sha1entry
3964     global commentend idtags linknum
3965     global mergemax numcommits pending_select
3966     global cmitmode showneartags allcommits
3968     catch {unset pending_select}
3969     $canv delete hover
3970     normalline
3971     cancel_next_highlight
3972     if {$l < 0 || $l >= $numcommits} return
3973     set y [expr {$canvy0 + $l * $linespc}]
3974     set ymax [lindex [$canv cget -scrollregion] 3]
3975     set ytop [expr {$y - $linespc - 1}]
3976     set ybot [expr {$y + $linespc + 1}]
3977     set wnow [$canv yview]
3978     set wtop [expr {[lindex $wnow 0] * $ymax}]
3979     set wbot [expr {[lindex $wnow 1] * $ymax}]
3980     set wh [expr {$wbot - $wtop}]
3981     set newtop $wtop
3982     if {$ytop < $wtop} {
3983         if {$ybot < $wtop} {
3984             set newtop [expr {$y - $wh / 2.0}]
3985         } else {
3986             set newtop $ytop
3987             if {$newtop > $wtop - $linespc} {
3988                 set newtop [expr {$wtop - $linespc}]
3989             }
3990         }
3991     } elseif {$ybot > $wbot} {
3992         if {$ytop > $wbot} {
3993             set newtop [expr {$y - $wh / 2.0}]
3994         } else {
3995             set newtop [expr {$ybot - $wh}]
3996             if {$newtop < $wtop + $linespc} {
3997                 set newtop [expr {$wtop + $linespc}]
3998             }
3999         }
4000     }
4001     if {$newtop != $wtop} {
4002         if {$newtop < 0} {
4003             set newtop 0
4004         }
4005         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4006         drawvisible
4007     }
4009     if {![info exists linehtag($l)]} return
4010     $canv delete secsel
4011     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4012                -tags secsel -fill [$canv cget -selectbackground]]
4013     $canv lower $t
4014     $canv2 delete secsel
4015     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4016                -tags secsel -fill [$canv2 cget -selectbackground]]
4017     $canv2 lower $t
4018     $canv3 delete secsel
4019     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4020                -tags secsel -fill [$canv3 cget -selectbackground]]
4021     $canv3 lower $t
4023     if {$isnew} {
4024         addtohistory [list selectline $l 0]
4025     }
4027     set selectedline $l
4029     set id [lindex $displayorder $l]
4030     set currentid $id
4031     $sha1entry delete 0 end
4032     $sha1entry insert 0 $id
4033     $sha1entry selection from 0
4034     $sha1entry selection to end
4035     rhighlight_sel $id
4037     $ctext conf -state normal
4038     clear_ctext
4039     set linknum 0
4040     set info $commitinfo($id)
4041     set date [formatdate [lindex $info 2]]
4042     $ctext insert end "Author: [lindex $info 1]  $date\n"
4043     set date [formatdate [lindex $info 4]]
4044     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4045     if {[info exists idtags($id)]} {
4046         $ctext insert end "Tags:"
4047         foreach tag $idtags($id) {
4048             $ctext insert end " $tag"
4049         }
4050         $ctext insert end "\n"
4051     }
4053     set headers {}
4054     set olds [lindex $parentlist $l]
4055     if {[llength $olds] > 1} {
4056         set np 0
4057         foreach p $olds {
4058             if {$np >= $mergemax} {
4059                 set tag mmax
4060             } else {
4061                 set tag m$np
4062             }
4063             $ctext insert end "Parent: " $tag
4064             appendwithlinks [commit_descriptor $p] {}
4065             incr np
4066         }
4067     } else {
4068         foreach p $olds {
4069             append headers "Parent: [commit_descriptor $p]"
4070         }
4071     }
4073     foreach c [lindex $childlist $l] {
4074         append headers "Child:  [commit_descriptor $c]"
4075     }
4077     # make anything that looks like a SHA1 ID be a clickable link
4078     appendwithlinks $headers {}
4079     if {$showneartags} {
4080         if {![info exists allcommits]} {
4081             getallcommits
4082         }
4083         $ctext insert end "Branch: "
4084         $ctext mark set branch "end -1c"
4085         $ctext mark gravity branch left
4086         $ctext insert end "\nFollows: "
4087         $ctext mark set follows "end -1c"
4088         $ctext mark gravity follows left
4089         $ctext insert end "\nPrecedes: "
4090         $ctext mark set precedes "end -1c"
4091         $ctext mark gravity precedes left
4092         $ctext insert end "\n"
4093         dispneartags 1
4094     }
4095     $ctext insert end "\n"
4096     appendwithlinks [lindex $info 5] {comment}
4098     $ctext tag delete Comments
4099     $ctext tag remove found 1.0 end
4100     $ctext conf -state disabled
4101     set commentend [$ctext index "end - 1c"]
4103     init_flist "Comments"
4104     if {$cmitmode eq "tree"} {
4105         gettree $id
4106     } elseif {[llength $olds] <= 1} {
4107         startdiff $id
4108     } else {
4109         mergediff $id $l
4110     }
4113 proc selfirstline {} {
4114     unmarkmatches
4115     selectline 0 1
4118 proc sellastline {} {
4119     global numcommits
4120     unmarkmatches
4121     set l [expr {$numcommits - 1}]
4122     selectline $l 1
4125 proc selnextline {dir} {
4126     global selectedline
4127     if {![info exists selectedline]} return
4128     set l [expr {$selectedline + $dir}]
4129     unmarkmatches
4130     selectline $l 1
4133 proc selnextpage {dir} {
4134     global canv linespc selectedline numcommits
4136     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4137     if {$lpp < 1} {
4138         set lpp 1
4139     }
4140     allcanvs yview scroll [expr {$dir * $lpp}] units
4141     drawvisible
4142     if {![info exists selectedline]} return
4143     set l [expr {$selectedline + $dir * $lpp}]
4144     if {$l < 0} {
4145         set l 0
4146     } elseif {$l >= $numcommits} {
4147         set l [expr $numcommits - 1]
4148     }
4149     unmarkmatches
4150     selectline $l 1
4153 proc unselectline {} {
4154     global selectedline currentid
4156     catch {unset selectedline}
4157     catch {unset currentid}
4158     allcanvs delete secsel
4159     rhighlight_none
4160     cancel_next_highlight
4163 proc reselectline {} {
4164     global selectedline
4166     if {[info exists selectedline]} {
4167         selectline $selectedline 0
4168     }
4171 proc addtohistory {cmd} {
4172     global history historyindex curview
4174     set elt [list $curview $cmd]
4175     if {$historyindex > 0
4176         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4177         return
4178     }
4180     if {$historyindex < [llength $history]} {
4181         set history [lreplace $history $historyindex end $elt]
4182     } else {
4183         lappend history $elt
4184     }
4185     incr historyindex
4186     if {$historyindex > 1} {
4187         .tf.bar.leftbut conf -state normal
4188     } else {
4189         .tf.bar.leftbut conf -state disabled
4190     }
4191     .tf.bar.rightbut conf -state disabled
4194 proc godo {elt} {
4195     global curview
4197     set view [lindex $elt 0]
4198     set cmd [lindex $elt 1]
4199     if {$curview != $view} {
4200         showview $view
4201     }
4202     eval $cmd
4205 proc goback {} {
4206     global history historyindex
4208     if {$historyindex > 1} {
4209         incr historyindex -1
4210         godo [lindex $history [expr {$historyindex - 1}]]
4211         .tf.bar.rightbut conf -state normal
4212     }
4213     if {$historyindex <= 1} {
4214         .tf.bar.leftbut conf -state disabled
4215     }
4218 proc goforw {} {
4219     global history historyindex
4221     if {$historyindex < [llength $history]} {
4222         set cmd [lindex $history $historyindex]
4223         incr historyindex
4224         godo $cmd
4225         .tf.bar.leftbut conf -state normal
4226     }
4227     if {$historyindex >= [llength $history]} {
4228         .tf.bar.rightbut conf -state disabled
4229     }
4232 proc gettree {id} {
4233     global treefilelist treeidlist diffids diffmergeid treepending
4235     set diffids $id
4236     catch {unset diffmergeid}
4237     if {![info exists treefilelist($id)]} {
4238         if {![info exists treepending]} {
4239             if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4240                 return
4241             }
4242             set treepending $id
4243             set treefilelist($id) {}
4244             set treeidlist($id) {}
4245             fconfigure $gtf -blocking 0
4246             fileevent $gtf readable [list gettreeline $gtf $id]
4247         }
4248     } else {
4249         setfilelist $id
4250     }
4253 proc gettreeline {gtf id} {
4254     global treefilelist treeidlist treepending cmitmode diffids
4256     while {[gets $gtf line] >= 0} {
4257         if {[lindex $line 1] ne "blob"} continue
4258         set sha1 [lindex $line 2]
4259         set fname [lindex $line 3]
4260         lappend treefilelist($id) $fname
4261         lappend treeidlist($id) $sha1
4262     }
4263     if {![eof $gtf]} return
4264     close $gtf
4265     unset treepending
4266     if {$cmitmode ne "tree"} {
4267         if {![info exists diffmergeid]} {
4268             gettreediffs $diffids
4269         }
4270     } elseif {$id ne $diffids} {
4271         gettree $diffids
4272     } else {
4273         setfilelist $id
4274     }
4277 proc showfile {f} {
4278     global treefilelist treeidlist diffids
4279     global ctext commentend
4281     set i [lsearch -exact $treefilelist($diffids) $f]
4282     if {$i < 0} {
4283         puts "oops, $f not in list for id $diffids"
4284         return
4285     }
4286     set blob [lindex $treeidlist($diffids) $i]
4287     if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4288         puts "oops, error reading blob $blob: $err"
4289         return
4290     }
4291     fconfigure $bf -blocking 0
4292     fileevent $bf readable [list getblobline $bf $diffids]
4293     $ctext config -state normal
4294     clear_ctext $commentend
4295     $ctext insert end "\n"
4296     $ctext insert end "$f\n" filesep
4297     $ctext config -state disabled
4298     $ctext yview $commentend
4301 proc getblobline {bf id} {
4302     global diffids cmitmode ctext
4304     if {$id ne $diffids || $cmitmode ne "tree"} {
4305         catch {close $bf}
4306         return
4307     }
4308     $ctext config -state normal
4309     while {[gets $bf line] >= 0} {
4310         $ctext insert end "$line\n"
4311     }
4312     if {[eof $bf]} {
4313         # delete last newline
4314         $ctext delete "end - 2c" "end - 1c"
4315         close $bf
4316     }
4317     $ctext config -state disabled
4320 proc mergediff {id l} {
4321     global diffmergeid diffopts mdifffd
4322     global diffids
4323     global parentlist
4325     set diffmergeid $id
4326     set diffids $id
4327     # this doesn't seem to actually affect anything...
4328     set env(GIT_DIFF_OPTS) $diffopts
4329     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4330     if {[catch {set mdf [open $cmd r]} err]} {
4331         error_popup "Error getting merge diffs: $err"
4332         return
4333     }
4334     fconfigure $mdf -blocking 0
4335     set mdifffd($id) $mdf
4336     set np [llength [lindex $parentlist $l]]
4337     fileevent $mdf readable [list getmergediffline $mdf $id $np]
4338     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4341 proc getmergediffline {mdf id np} {
4342     global diffmergeid ctext cflist nextupdate mergemax
4343     global difffilestart mdifffd
4345     set n [gets $mdf line]
4346     if {$n < 0} {
4347         if {[eof $mdf]} {
4348             close $mdf
4349         }
4350         return
4351     }
4352     if {![info exists diffmergeid] || $id != $diffmergeid
4353         || $mdf != $mdifffd($id)} {
4354         return
4355     }
4356     $ctext conf -state normal
4357     if {[regexp {^diff --cc (.*)} $line match fname]} {
4358         # start of a new file
4359         $ctext insert end "\n"
4360         set here [$ctext index "end - 1c"]
4361         lappend difffilestart $here
4362         add_flist [list $fname]
4363         set l [expr {(78 - [string length $fname]) / 2}]
4364         set pad [string range "----------------------------------------" 1 $l]
4365         $ctext insert end "$pad $fname $pad\n" filesep
4366     } elseif {[regexp {^@@} $line]} {
4367         $ctext insert end "$line\n" hunksep
4368     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4369         # do nothing
4370     } else {
4371         # parse the prefix - one ' ', '-' or '+' for each parent
4372         set spaces {}
4373         set minuses {}
4374         set pluses {}
4375         set isbad 0
4376         for {set j 0} {$j < $np} {incr j} {
4377             set c [string range $line $j $j]
4378             if {$c == " "} {
4379                 lappend spaces $j
4380             } elseif {$c == "-"} {
4381                 lappend minuses $j
4382             } elseif {$c == "+"} {
4383                 lappend pluses $j
4384             } else {
4385                 set isbad 1
4386                 break
4387             }
4388         }
4389         set tags {}
4390         set num {}
4391         if {!$isbad && $minuses ne {} && $pluses eq {}} {
4392             # line doesn't appear in result, parents in $minuses have the line
4393             set num [lindex $minuses 0]
4394         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4395             # line appears in result, parents in $pluses don't have the line
4396             lappend tags mresult
4397             set num [lindex $spaces 0]
4398         }
4399         if {$num ne {}} {
4400             if {$num >= $mergemax} {
4401                 set num "max"
4402             }
4403             lappend tags m$num
4404         }
4405         $ctext insert end "$line\n" $tags
4406     }
4407     $ctext conf -state disabled
4408     if {[clock clicks -milliseconds] >= $nextupdate} {
4409         incr nextupdate 100
4410         fileevent $mdf readable {}
4411         update
4412         fileevent $mdf readable [list getmergediffline $mdf $id $np]
4413     }
4416 proc startdiff {ids} {
4417     global treediffs diffids treepending diffmergeid
4419     set diffids $ids
4420     catch {unset diffmergeid}
4421     if {![info exists treediffs($ids)]} {
4422         if {![info exists treepending]} {
4423             gettreediffs $ids
4424         }
4425     } else {
4426         addtocflist $ids
4427     }
4430 proc addtocflist {ids} {
4431     global treediffs cflist
4432     add_flist $treediffs($ids)
4433     getblobdiffs $ids
4436 proc gettreediffs {ids} {
4437     global treediff treepending
4438     set treepending $ids
4439     set treediff {}
4440     if {[catch \
4441          {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4442         ]} return
4443     fconfigure $gdtf -blocking 0
4444     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4447 proc gettreediffline {gdtf ids} {
4448     global treediff treediffs treepending diffids diffmergeid
4449     global cmitmode
4451     set n [gets $gdtf line]
4452     if {$n < 0} {
4453         if {![eof $gdtf]} return
4454         close $gdtf
4455         set treediffs($ids) $treediff
4456         unset treepending
4457         if {$cmitmode eq "tree"} {
4458             gettree $diffids
4459         } elseif {$ids != $diffids} {
4460             if {![info exists diffmergeid]} {
4461                 gettreediffs $diffids
4462             }
4463         } else {
4464             addtocflist $ids
4465         }
4466         return
4467     }
4468     set file [lindex $line 5]
4469     lappend treediff $file
4472 proc getblobdiffs {ids} {
4473     global diffopts blobdifffd diffids env curdifftag curtagstart
4474     global nextupdate diffinhdr treediffs
4476     set env(GIT_DIFF_OPTS) $diffopts
4477     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4478     if {[catch {set bdf [open $cmd r]} err]} {
4479         puts "error getting diffs: $err"
4480         return
4481     }
4482     set diffinhdr 0
4483     fconfigure $bdf -blocking 0
4484     set blobdifffd($ids) $bdf
4485     set curdifftag Comments
4486     set curtagstart 0.0
4487     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4488     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4491 proc setinlist {var i val} {
4492     global $var
4494     while {[llength [set $var]] < $i} {
4495         lappend $var {}
4496     }
4497     if {[llength [set $var]] == $i} {
4498         lappend $var $val
4499     } else {
4500         lset $var $i $val
4501     }
4504 proc getblobdiffline {bdf ids} {
4505     global diffids blobdifffd ctext curdifftag curtagstart
4506     global diffnexthead diffnextnote difffilestart
4507     global nextupdate diffinhdr treediffs
4509     set n [gets $bdf line]
4510     if {$n < 0} {
4511         if {[eof $bdf]} {
4512             close $bdf
4513             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4514                 $ctext tag add $curdifftag $curtagstart end
4515             }
4516         }
4517         return
4518     }
4519     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4520         return
4521     }
4522     $ctext conf -state normal
4523     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4524         # start of a new file
4525         $ctext insert end "\n"
4526         $ctext tag add $curdifftag $curtagstart end
4527         set here [$ctext index "end - 1c"]
4528         set curtagstart $here
4529         set header $newname
4530         set i [lsearch -exact $treediffs($ids) $fname]
4531         if {$i >= 0} {
4532             setinlist difffilestart $i $here
4533         }
4534         if {$newname ne $fname} {
4535             set i [lsearch -exact $treediffs($ids) $newname]
4536             if {$i >= 0} {
4537                 setinlist difffilestart $i $here
4538             }
4539         }
4540         set curdifftag "f:$fname"
4541         $ctext tag delete $curdifftag
4542         set l [expr {(78 - [string length $header]) / 2}]
4543         set pad [string range "----------------------------------------" 1 $l]
4544         $ctext insert end "$pad $header $pad\n" filesep
4545         set diffinhdr 1
4546     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4547         # do nothing
4548     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4549         set diffinhdr 0
4550     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4551                    $line match f1l f1c f2l f2c rest]} {
4552         $ctext insert end "$line\n" hunksep
4553         set diffinhdr 0
4554     } else {
4555         set x [string range $line 0 0]
4556         if {$x == "-" || $x == "+"} {
4557             set tag [expr {$x == "+"}]
4558             $ctext insert end "$line\n" d$tag
4559         } elseif {$x == " "} {
4560             $ctext insert end "$line\n"
4561         } elseif {$diffinhdr || $x == "\\"} {
4562             # e.g. "\ No newline at end of file"
4563             $ctext insert end "$line\n" filesep
4564         } else {
4565             # Something else we don't recognize
4566             if {$curdifftag != "Comments"} {
4567                 $ctext insert end "\n"
4568                 $ctext tag add $curdifftag $curtagstart end
4569                 set curtagstart [$ctext index "end - 1c"]
4570                 set curdifftag Comments
4571             }
4572             $ctext insert end "$line\n" filesep
4573         }
4574     }
4575     $ctext conf -state disabled
4576     if {[clock clicks -milliseconds] >= $nextupdate} {
4577         incr nextupdate 100
4578         fileevent $bdf readable {}
4579         update
4580         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4581     }
4584 proc changediffdisp {} {
4585     global ctext diffelide
4587     $ctext tag conf d0 -elide [lindex $diffelide 0]
4588     $ctext tag conf d1 -elide [lindex $diffelide 1]
4591 proc prevfile {} {
4592     global difffilestart ctext
4593     set prev [lindex $difffilestart 0]
4594     set here [$ctext index @0,0]
4595     foreach loc $difffilestart {
4596         if {[$ctext compare $loc >= $here]} {
4597             $ctext yview $prev
4598             return
4599         }
4600         set prev $loc
4601     }
4602     $ctext yview $prev
4605 proc nextfile {} {
4606     global difffilestart ctext
4607     set here [$ctext index @0,0]
4608     foreach loc $difffilestart {
4609         if {[$ctext compare $loc > $here]} {
4610             $ctext yview $loc
4611             return
4612         }
4613     }
4616 proc clear_ctext {{first 1.0}} {
4617     global ctext smarktop smarkbot
4619     set l [lindex [split $first .] 0]
4620     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4621         set smarktop $l
4622     }
4623     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4624         set smarkbot $l
4625     }
4626     $ctext delete $first end
4629 proc incrsearch {name ix op} {
4630     global ctext searchstring searchdirn
4632     $ctext tag remove found 1.0 end
4633     if {[catch {$ctext index anchor}]} {
4634         # no anchor set, use start of selection, or of visible area
4635         set sel [$ctext tag ranges sel]
4636         if {$sel ne {}} {
4637             $ctext mark set anchor [lindex $sel 0]
4638         } elseif {$searchdirn eq "-forwards"} {
4639             $ctext mark set anchor @0,0
4640         } else {
4641             $ctext mark set anchor @0,[winfo height $ctext]
4642         }
4643     }
4644     if {$searchstring ne {}} {
4645         set here [$ctext search $searchdirn -- $searchstring anchor]
4646         if {$here ne {}} {
4647             $ctext see $here
4648         }
4649         searchmarkvisible 1
4650     }
4653 proc dosearch {} {
4654     global sstring ctext searchstring searchdirn
4656     focus $sstring
4657     $sstring icursor end
4658     set searchdirn -forwards
4659     if {$searchstring ne {}} {
4660         set sel [$ctext tag ranges sel]
4661         if {$sel ne {}} {
4662             set start "[lindex $sel 0] + 1c"
4663         } elseif {[catch {set start [$ctext index anchor]}]} {
4664             set start "@0,0"
4665         }
4666         set match [$ctext search -count mlen -- $searchstring $start]
4667         $ctext tag remove sel 1.0 end
4668         if {$match eq {}} {
4669             bell
4670             return
4671         }
4672         $ctext see $match
4673         set mend "$match + $mlen c"
4674         $ctext tag add sel $match $mend
4675         $ctext mark unset anchor
4676     }
4679 proc dosearchback {} {
4680     global sstring ctext searchstring searchdirn
4682     focus $sstring
4683     $sstring icursor end
4684     set searchdirn -backwards
4685     if {$searchstring ne {}} {
4686         set sel [$ctext tag ranges sel]
4687         if {$sel ne {}} {
4688             set start [lindex $sel 0]
4689         } elseif {[catch {set start [$ctext index anchor]}]} {
4690             set start @0,[winfo height $ctext]
4691         }
4692         set match [$ctext search -backwards -count ml -- $searchstring $start]
4693         $ctext tag remove sel 1.0 end
4694         if {$match eq {}} {
4695             bell
4696             return
4697         }
4698         $ctext see $match
4699         set mend "$match + $ml c"
4700         $ctext tag add sel $match $mend
4701         $ctext mark unset anchor
4702     }
4705 proc searchmark {first last} {
4706     global ctext searchstring
4708     set mend $first.0
4709     while {1} {
4710         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4711         if {$match eq {}} break
4712         set mend "$match + $mlen c"
4713         $ctext tag add found $match $mend
4714     }
4717 proc searchmarkvisible {doall} {
4718     global ctext smarktop smarkbot
4720     set topline [lindex [split [$ctext index @0,0] .] 0]
4721     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4722     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4723         # no overlap with previous
4724         searchmark $topline $botline
4725         set smarktop $topline
4726         set smarkbot $botline
4727     } else {
4728         if {$topline < $smarktop} {
4729             searchmark $topline [expr {$smarktop-1}]
4730             set smarktop $topline
4731         }
4732         if {$botline > $smarkbot} {
4733             searchmark [expr {$smarkbot+1}] $botline
4734             set smarkbot $botline
4735         }
4736     }
4739 proc scrolltext {f0 f1} {
4740     global searchstring
4742     .bleft.sb set $f0 $f1
4743     if {$searchstring ne {}} {
4744         searchmarkvisible 0
4745     }
4748 proc setcoords {} {
4749     global linespc charspc canvx0 canvy0 mainfont
4750     global xspc1 xspc2 lthickness
4752     set linespc [font metrics $mainfont -linespace]
4753     set charspc [font measure $mainfont "m"]
4754     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4755     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4756     set lthickness [expr {int($linespc / 9) + 1}]
4757     set xspc1(0) $linespc
4758     set xspc2 $linespc
4761 proc redisplay {} {
4762     global canv
4763     global selectedline
4765     set ymax [lindex [$canv cget -scrollregion] 3]
4766     if {$ymax eq {} || $ymax == 0} return
4767     set span [$canv yview]
4768     clear_display
4769     setcanvscroll
4770     allcanvs yview moveto [lindex $span 0]
4771     drawvisible
4772     if {[info exists selectedline]} {
4773         selectline $selectedline 0
4774         allcanvs yview moveto [lindex $span 0]
4775     }
4778 proc incrfont {inc} {
4779     global mainfont textfont ctext canv phase cflist
4780     global charspc tabstop
4781     global stopped entries
4782     unmarkmatches
4783     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4784     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4785     setcoords
4786     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
4787     $cflist conf -font $textfont
4788     $ctext tag conf filesep -font [concat $textfont bold]
4789     foreach e $entries {
4790         $e conf -font $mainfont
4791     }
4792     if {$phase eq "getcommits"} {
4793         $canv itemconf textitems -font $mainfont
4794     }
4795     redisplay
4798 proc clearsha1 {} {
4799     global sha1entry sha1string
4800     if {[string length $sha1string] == 40} {
4801         $sha1entry delete 0 end
4802     }
4805 proc sha1change {n1 n2 op} {
4806     global sha1string currentid sha1but
4807     if {$sha1string == {}
4808         || ([info exists currentid] && $sha1string == $currentid)} {
4809         set state disabled
4810     } else {
4811         set state normal
4812     }
4813     if {[$sha1but cget -state] == $state} return
4814     if {$state == "normal"} {
4815         $sha1but conf -state normal -relief raised -text "Goto: "
4816     } else {
4817         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4818     }
4821 proc gotocommit {} {
4822     global sha1string currentid commitrow tagids headids
4823     global displayorder numcommits curview
4825     if {$sha1string == {}
4826         || ([info exists currentid] && $sha1string == $currentid)} return
4827     if {[info exists tagids($sha1string)]} {
4828         set id $tagids($sha1string)
4829     } elseif {[info exists headids($sha1string)]} {
4830         set id $headids($sha1string)
4831     } else {
4832         set id [string tolower $sha1string]
4833         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4834             set matches {}
4835             foreach i $displayorder {
4836                 if {[string match $id* $i]} {
4837                     lappend matches $i
4838                 }
4839             }
4840             if {$matches ne {}} {
4841                 if {[llength $matches] > 1} {
4842                     error_popup "Short SHA1 id $id is ambiguous"
4843                     return
4844                 }
4845                 set id [lindex $matches 0]
4846             }
4847         }
4848     }
4849     if {[info exists commitrow($curview,$id)]} {
4850         selectline $commitrow($curview,$id) 1
4851         return
4852     }
4853     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4854         set type "SHA1 id"
4855     } else {
4856         set type "Tag/Head"
4857     }
4858     error_popup "$type $sha1string is not known"
4861 proc lineenter {x y id} {
4862     global hoverx hovery hoverid hovertimer
4863     global commitinfo canv
4865     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4866     set hoverx $x
4867     set hovery $y
4868     set hoverid $id
4869     if {[info exists hovertimer]} {
4870         after cancel $hovertimer
4871     }
4872     set hovertimer [after 500 linehover]
4873     $canv delete hover
4876 proc linemotion {x y id} {
4877     global hoverx hovery hoverid hovertimer
4879     if {[info exists hoverid] && $id == $hoverid} {
4880         set hoverx $x
4881         set hovery $y
4882         if {[info exists hovertimer]} {
4883             after cancel $hovertimer
4884         }
4885         set hovertimer [after 500 linehover]
4886     }
4889 proc lineleave {id} {
4890     global hoverid hovertimer canv
4892     if {[info exists hoverid] && $id == $hoverid} {
4893         $canv delete hover
4894         if {[info exists hovertimer]} {
4895             after cancel $hovertimer
4896             unset hovertimer
4897         }
4898         unset hoverid
4899     }
4902 proc linehover {} {
4903     global hoverx hovery hoverid hovertimer
4904     global canv linespc lthickness
4905     global commitinfo mainfont
4907     set text [lindex $commitinfo($hoverid) 0]
4908     set ymax [lindex [$canv cget -scrollregion] 3]
4909     if {$ymax == {}} return
4910     set yfrac [lindex [$canv yview] 0]
4911     set x [expr {$hoverx + 2 * $linespc}]
4912     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4913     set x0 [expr {$x - 2 * $lthickness}]
4914     set y0 [expr {$y - 2 * $lthickness}]
4915     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4916     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4917     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4918                -fill \#ffff80 -outline black -width 1 -tags hover]
4919     $canv raise $t
4920     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4921                -font $mainfont]
4922     $canv raise $t
4925 proc clickisonarrow {id y} {
4926     global lthickness
4928     set ranges [rowranges $id]
4929     set thresh [expr {2 * $lthickness + 6}]
4930     set n [expr {[llength $ranges] - 1}]
4931     for {set i 1} {$i < $n} {incr i} {
4932         set row [lindex $ranges $i]
4933         if {abs([yc $row] - $y) < $thresh} {
4934             return $i
4935         }
4936     }
4937     return {}
4940 proc arrowjump {id n y} {
4941     global canv
4943     # 1 <-> 2, 3 <-> 4, etc...
4944     set n [expr {(($n - 1) ^ 1) + 1}]
4945     set row [lindex [rowranges $id] $n]
4946     set yt [yc $row]
4947     set ymax [lindex [$canv cget -scrollregion] 3]
4948     if {$ymax eq {} || $ymax <= 0} return
4949     set view [$canv yview]
4950     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4951     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4952     if {$yfrac < 0} {
4953         set yfrac 0
4954     }
4955     allcanvs yview moveto $yfrac
4958 proc lineclick {x y id isnew} {
4959     global ctext commitinfo children canv thickerline curview
4961     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4962     unmarkmatches
4963     unselectline
4964     normalline
4965     $canv delete hover
4966     # draw this line thicker than normal
4967     set thickerline $id
4968     drawlines $id
4969     if {$isnew} {
4970         set ymax [lindex [$canv cget -scrollregion] 3]
4971         if {$ymax eq {}} return
4972         set yfrac [lindex [$canv yview] 0]
4973         set y [expr {$y + $yfrac * $ymax}]
4974     }
4975     set dirn [clickisonarrow $id $y]
4976     if {$dirn ne {}} {
4977         arrowjump $id $dirn $y
4978         return
4979     }
4981     if {$isnew} {
4982         addtohistory [list lineclick $x $y $id 0]
4983     }
4984     # fill the details pane with info about this line
4985     $ctext conf -state normal
4986     clear_ctext
4987     $ctext tag conf link -foreground blue -underline 1
4988     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4989     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4990     $ctext insert end "Parent:\t"
4991     $ctext insert end $id [list link link0]
4992     $ctext tag bind link0 <1> [list selbyid $id]
4993     set info $commitinfo($id)
4994     $ctext insert end "\n\t[lindex $info 0]\n"
4995     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4996     set date [formatdate [lindex $info 2]]
4997     $ctext insert end "\tDate:\t$date\n"
4998     set kids $children($curview,$id)
4999     if {$kids ne {}} {
5000         $ctext insert end "\nChildren:"
5001         set i 0
5002         foreach child $kids {
5003             incr i
5004             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5005             set info $commitinfo($child)
5006             $ctext insert end "\n\t"
5007             $ctext insert end $child [list link link$i]
5008             $ctext tag bind link$i <1> [list selbyid $child]
5009             $ctext insert end "\n\t[lindex $info 0]"
5010             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5011             set date [formatdate [lindex $info 2]]
5012             $ctext insert end "\n\tDate:\t$date\n"
5013         }
5014     }
5015     $ctext conf -state disabled
5016     init_flist {}
5019 proc normalline {} {
5020     global thickerline
5021     if {[info exists thickerline]} {
5022         set id $thickerline
5023         unset thickerline
5024         drawlines $id
5025     }
5028 proc selbyid {id} {
5029     global commitrow curview
5030     if {[info exists commitrow($curview,$id)]} {
5031         selectline $commitrow($curview,$id) 1
5032     }
5035 proc mstime {} {
5036     global startmstime
5037     if {![info exists startmstime]} {
5038         set startmstime [clock clicks -milliseconds]
5039     }
5040     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5043 proc rowmenu {x y id} {
5044     global rowctxmenu commitrow selectedline rowmenuid curview
5046     if {![info exists selectedline]
5047         || $commitrow($curview,$id) eq $selectedline} {
5048         set state disabled
5049     } else {
5050         set state normal
5051     }
5052     $rowctxmenu entryconfigure "Diff this*" -state $state
5053     $rowctxmenu entryconfigure "Diff selected*" -state $state
5054     $rowctxmenu entryconfigure "Make patch" -state $state
5055     set rowmenuid $id
5056     tk_popup $rowctxmenu $x $y
5059 proc diffvssel {dirn} {
5060     global rowmenuid selectedline displayorder
5062     if {![info exists selectedline]} return
5063     if {$dirn} {
5064         set oldid [lindex $displayorder $selectedline]
5065         set newid $rowmenuid
5066     } else {
5067         set oldid $rowmenuid
5068         set newid [lindex $displayorder $selectedline]
5069     }
5070     addtohistory [list doseldiff $oldid $newid]
5071     doseldiff $oldid $newid
5074 proc doseldiff {oldid newid} {
5075     global ctext
5076     global commitinfo
5078     $ctext conf -state normal
5079     clear_ctext
5080     init_flist "Top"
5081     $ctext insert end "From "
5082     $ctext tag conf link -foreground blue -underline 1
5083     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5084     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5085     $ctext tag bind link0 <1> [list selbyid $oldid]
5086     $ctext insert end $oldid [list link link0]
5087     $ctext insert end "\n     "
5088     $ctext insert end [lindex $commitinfo($oldid) 0]
5089     $ctext insert end "\n\nTo   "
5090     $ctext tag bind link1 <1> [list selbyid $newid]
5091     $ctext insert end $newid [list link link1]
5092     $ctext insert end "\n     "
5093     $ctext insert end [lindex $commitinfo($newid) 0]
5094     $ctext insert end "\n"
5095     $ctext conf -state disabled
5096     $ctext tag delete Comments
5097     $ctext tag remove found 1.0 end
5098     startdiff [list $oldid $newid]
5101 proc mkpatch {} {
5102     global rowmenuid currentid commitinfo patchtop patchnum
5104     if {![info exists currentid]} return
5105     set oldid $currentid
5106     set oldhead [lindex $commitinfo($oldid) 0]
5107     set newid $rowmenuid
5108     set newhead [lindex $commitinfo($newid) 0]
5109     set top .patch
5110     set patchtop $top
5111     catch {destroy $top}
5112     toplevel $top
5113     label $top.title -text "Generate patch"
5114     grid $top.title - -pady 10
5115     label $top.from -text "From:"
5116     entry $top.fromsha1 -width 40 -relief flat
5117     $top.fromsha1 insert 0 $oldid
5118     $top.fromsha1 conf -state readonly
5119     grid $top.from $top.fromsha1 -sticky w
5120     entry $top.fromhead -width 60 -relief flat
5121     $top.fromhead insert 0 $oldhead
5122     $top.fromhead conf -state readonly
5123     grid x $top.fromhead -sticky w
5124     label $top.to -text "To:"
5125     entry $top.tosha1 -width 40 -relief flat
5126     $top.tosha1 insert 0 $newid
5127     $top.tosha1 conf -state readonly
5128     grid $top.to $top.tosha1 -sticky w
5129     entry $top.tohead -width 60 -relief flat
5130     $top.tohead insert 0 $newhead
5131     $top.tohead conf -state readonly
5132     grid x $top.tohead -sticky w
5133     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5134     grid $top.rev x -pady 10
5135     label $top.flab -text "Output file:"
5136     entry $top.fname -width 60
5137     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5138     incr patchnum
5139     grid $top.flab $top.fname -sticky w
5140     frame $top.buts
5141     button $top.buts.gen -text "Generate" -command mkpatchgo
5142     button $top.buts.can -text "Cancel" -command mkpatchcan
5143     grid $top.buts.gen $top.buts.can
5144     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5145     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5146     grid $top.buts - -pady 10 -sticky ew
5147     focus $top.fname
5150 proc mkpatchrev {} {
5151     global patchtop
5153     set oldid [$patchtop.fromsha1 get]
5154     set oldhead [$patchtop.fromhead get]
5155     set newid [$patchtop.tosha1 get]
5156     set newhead [$patchtop.tohead get]
5157     foreach e [list fromsha1 fromhead tosha1 tohead] \
5158             v [list $newid $newhead $oldid $oldhead] {
5159         $patchtop.$e conf -state normal
5160         $patchtop.$e delete 0 end
5161         $patchtop.$e insert 0 $v
5162         $patchtop.$e conf -state readonly
5163     }
5166 proc mkpatchgo {} {
5167     global patchtop
5169     set oldid [$patchtop.fromsha1 get]
5170     set newid [$patchtop.tosha1 get]
5171     set fname [$patchtop.fname get]
5172     if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5173         error_popup "Error creating patch: $err"
5174     }
5175     catch {destroy $patchtop}
5176     unset patchtop
5179 proc mkpatchcan {} {
5180     global patchtop
5182     catch {destroy $patchtop}
5183     unset patchtop
5186 proc mktag {} {
5187     global rowmenuid mktagtop commitinfo
5189     set top .maketag
5190     set mktagtop $top
5191     catch {destroy $top}
5192     toplevel $top
5193     label $top.title -text "Create tag"
5194     grid $top.title - -pady 10
5195     label $top.id -text "ID:"
5196     entry $top.sha1 -width 40 -relief flat
5197     $top.sha1 insert 0 $rowmenuid
5198     $top.sha1 conf -state readonly
5199     grid $top.id $top.sha1 -sticky w
5200     entry $top.head -width 60 -relief flat
5201     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5202     $top.head conf -state readonly
5203     grid x $top.head -sticky w
5204     label $top.tlab -text "Tag name:"
5205     entry $top.tag -width 60
5206     grid $top.tlab $top.tag -sticky w
5207     frame $top.buts
5208     button $top.buts.gen -text "Create" -command mktaggo
5209     button $top.buts.can -text "Cancel" -command mktagcan
5210     grid $top.buts.gen $top.buts.can
5211     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5212     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5213     grid $top.buts - -pady 10 -sticky ew
5214     focus $top.tag
5217 proc domktag {} {
5218     global mktagtop env tagids idtags
5220     set id [$mktagtop.sha1 get]
5221     set tag [$mktagtop.tag get]
5222     if {$tag == {}} {
5223         error_popup "No tag name specified"
5224         return
5225     }
5226     if {[info exists tagids($tag)]} {
5227         error_popup "Tag \"$tag\" already exists"
5228         return
5229     }
5230     if {[catch {
5231         set dir [gitdir]
5232         set fname [file join $dir "refs/tags" $tag]
5233         set f [open $fname w]
5234         puts $f $id
5235         close $f
5236     } err]} {
5237         error_popup "Error creating tag: $err"
5238         return
5239     }
5241     set tagids($tag) $id
5242     lappend idtags($id) $tag
5243     redrawtags $id
5244     addedtag $id
5247 proc redrawtags {id} {
5248     global canv linehtag commitrow idpos selectedline curview
5249     global mainfont canvxmax
5251     if {![info exists commitrow($curview,$id)]} return
5252     drawcmitrow $commitrow($curview,$id)
5253     $canv delete tag.$id
5254     set xt [eval drawtags $id $idpos($id)]
5255     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5256     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5257     set xr [expr {$xt + [font measure $mainfont $text]}]
5258     if {$xr > $canvxmax} {
5259         set canvxmax $xr
5260         setcanvscroll
5261     }
5262     if {[info exists selectedline]
5263         && $selectedline == $commitrow($curview,$id)} {
5264         selectline $selectedline 0
5265     }
5268 proc mktagcan {} {
5269     global mktagtop
5271     catch {destroy $mktagtop}
5272     unset mktagtop
5275 proc mktaggo {} {
5276     domktag
5277     mktagcan
5280 proc writecommit {} {
5281     global rowmenuid wrcomtop commitinfo wrcomcmd
5283     set top .writecommit
5284     set wrcomtop $top
5285     catch {destroy $top}
5286     toplevel $top
5287     label $top.title -text "Write commit to file"
5288     grid $top.title - -pady 10
5289     label $top.id -text "ID:"
5290     entry $top.sha1 -width 40 -relief flat
5291     $top.sha1 insert 0 $rowmenuid
5292     $top.sha1 conf -state readonly
5293     grid $top.id $top.sha1 -sticky w
5294     entry $top.head -width 60 -relief flat
5295     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5296     $top.head conf -state readonly
5297     grid x $top.head -sticky w
5298     label $top.clab -text "Command:"
5299     entry $top.cmd -width 60 -textvariable wrcomcmd
5300     grid $top.clab $top.cmd -sticky w -pady 10
5301     label $top.flab -text "Output file:"
5302     entry $top.fname -width 60
5303     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5304     grid $top.flab $top.fname -sticky w
5305     frame $top.buts
5306     button $top.buts.gen -text "Write" -command wrcomgo
5307     button $top.buts.can -text "Cancel" -command wrcomcan
5308     grid $top.buts.gen $top.buts.can
5309     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5310     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5311     grid $top.buts - -pady 10 -sticky ew
5312     focus $top.fname
5315 proc wrcomgo {} {
5316     global wrcomtop
5318     set id [$wrcomtop.sha1 get]
5319     set cmd "echo $id | [$wrcomtop.cmd get]"
5320     set fname [$wrcomtop.fname get]
5321     if {[catch {exec sh -c $cmd >$fname &} err]} {
5322         error_popup "Error writing commit: $err"
5323     }
5324     catch {destroy $wrcomtop}
5325     unset wrcomtop
5328 proc wrcomcan {} {
5329     global wrcomtop
5331     catch {destroy $wrcomtop}
5332     unset wrcomtop
5335 proc mkbranch {} {
5336     global rowmenuid mkbrtop
5338     set top .makebranch
5339     catch {destroy $top}
5340     toplevel $top
5341     label $top.title -text "Create new branch"
5342     grid $top.title - -pady 10
5343     label $top.id -text "ID:"
5344     entry $top.sha1 -width 40 -relief flat
5345     $top.sha1 insert 0 $rowmenuid
5346     $top.sha1 conf -state readonly
5347     grid $top.id $top.sha1 -sticky w
5348     label $top.nlab -text "Name:"
5349     entry $top.name -width 40
5350     grid $top.nlab $top.name -sticky w
5351     frame $top.buts
5352     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5353     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5354     grid $top.buts.go $top.buts.can
5355     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5356     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5357     grid $top.buts - -pady 10 -sticky ew
5358     focus $top.name
5361 proc mkbrgo {top} {
5362     global headids idheads
5364     set name [$top.name get]
5365     set id [$top.sha1 get]
5366     if {$name eq {}} {
5367         error_popup "Please specify a name for the new branch"
5368         return
5369     }
5370     catch {destroy $top}
5371     nowbusy newbranch
5372     update
5373     if {[catch {
5374         exec git branch $name $id
5375     } err]} {
5376         notbusy newbranch
5377         error_popup $err
5378     } else {
5379         set headids($name) $id
5380         lappend idheads($id) $name
5381         addedhead $id $name
5382         notbusy newbranch
5383         redrawtags $id
5384         dispneartags 0
5385     }
5388 proc cherrypick {} {
5389     global rowmenuid curview commitrow
5390     global mainhead
5392     set oldhead [exec git rev-parse HEAD]
5393     set dheads [descheads $rowmenuid]
5394     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5395         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5396                         included in branch $mainhead -- really re-apply it?"]
5397         if {!$ok} return
5398     }
5399     nowbusy cherrypick
5400     update
5401     # Unfortunately git-cherry-pick writes stuff to stderr even when
5402     # no error occurs, and exec takes that as an indication of error...
5403     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5404         notbusy cherrypick
5405         error_popup $err
5406         return
5407     }
5408     set newhead [exec git rev-parse HEAD]
5409     if {$newhead eq $oldhead} {
5410         notbusy cherrypick
5411         error_popup "No changes committed"
5412         return
5413     }
5414     addnewchild $newhead $oldhead
5415     if {[info exists commitrow($curview,$oldhead)]} {
5416         insertrow $commitrow($curview,$oldhead) $newhead
5417         if {$mainhead ne {}} {
5418             movehead $newhead $mainhead
5419             movedhead $newhead $mainhead
5420         }
5421         redrawtags $oldhead
5422         redrawtags $newhead
5423     }
5424     notbusy cherrypick
5427 # context menu for a head
5428 proc headmenu {x y id head} {
5429     global headmenuid headmenuhead headctxmenu
5431     set headmenuid $id
5432     set headmenuhead $head
5433     tk_popup $headctxmenu $x $y
5436 proc cobranch {} {
5437     global headmenuid headmenuhead mainhead headids
5439     # check the tree is clean first??
5440     set oldmainhead $mainhead
5441     nowbusy checkout
5442     update
5443     if {[catch {
5444         exec git checkout -q $headmenuhead
5445     } err]} {
5446         notbusy checkout
5447         error_popup $err
5448     } else {
5449         notbusy checkout
5450         set mainhead $headmenuhead
5451         if {[info exists headids($oldmainhead)]} {
5452             redrawtags $headids($oldmainhead)
5453         }
5454         redrawtags $headmenuid
5455     }
5458 proc rmbranch {} {
5459     global headmenuid headmenuhead mainhead
5460     global headids idheads
5462     set head $headmenuhead
5463     set id $headmenuid
5464     if {$head eq $mainhead} {
5465         error_popup "Cannot delete the currently checked-out branch"
5466         return
5467     }
5468     set dheads [descheads $id]
5469     if {$dheads eq $headids($head)} {
5470         # the stuff on this branch isn't on any other branch
5471         if {![confirm_popup "The commits on branch $head aren't on any other\
5472                         branch.\nReally delete branch $head?"]} return
5473     }
5474     nowbusy rmbranch
5475     update
5476     if {[catch {exec git branch -D $head} err]} {
5477         notbusy rmbranch
5478         error_popup $err
5479         return
5480     }
5481     removehead $id $head
5482     removedhead $id $head
5483     redrawtags $id
5484     notbusy rmbranch
5485     dispneartags 0
5488 # Stuff for finding nearby tags
5489 proc getallcommits {} {
5490     global allcommits allids nbmp nextarc seeds
5492     set allids {}
5493     set nbmp 0
5494     set nextarc 0
5495     set allcommits 0
5496     set seeds {}
5497     regetallcommits
5500 # Called when the graph might have changed
5501 proc regetallcommits {} {
5502     global allcommits seeds
5504     set cmd [concat | git rev-list --all --parents]
5505     foreach id $seeds {
5506         lappend cmd "^$id"
5507     }
5508     set fd [open $cmd r]
5509     fconfigure $fd -blocking 0
5510     incr allcommits
5511     nowbusy allcommits
5512     restartgetall $fd
5515 proc restartgetall {fd} {
5516     fileevent $fd readable [list getallclines $fd]
5519 # Since most commits have 1 parent and 1 child, we group strings of
5520 # such commits into "arcs" joining branch/merge points (BMPs), which
5521 # are commits that either don't have 1 parent or don't have 1 child.
5523 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
5524 # arcout(id) - outgoing arcs for BMP
5525 # arcids(a) - list of IDs on arc including end but not start
5526 # arcstart(a) - BMP ID at start of arc
5527 # arcend(a) - BMP ID at end of arc
5528 # growing(a) - arc a is still growing
5529 # arctags(a) - IDs out of arcids (excluding end) that have tags
5530 # archeads(a) - IDs out of arcids (excluding end) that have heads
5531 # The start of an arc is at the descendent end, so "incoming" means
5532 # coming from descendents, and "outgoing" means going towards ancestors.
5534 proc getallclines {fd} {
5535     global allids allparents allchildren idtags nextarc nbmp
5536     global arcnos arcids arctags arcout arcend arcstart archeads growing
5537     global seeds allcommits allcstart
5539     if {![info exists allcstart]} {
5540         set allcstart [clock clicks -milliseconds]
5541     }
5542     set nid 0
5543     while {[gets $fd line] >= 0} {
5544         set id [lindex $line 0]
5545         if {[info exists allparents($id)]} {
5546             # seen it already
5547             continue
5548         }
5549         lappend allids $id
5550         set olds [lrange $line 1 end]
5551         set allparents($id) $olds
5552         if {![info exists allchildren($id)]} {
5553             set allchildren($id) {}
5554             set arcnos($id) {}
5555             lappend seeds $id
5556         } else {
5557             set a $arcnos($id)
5558             if {[llength $olds] == 1 && [llength $a] == 1} {
5559                 lappend arcids($a) $id
5560                 if {[info exists idtags($id)]} {
5561                     lappend arctags($a) $id
5562                 }
5563                 if {[info exists idheads($id)]} {
5564                     lappend archeads($a) $id
5565                 }
5566                 if {[info exists allparents($olds)]} {
5567                     # seen parent already
5568                     if {![info exists arcout($olds)]} {
5569                         splitarc $olds
5570                     }
5571                     lappend arcids($a) $olds
5572                     set arcend($a) $olds
5573                     unset growing($a)
5574                 }
5575                 lappend allchildren($olds) $id
5576                 lappend arcnos($olds) $a
5577                 continue
5578             }
5579         }
5580         incr nbmp
5581         foreach a $arcnos($id) {
5582             lappend arcids($a) $id
5583             set arcend($a) $id
5584             unset growing($a)
5585         }
5587         set ao {}
5588         foreach p $olds {
5589             lappend allchildren($p) $id
5590             set a [incr nextarc]
5591             set arcstart($a) $id
5592             set archeads($a) {}
5593             set arctags($a) {}
5594             set archeads($a) {}
5595             set arcids($a) {}
5596             lappend ao $a
5597             set growing($a) 1
5598             if {[info exists allparents($p)]} {
5599                 # seen it already, may need to make a new branch
5600                 if {![info exists arcout($p)]} {
5601                     splitarc $p
5602                 }
5603                 lappend arcids($a) $p
5604                 set arcend($a) $p
5605                 unset growing($a)
5606             }
5607             lappend arcnos($p) $a
5608         }
5609         set arcout($id) $ao
5610         if {[incr nid] >= 50} {
5611             set nid 0
5612             if {[clock clicks -milliseconds] - $allcstart >= 50} {
5613                 fileevent $fd readable {}
5614                 after idle restartgetall $fd
5615                 unset allcstart
5616                 return
5617             }
5618         }
5619     }
5620     if {![eof $fd]} return
5621     close $fd
5622     if {[incr allcommits -1] == 0} {
5623         notbusy allcommits
5624     }
5625     dispneartags 0
5628 proc recalcarc {a} {
5629     global arctags archeads arcids idtags idheads
5631     set at {}
5632     set ah {}
5633     foreach id [lrange $arcids($a) 0 end-1] {
5634         if {[info exists idtags($id)]} {
5635             lappend at $id
5636         }
5637         if {[info exists idheads($id)]} {
5638             lappend ah $id
5639         }
5640     }
5641     set arctags($a) $at
5642     set archeads($a) $ah
5645 proc splitarc {p} {
5646     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
5647     global arcstart arcend arcout allparents growing
5649     set a $arcnos($p)
5650     if {[llength $a] != 1} {
5651         puts "oops splitarc called but [llength $a] arcs already"
5652         return
5653     }
5654     set a [lindex $a 0]
5655     set i [lsearch -exact $arcids($a) $p]
5656     if {$i < 0} {
5657         puts "oops splitarc $p not in arc $a"
5658         return
5659     }
5660     set na [incr nextarc]
5661     if {[info exists arcend($a)]} {
5662         set arcend($na) $arcend($a)
5663     } else {
5664         set l [lindex $allparents([lindex $arcids($a) end]) 0]
5665         set j [lsearch -exact $arcnos($l) $a]
5666         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
5667     }
5668     set tail [lrange $arcids($a) [expr {$i+1}] end]
5669     set arcids($a) [lrange $arcids($a) 0 $i]
5670     set arcend($a) $p
5671     set arcstart($na) $p
5672     set arcout($p) $na
5673     set arcids($na) $tail
5674     if {[info exists growing($a)]} {
5675         set growing($na) 1
5676         unset growing($a)
5677     }
5678     incr nbmp
5680     foreach id $tail {
5681         if {[llength $arcnos($id)] == 1} {
5682             set arcnos($id) $na
5683         } else {
5684             set j [lsearch -exact $arcnos($id) $a]
5685             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
5686         }
5687     }
5689     # reconstruct tags and heads lists
5690     if {$arctags($a) ne {} || $archeads($a) ne {}} {
5691         recalcarc $a
5692         recalcarc $na
5693     } else {
5694         set arctags($na) {}
5695         set archeads($na) {}
5696     }
5699 # Update things for a new commit added that is a child of one
5700 # existing commit.  Used when cherry-picking.
5701 proc addnewchild {id p} {
5702     global allids allparents allchildren idtags nextarc nbmp
5703     global arcnos arcids arctags arcout arcend arcstart archeads growing
5704     global seeds
5706     lappend allids $id
5707     set allparents($id) [list $p]
5708     set allchildren($id) {}
5709     set arcnos($id) {}
5710     lappend seeds $id
5711     incr nbmp
5712     lappend allchildren($p) $id
5713     set a [incr nextarc]
5714     set arcstart($a) $id
5715     set archeads($a) {}
5716     set arctags($a) {}
5717     set arcids($a) [list $p]
5718     set arcend($a) $p
5719     if {![info exists arcout($p)]} {
5720         splitarc $p
5721     }
5722     lappend arcnos($p) $a
5723     set arcout($id) [list $a]
5726 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
5727 # or 0 if neither is true.
5728 proc anc_or_desc {a b} {
5729     global arcout arcstart arcend arcnos cached_isanc
5731     if {$arcnos($a) eq $arcnos($b)} {
5732         # Both are on the same arc(s); either both are the same BMP,
5733         # or if one is not a BMP, the other is also not a BMP or is
5734         # the BMP at end of the arc (and it only has 1 incoming arc).
5735         if {$a eq $b} {
5736             return 0
5737         }
5738         # assert {[llength $arcnos($a)] == 1}
5739         set arc [lindex $arcnos($a) 0]
5740         set i [lsearch -exact $arcids($arc) $a]
5741         set j [lsearch -exact $arcids($arc) $b]
5742         if {$i < 0 || $i > $j} {
5743             return 1
5744         } else {
5745             return -1
5746         }
5747     }
5749     if {![info exists arcout($a)]} {
5750         set arc [lindex $arcnos($a) 0]
5751         if {[info exists arcend($arc)]} {
5752             set aend $arcend($arc)
5753         } else {
5754             set aend {}
5755         }
5756         set a $arcstart($arc)
5757     } else {
5758         set aend $a
5759     }
5760     if {![info exists arcout($b)]} {
5761         set arc [lindex $arcnos($b) 0]
5762         if {[info exists arcend($arc)]} {
5763             set bend $arcend($arc)
5764         } else {
5765             set bend {}
5766         }
5767         set b $arcstart($arc)
5768     } else {
5769         set bend $b
5770     }
5771     if {$a eq $bend} {
5772         return 1
5773     }
5774     if {$b eq $aend} {
5775         return -1
5776     }
5777     if {[info exists cached_isanc($a,$bend)]} {
5778         if {$cached_isanc($a,$bend)} {
5779             return 1
5780         }
5781     }
5782     if {[info exists cached_isanc($b,$aend)]} {
5783         if {$cached_isanc($b,$aend)} {
5784             return -1
5785         }
5786         if {[info exists cached_isanc($a,$bend)]} {
5787             return 0
5788         }
5789     }
5791     set todo [list $a $b]
5792     set anc($a) a
5793     set anc($b) b
5794     for {set i 0} {$i < [llength $todo]} {incr i} {
5795         set x [lindex $todo $i]
5796         if {$anc($x) eq {}} {
5797             continue
5798         }
5799         foreach arc $arcnos($x) {
5800             set xd $arcstart($arc)
5801             if {$xd eq $bend} {
5802                 set cached_isanc($a,$bend) 1
5803                 set cached_isanc($b,$aend) 0
5804                 return 1
5805             } elseif {$xd eq $aend} {
5806                 set cached_isanc($b,$aend) 1
5807                 set cached_isanc($a,$bend) 0
5808                 return -1
5809             }
5810             if {![info exists anc($xd)]} {
5811                 set anc($xd) $anc($x)
5812                 lappend todo $xd
5813             } elseif {$anc($xd) ne $anc($x)} {
5814                 set anc($xd) {}
5815             }
5816         }
5817     }
5818     set cached_isanc($a,$bend) 0
5819     set cached_isanc($b,$aend) 0
5820     return 0
5823 # This identifies whether $desc has an ancestor that is
5824 # a growing tip of the graph and which is not an ancestor of $anc
5825 # and returns 0 if so and 1 if not.
5826 # If we subsequently discover a tag on such a growing tip, and that
5827 # turns out to be a descendent of $anc (which it could, since we
5828 # don't necessarily see children before parents), then $desc
5829 # isn't a good choice to display as a descendent tag of
5830 # $anc (since it is the descendent of another tag which is
5831 # a descendent of $anc).  Similarly, $anc isn't a good choice to
5832 # display as a ancestor tag of $desc.
5834 proc is_certain {desc anc} {
5835     global arcnos arcout arcstart arcend growing problems
5837     set certain {}
5838     if {[llength $arcnos($anc)] == 1} {
5839         # tags on the same arc are certain
5840         if {$arcnos($desc) eq $arcnos($anc)} {
5841             return 1
5842         }
5843         if {![info exists arcout($anc)]} {
5844             # if $anc is partway along an arc, use the start of the arc instead
5845             set a [lindex $arcnos($anc) 0]
5846             set anc $arcstart($a)
5847         }
5848     }
5849     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
5850         set x $desc
5851     } else {
5852         set a [lindex $arcnos($desc) 0]
5853         set x $arcend($a)
5854     }
5855     if {$x == $anc} {
5856         return 1
5857     }
5858     set anclist [list $x]
5859     set dl($x) 1
5860     set nnh 1
5861     set ngrowanc 0
5862     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
5863         set x [lindex $anclist $i]
5864         if {$dl($x)} {
5865             incr nnh -1
5866         }
5867         set done($x) 1
5868         foreach a $arcout($x) {
5869             if {[info exists growing($a)]} {
5870                 if {![info exists growanc($x)] && $dl($x)} {
5871                     set growanc($x) 1
5872                     incr ngrowanc
5873                 }
5874             } else {
5875                 set y $arcend($a)
5876                 if {[info exists dl($y)]} {
5877                     if {$dl($y)} {
5878                         if {!$dl($x)} {
5879                             set dl($y) 0
5880                             if {![info exists done($y)]} {
5881                                 incr nnh -1
5882                             }
5883                             if {[info exists growanc($x)]} {
5884                                 incr ngrowanc -1
5885                             }
5886                             set xl [list $y]
5887                             for {set k 0} {$k < [llength $xl]} {incr k} {
5888                                 set z [lindex $xl $k]
5889                                 foreach c $arcout($z) {
5890                                     if {[info exists arcend($c)]} {
5891                                         set v $arcend($c)
5892                                         if {[info exists dl($v)] && $dl($v)} {
5893                                             set dl($v) 0
5894                                             if {![info exists done($v)]} {
5895                                                 incr nnh -1
5896                                             }
5897                                             if {[info exists growanc($v)]} {
5898                                                 incr ngrowanc -1
5899                                             }
5900                                             lappend xl $v
5901                                         }
5902                                     }
5903                                 }
5904                             }
5905                         }
5906                     }
5907                 } elseif {$y eq $anc || !$dl($x)} {
5908                     set dl($y) 0
5909                     lappend anclist $y
5910                 } else {
5911                     set dl($y) 1
5912                     lappend anclist $y
5913                     incr nnh
5914                 }
5915             }
5916         }
5917     }
5918     foreach x [array names growanc] {
5919         if {$dl($x)} {
5920             return 0
5921         }
5922     }
5923     return 1
5926 proc validate_arctags {a} {
5927     global arctags idtags
5929     set i -1
5930     set na $arctags($a)
5931     foreach id $arctags($a) {
5932         incr i
5933         if {![info exists idtags($id)]} {
5934             set na [lreplace $na $i $i]
5935             incr i -1
5936         }
5937     }
5938     set arctags($a) $na
5941 proc validate_archeads {a} {
5942     global archeads idheads
5944     set i -1
5945     set na $archeads($a)
5946     foreach id $archeads($a) {
5947         incr i
5948         if {![info exists idheads($id)]} {
5949             set na [lreplace $na $i $i]
5950             incr i -1
5951         }
5952     }
5953     set archeads($a) $na
5956 # Return the list of IDs that have tags that are descendents of id,
5957 # ignoring IDs that are descendents of IDs already reported.
5958 proc desctags {id} {
5959     global arcnos arcstart arcids arctags idtags allparents
5960     global growing cached_dtags
5962     if {![info exists allparents($id)]} {
5963         return {}
5964     }
5965     set t1 [clock clicks -milliseconds]
5966     set argid $id
5967     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
5968         # part-way along an arc; check that arc first
5969         set a [lindex $arcnos($id) 0]
5970         if {$arctags($a) ne {}} {
5971             validate_arctags $a
5972             set i [lsearch -exact $arcids($a) $id]
5973             set tid {}
5974             foreach t $arctags($a) {
5975                 set j [lsearch -exact $arcids($a) $t]
5976                 if {$j >= $i} break
5977                 set tid $t
5978             }
5979             if {$tid ne {}} {
5980                 return $tid
5981             }
5982         }
5983         set id $arcstart($a)
5984         if {[info exists idtags($id)]} {
5985             return $id
5986         }
5987     }
5988     if {[info exists cached_dtags($id)]} {
5989         return $cached_dtags($id)
5990     }
5992     set origid $id
5993     set todo [list $id]
5994     set queued($id) 1
5995     set nc 1
5996     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
5997         set id [lindex $todo $i]
5998         set done($id) 1
5999         set ta [info exists hastaggedancestor($id)]
6000         if {!$ta} {
6001             incr nc -1
6002         }
6003         # ignore tags on starting node
6004         if {!$ta && $i > 0} {
6005             if {[info exists idtags($id)]} {
6006                 set tagloc($id) $id
6007                 set ta 1
6008             } elseif {[info exists cached_dtags($id)]} {
6009                 set tagloc($id) $cached_dtags($id)
6010                 set ta 1
6011             }
6012         }
6013         foreach a $arcnos($id) {
6014             set d $arcstart($a)
6015             if {!$ta && $arctags($a) ne {}} {
6016                 validate_arctags $a
6017                 if {$arctags($a) ne {}} {
6018                     lappend tagloc($id) [lindex $arctags($a) end]
6019                 }
6020             }
6021             if {$ta || $arctags($a) ne {}} {
6022                 set tomark [list $d]
6023                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6024                     set dd [lindex $tomark $j]
6025                     if {![info exists hastaggedancestor($dd)]} {
6026                         if {[info exists done($dd)]} {
6027                             foreach b $arcnos($dd) {
6028                                 lappend tomark $arcstart($b)
6029                             }
6030                             if {[info exists tagloc($dd)]} {
6031                                 unset tagloc($dd)
6032                             }
6033                         } elseif {[info exists queued($dd)]} {
6034                             incr nc -1
6035                         }
6036                         set hastaggedancestor($dd) 1
6037                     }
6038                 }
6039             }
6040             if {![info exists queued($d)]} {
6041                 lappend todo $d
6042                 set queued($d) 1
6043                 if {![info exists hastaggedancestor($d)]} {
6044                     incr nc
6045                 }
6046             }
6047         }
6048     }
6049     set tags {}
6050     foreach id [array names tagloc] {
6051         if {![info exists hastaggedancestor($id)]} {
6052             foreach t $tagloc($id) {
6053                 if {[lsearch -exact $tags $t] < 0} {
6054                     lappend tags $t
6055                 }
6056             }
6057         }
6058     }
6059     set t2 [clock clicks -milliseconds]
6060     set loopix $i
6062     # remove tags that are descendents of other tags
6063     for {set i 0} {$i < [llength $tags]} {incr i} {
6064         set a [lindex $tags $i]
6065         for {set j 0} {$j < $i} {incr j} {
6066             set b [lindex $tags $j]
6067             set r [anc_or_desc $a $b]
6068             if {$r == 1} {
6069                 set tags [lreplace $tags $j $j]
6070                 incr j -1
6071                 incr i -1
6072             } elseif {$r == -1} {
6073                 set tags [lreplace $tags $i $i]
6074                 incr i -1
6075                 break
6076             }
6077         }
6078     }
6080     if {[array names growing] ne {}} {
6081         # graph isn't finished, need to check if any tag could get
6082         # eclipsed by another tag coming later.  Simply ignore any
6083         # tags that could later get eclipsed.
6084         set ctags {}
6085         foreach t $tags {
6086             if {[is_certain $t $origid]} {
6087                 lappend ctags $t
6088             }
6089         }
6090         if {$tags eq $ctags} {
6091             set cached_dtags($origid) $tags
6092         } else {
6093             set tags $ctags
6094         }
6095     } else {
6096         set cached_dtags($origid) $tags
6097     }
6098     set t3 [clock clicks -milliseconds]
6099     if {0 && $t3 - $t1 >= 100} {
6100         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6101             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6102     }
6103     return $tags
6106 proc anctags {id} {
6107     global arcnos arcids arcout arcend arctags idtags allparents
6108     global growing cached_atags
6110     if {![info exists allparents($id)]} {
6111         return {}
6112     }
6113     set t1 [clock clicks -milliseconds]
6114     set argid $id
6115     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6116         # part-way along an arc; check that arc first
6117         set a [lindex $arcnos($id) 0]
6118         if {$arctags($a) ne {}} {
6119             validate_arctags $a
6120             set i [lsearch -exact $arcids($a) $id]
6121             foreach t $arctags($a) {
6122                 set j [lsearch -exact $arcids($a) $t]
6123                 if {$j > $i} {
6124                     return $t
6125                 }
6126             }
6127         }
6128         if {![info exists arcend($a)]} {
6129             return {}
6130         }
6131         set id $arcend($a)
6132         if {[info exists idtags($id)]} {
6133             return $id
6134         }
6135     }
6136     if {[info exists cached_atags($id)]} {
6137         return $cached_atags($id)
6138     }
6140     set origid $id
6141     set todo [list $id]
6142     set queued($id) 1
6143     set taglist {}
6144     set nc 1
6145     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6146         set id [lindex $todo $i]
6147         set done($id) 1
6148         set td [info exists hastaggeddescendent($id)]
6149         if {!$td} {
6150             incr nc -1
6151         }
6152         # ignore tags on starting node
6153         if {!$td && $i > 0} {
6154             if {[info exists idtags($id)]} {
6155                 set tagloc($id) $id
6156                 set td 1
6157             } elseif {[info exists cached_atags($id)]} {
6158                 set tagloc($id) $cached_atags($id)
6159                 set td 1
6160             }
6161         }
6162         foreach a $arcout($id) {
6163             if {!$td && $arctags($a) ne {}} {
6164                 validate_arctags $a
6165                 if {$arctags($a) ne {}} {
6166                     lappend tagloc($id) [lindex $arctags($a) 0]
6167                 }
6168             }
6169             if {![info exists arcend($a)]} continue
6170             set d $arcend($a)
6171             if {$td || $arctags($a) ne {}} {
6172                 set tomark [list $d]
6173                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6174                     set dd [lindex $tomark $j]
6175                     if {![info exists hastaggeddescendent($dd)]} {
6176                         if {[info exists done($dd)]} {
6177                             foreach b $arcout($dd) {
6178                                 if {[info exists arcend($b)]} {
6179                                     lappend tomark $arcend($b)
6180                                 }
6181                             }
6182                             if {[info exists tagloc($dd)]} {
6183                                 unset tagloc($dd)
6184                             }
6185                         } elseif {[info exists queued($dd)]} {
6186                             incr nc -1
6187                         }
6188                         set hastaggeddescendent($dd) 1
6189                     }
6190                 }
6191             }
6192             if {![info exists queued($d)]} {
6193                 lappend todo $d
6194                 set queued($d) 1
6195                 if {![info exists hastaggeddescendent($d)]} {
6196                     incr nc
6197                 }
6198             }
6199         }
6200     }
6201     set t2 [clock clicks -milliseconds]
6202     set loopix $i
6203     set tags {}
6204     foreach id [array names tagloc] {
6205         if {![info exists hastaggeddescendent($id)]} {
6206             foreach t $tagloc($id) {
6207                 if {[lsearch -exact $tags $t] < 0} {
6208                     lappend tags $t
6209                 }
6210             }
6211         }
6212     }
6214     # remove tags that are ancestors of other tags
6215     for {set i 0} {$i < [llength $tags]} {incr i} {
6216         set a [lindex $tags $i]
6217         for {set j 0} {$j < $i} {incr j} {
6218             set b [lindex $tags $j]
6219             set r [anc_or_desc $a $b]
6220             if {$r == -1} {
6221                 set tags [lreplace $tags $j $j]
6222                 incr j -1
6223                 incr i -1
6224             } elseif {$r == 1} {
6225                 set tags [lreplace $tags $i $i]
6226                 incr i -1
6227                 break
6228             }
6229         }
6230     }
6232     if {[array names growing] ne {}} {
6233         # graph isn't finished, need to check if any tag could get
6234         # eclipsed by another tag coming later.  Simply ignore any
6235         # tags that could later get eclipsed.
6236         set ctags {}
6237         foreach t $tags {
6238             if {[is_certain $origid $t]} {
6239                 lappend ctags $t
6240             }
6241         }
6242         if {$tags eq $ctags} {
6243             set cached_atags($origid) $tags
6244         } else {
6245             set tags $ctags
6246         }
6247     } else {
6248         set cached_atags($origid) $tags
6249     }
6250     set t3 [clock clicks -milliseconds]
6251     if {0 && $t3 - $t1 >= 100} {
6252         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6253             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6254     }
6255     return $tags
6258 # Return the list of IDs that have heads that are descendents of id,
6259 # including id itself if it has a head.
6260 proc descheads {id} {
6261     global arcnos arcstart arcids archeads idheads cached_dheads
6262     global allparents
6264     if {![info exists allparents($id)]} {
6265         return {}
6266     }
6267     set ret {}
6268     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6269         # part-way along an arc; check it first
6270         set a [lindex $arcnos($id) 0]
6271         if {$archeads($a) ne {}} {
6272             validate_archeads $a
6273             set i [lsearch -exact $arcids($a) $id]
6274             foreach t $archeads($a) {
6275                 set j [lsearch -exact $arcids($a) $t]
6276                 if {$j > $i} break
6277                 lappend $ret $t
6278             }
6279         }
6280         set id $arcstart($a)
6281     }
6282     set origid $id
6283     set todo [list $id]
6284     set seen($id) 1
6285     for {set i 0} {$i < [llength $todo]} {incr i} {
6286         set id [lindex $todo $i]
6287         if {[info exists cached_dheads($id)]} {
6288             set ret [concat $ret $cached_dheads($id)]
6289         } else {
6290             if {[info exists idheads($id)]} {
6291                 lappend ret $id
6292             }
6293             foreach a $arcnos($id) {
6294                 if {$archeads($a) ne {}} {
6295                     set ret [concat $ret $archeads($a)]
6296                 }
6297                 set d $arcstart($a)
6298                 if {![info exists seen($d)]} {
6299                     lappend todo $d
6300                     set seen($d) 1
6301                 }
6302             }
6303         }
6304     }
6305     set ret [lsort -unique $ret]
6306     set cached_dheads($origid) $ret
6309 proc addedtag {id} {
6310     global arcnos arcout cached_dtags cached_atags
6312     if {![info exists arcnos($id)]} return
6313     if {![info exists arcout($id)]} {
6314         recalcarc [lindex $arcnos($id) 0]
6315     }
6316     catch {unset cached_dtags}
6317     catch {unset cached_atags}
6320 proc addedhead {hid head} {
6321     global arcnos arcout cached_dheads
6323     if {![info exists arcnos($hid)]} return
6324     if {![info exists arcout($hid)]} {
6325         recalcarc [lindex $arcnos($hid) 0]
6326     }
6327     catch {unset cached_dheads}
6330 proc removedhead {hid head} {
6331     global cached_dheads
6333     catch {unset cached_dheads}
6336 proc movedhead {hid head} {
6337     global arcnos arcout cached_dheads
6339     if {![info exists arcnos($hid)]} return
6340     if {![info exists arcout($hid)]} {
6341         recalcarc [lindex $arcnos($hid) 0]
6342     }
6343     catch {unset cached_dheads}
6346 proc changedrefs {} {
6347     global cached_dheads cached_dtags cached_atags
6348     global arctags archeads arcnos arcout idheads idtags
6350     foreach id [concat [array names idheads] [array names idtags]] {
6351         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
6352             set a [lindex $arcnos($id) 0]
6353             if {![info exists donearc($a)]} {
6354                 recalcarc $a
6355                 set donearc($a) 1
6356             }
6357         }
6358     }
6359     catch {unset cached_dtags}
6360     catch {unset cached_atags}
6361     catch {unset cached_dheads}
6364 proc rereadrefs {} {
6365     global idtags idheads idotherrefs mainhead
6367     set refids [concat [array names idtags] \
6368                     [array names idheads] [array names idotherrefs]]
6369     foreach id $refids {
6370         if {![info exists ref($id)]} {
6371             set ref($id) [listrefs $id]
6372         }
6373     }
6374     set oldmainhead $mainhead
6375     readrefs
6376     changedrefs
6377     set refids [lsort -unique [concat $refids [array names idtags] \
6378                         [array names idheads] [array names idotherrefs]]]
6379     foreach id $refids {
6380         set v [listrefs $id]
6381         if {![info exists ref($id)] || $ref($id) != $v ||
6382             ($id eq $oldmainhead && $id ne $mainhead) ||
6383             ($id eq $mainhead && $id ne $oldmainhead)} {
6384             redrawtags $id
6385         }
6386     }
6389 proc listrefs {id} {
6390     global idtags idheads idotherrefs
6392     set x {}
6393     if {[info exists idtags($id)]} {
6394         set x $idtags($id)
6395     }
6396     set y {}
6397     if {[info exists idheads($id)]} {
6398         set y $idheads($id)
6399     }
6400     set z {}
6401     if {[info exists idotherrefs($id)]} {
6402         set z $idotherrefs($id)
6403     }
6404     return [list $x $y $z]
6407 proc showtag {tag isnew} {
6408     global ctext tagcontents tagids linknum
6410     if {$isnew} {
6411         addtohistory [list showtag $tag 0]
6412     }
6413     $ctext conf -state normal
6414     clear_ctext
6415     set linknum 0
6416     if {[info exists tagcontents($tag)]} {
6417         set text $tagcontents($tag)
6418     } else {
6419         set text "Tag: $tag\nId:  $tagids($tag)"
6420     }
6421     appendwithlinks $text {}
6422     $ctext conf -state disabled
6423     init_flist {}
6426 proc doquit {} {
6427     global stopped
6428     set stopped 100
6429     savestuff .
6430     destroy .
6433 proc doprefs {} {
6434     global maxwidth maxgraphpct diffopts
6435     global oldprefs prefstop showneartags
6436     global bgcolor fgcolor ctext diffcolors selectbgcolor
6437     global uifont tabstop
6439     set top .gitkprefs
6440     set prefstop $top
6441     if {[winfo exists $top]} {
6442         raise $top
6443         return
6444     }
6445     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6446         set oldprefs($v) [set $v]
6447     }
6448     toplevel $top
6449     wm title $top "Gitk preferences"
6450     label $top.ldisp -text "Commit list display options"
6451     $top.ldisp configure -font $uifont
6452     grid $top.ldisp - -sticky w -pady 10
6453     label $top.spacer -text " "
6454     label $top.maxwidthl -text "Maximum graph width (lines)" \
6455         -font optionfont
6456     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
6457     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
6458     label $top.maxpctl -text "Maximum graph width (% of pane)" \
6459         -font optionfont
6460     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
6461     grid x $top.maxpctl $top.maxpct -sticky w
6463     label $top.ddisp -text "Diff display options"
6464     $top.ddisp configure -font $uifont
6465     grid $top.ddisp - -sticky w -pady 10
6466     label $top.diffoptl -text "Options for diff program" \
6467         -font optionfont
6468     entry $top.diffopt -width 20 -textvariable diffopts
6469     grid x $top.diffoptl $top.diffopt -sticky w
6470     frame $top.ntag
6471     label $top.ntag.l -text "Display nearby tags" -font optionfont
6472     checkbutton $top.ntag.b -variable showneartags
6473     pack $top.ntag.b $top.ntag.l -side left
6474     grid x $top.ntag -sticky w
6475     label $top.tabstopl -text "tabstop" -font optionfont
6476     entry $top.tabstop -width 10 -textvariable tabstop
6477     grid x $top.tabstopl $top.tabstop -sticky w
6479     label $top.cdisp -text "Colors: press to choose"
6480     $top.cdisp configure -font $uifont
6481     grid $top.cdisp - -sticky w -pady 10
6482     label $top.bg -padx 40 -relief sunk -background $bgcolor
6483     button $top.bgbut -text "Background" -font optionfont \
6484         -command [list choosecolor bgcolor 0 $top.bg background setbg]
6485     grid x $top.bgbut $top.bg -sticky w
6486     label $top.fg -padx 40 -relief sunk -background $fgcolor
6487     button $top.fgbut -text "Foreground" -font optionfont \
6488         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
6489     grid x $top.fgbut $top.fg -sticky w
6490     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
6491     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
6492         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
6493                       [list $ctext tag conf d0 -foreground]]
6494     grid x $top.diffoldbut $top.diffold -sticky w
6495     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
6496     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
6497         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
6498                       [list $ctext tag conf d1 -foreground]]
6499     grid x $top.diffnewbut $top.diffnew -sticky w
6500     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
6501     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
6502         -command [list choosecolor diffcolors 2 $top.hunksep \
6503                       "diff hunk header" \
6504                       [list $ctext tag conf hunksep -foreground]]
6505     grid x $top.hunksepbut $top.hunksep -sticky w
6506     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
6507     button $top.selbgbut -text "Select bg" -font optionfont \
6508         -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
6509     grid x $top.selbgbut $top.selbgsep -sticky w
6511     frame $top.buts
6512     button $top.buts.ok -text "OK" -command prefsok -default active
6513     $top.buts.ok configure -font $uifont
6514     button $top.buts.can -text "Cancel" -command prefscan -default normal
6515     $top.buts.can configure -font $uifont
6516     grid $top.buts.ok $top.buts.can
6517     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6518     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6519     grid $top.buts - - -pady 10 -sticky ew
6520     bind $top <Visibility> "focus $top.buts.ok"
6523 proc choosecolor {v vi w x cmd} {
6524     global $v
6526     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
6527                -title "Gitk: choose color for $x"]
6528     if {$c eq {}} return
6529     $w conf -background $c
6530     lset $v $vi $c
6531     eval $cmd $c
6534 proc setselbg {c} {
6535     global bglist cflist
6536     foreach w $bglist {
6537         $w configure -selectbackground $c
6538     }
6539     $cflist tag configure highlight \
6540         -background [$cflist cget -selectbackground]
6541     allcanvs itemconf secsel -fill $c
6544 proc setbg {c} {
6545     global bglist
6547     foreach w $bglist {
6548         $w conf -background $c
6549     }
6552 proc setfg {c} {
6553     global fglist canv
6555     foreach w $fglist {
6556         $w conf -foreground $c
6557     }
6558     allcanvs itemconf text -fill $c
6559     $canv itemconf circle -outline $c
6562 proc prefscan {} {
6563     global maxwidth maxgraphpct diffopts
6564     global oldprefs prefstop showneartags
6566     foreach v {maxwidth maxgraphpct diffopts showneartags} {
6567         set $v $oldprefs($v)
6568     }
6569     catch {destroy $prefstop}
6570     unset prefstop
6573 proc prefsok {} {
6574     global maxwidth maxgraphpct
6575     global oldprefs prefstop showneartags
6576     global charspc ctext tabstop
6578     catch {destroy $prefstop}
6579     unset prefstop
6580     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
6581     if {$maxwidth != $oldprefs(maxwidth)
6582         || $maxgraphpct != $oldprefs(maxgraphpct)} {
6583         redisplay
6584     } elseif {$showneartags != $oldprefs(showneartags)} {
6585         reselectline
6586     }
6589 proc formatdate {d} {
6590     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6593 # This list of encoding names and aliases is distilled from
6594 # http://www.iana.org/assignments/character-sets.
6595 # Not all of them are supported by Tcl.
6596 set encoding_aliases {
6597     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6598       ISO646-US US-ASCII us IBM367 cp367 csASCII }
6599     { ISO-10646-UTF-1 csISO10646UTF1 }
6600     { ISO_646.basic:1983 ref csISO646basic1983 }
6601     { INVARIANT csINVARIANT }
6602     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6603     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6604     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6605     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6606     { NATS-DANO iso-ir-9-1 csNATSDANO }
6607     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6608     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6609     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6610     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6611     { ISO-2022-KR csISO2022KR }
6612     { EUC-KR csEUCKR }
6613     { ISO-2022-JP csISO2022JP }
6614     { ISO-2022-JP-2 csISO2022JP2 }
6615     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6616       csISO13JISC6220jp }
6617     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6618     { IT iso-ir-15 ISO646-IT csISO15Italian }
6619     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6620     { ES iso-ir-17 ISO646-ES csISO17Spanish }
6621     { greek7-old iso-ir-18 csISO18Greek7Old }
6622     { latin-greek iso-ir-19 csISO19LatinGreek }
6623     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6624     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6625     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6626     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6627     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6628     { BS_viewdata iso-ir-47 csISO47BSViewdata }
6629     { INIS iso-ir-49 csISO49INIS }
6630     { INIS-8 iso-ir-50 csISO50INIS8 }
6631     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6632     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6633     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6634     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6635     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6636     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6637       csISO60Norwegian1 }
6638     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6639     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6640     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6641     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6642     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6643     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6644     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6645     { greek7 iso-ir-88 csISO88Greek7 }
6646     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6647     { iso-ir-90 csISO90 }
6648     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6649     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6650       csISO92JISC62991984b }
6651     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6652     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6653     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6654       csISO95JIS62291984handadd }
6655     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6656     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6657     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6658     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6659       CP819 csISOLatin1 }
6660     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6661     { T.61-7bit iso-ir-102 csISO102T617bit }
6662     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6663     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6664     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6665     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6666     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6667     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6668     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6669     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6670       arabic csISOLatinArabic }
6671     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6672     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6673     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6674       greek greek8 csISOLatinGreek }
6675     { T.101-G2 iso-ir-128 csISO128T101G2 }
6676     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6677       csISOLatinHebrew }
6678     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6679     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6680     { CSN_369103 iso-ir-139 csISO139CSN369103 }
6681     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6682     { ISO_6937-2-add iso-ir-142 csISOTextComm }
6683     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6684     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6685       csISOLatinCyrillic }
6686     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6687     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6688     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6689     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6690     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6691     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6692     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6693     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6694     { ISO_10367-box iso-ir-155 csISO10367Box }
6695     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6696     { latin-lap lap iso-ir-158 csISO158Lap }
6697     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6698     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6699     { us-dk csUSDK }
6700     { dk-us csDKUS }
6701     { JIS_X0201 X0201 csHalfWidthKatakana }
6702     { KSC5636 ISO646-KR csKSC5636 }
6703     { ISO-10646-UCS-2 csUnicode }
6704     { ISO-10646-UCS-4 csUCS4 }
6705     { DEC-MCS dec csDECMCS }
6706     { hp-roman8 roman8 r8 csHPRoman8 }
6707     { macintosh mac csMacintosh }
6708     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6709       csIBM037 }
6710     { IBM038 EBCDIC-INT cp038 csIBM038 }
6711     { IBM273 CP273 csIBM273 }
6712     { IBM274 EBCDIC-BE CP274 csIBM274 }
6713     { IBM275 EBCDIC-BR cp275 csIBM275 }
6714     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6715     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6716     { IBM280 CP280 ebcdic-cp-it csIBM280 }
6717     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6718     { IBM284 CP284 ebcdic-cp-es csIBM284 }
6719     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6720     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6721     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6722     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6723     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6724     { IBM424 cp424 ebcdic-cp-he csIBM424 }
6725     { IBM437 cp437 437 csPC8CodePage437 }
6726     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6727     { IBM775 cp775 csPC775Baltic }
6728     { IBM850 cp850 850 csPC850Multilingual }
6729     { IBM851 cp851 851 csIBM851 }
6730     { IBM852 cp852 852 csPCp852 }
6731     { IBM855 cp855 855 csIBM855 }
6732     { IBM857 cp857 857 csIBM857 }
6733     { IBM860 cp860 860 csIBM860 }
6734     { IBM861 cp861 861 cp-is csIBM861 }
6735     { IBM862 cp862 862 csPC862LatinHebrew }
6736     { IBM863 cp863 863 csIBM863 }
6737     { IBM864 cp864 csIBM864 }
6738     { IBM865 cp865 865 csIBM865 }
6739     { IBM866 cp866 866 csIBM866 }
6740     { IBM868 CP868 cp-ar csIBM868 }
6741     { IBM869 cp869 869 cp-gr csIBM869 }
6742     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6743     { IBM871 CP871 ebcdic-cp-is csIBM871 }
6744     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6745     { IBM891 cp891 csIBM891 }
6746     { IBM903 cp903 csIBM903 }
6747     { IBM904 cp904 904 csIBBM904 }
6748     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6749     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6750     { IBM1026 CP1026 csIBM1026 }
6751     { EBCDIC-AT-DE csIBMEBCDICATDE }
6752     { EBCDIC-AT-DE-A csEBCDICATDEA }
6753     { EBCDIC-CA-FR csEBCDICCAFR }
6754     { EBCDIC-DK-NO csEBCDICDKNO }
6755     { EBCDIC-DK-NO-A csEBCDICDKNOA }
6756     { EBCDIC-FI-SE csEBCDICFISE }
6757     { EBCDIC-FI-SE-A csEBCDICFISEA }
6758     { EBCDIC-FR csEBCDICFR }
6759     { EBCDIC-IT csEBCDICIT }
6760     { EBCDIC-PT csEBCDICPT }
6761     { EBCDIC-ES csEBCDICES }
6762     { EBCDIC-ES-A csEBCDICESA }
6763     { EBCDIC-ES-S csEBCDICESS }
6764     { EBCDIC-UK csEBCDICUK }
6765     { EBCDIC-US csEBCDICUS }
6766     { UNKNOWN-8BIT csUnknown8BiT }
6767     { MNEMONIC csMnemonic }
6768     { MNEM csMnem }
6769     { VISCII csVISCII }
6770     { VIQR csVIQR }
6771     { KOI8-R csKOI8R }
6772     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6773     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6774     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6775     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6776     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6777     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6778     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6779     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6780     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6781     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6782     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6783     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6784     { IBM1047 IBM-1047 }
6785     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6786     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6787     { UNICODE-1-1 csUnicode11 }
6788     { CESU-8 csCESU-8 }
6789     { BOCU-1 csBOCU-1 }
6790     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6791     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6792       l8 }
6793     { ISO-8859-15 ISO_8859-15 Latin-9 }
6794     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6795     { GBK CP936 MS936 windows-936 }
6796     { JIS_Encoding csJISEncoding }
6797     { Shift_JIS MS_Kanji csShiftJIS }
6798     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6799       EUC-JP }
6800     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6801     { ISO-10646-UCS-Basic csUnicodeASCII }
6802     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6803     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6804     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6805     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6806     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6807     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6808     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6809     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6810     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6811     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6812     { Adobe-Standard-Encoding csAdobeStandardEncoding }
6813     { Ventura-US csVenturaUS }
6814     { Ventura-International csVenturaInternational }
6815     { PC8-Danish-Norwegian csPC8DanishNorwegian }
6816     { PC8-Turkish csPC8Turkish }
6817     { IBM-Symbols csIBMSymbols }
6818     { IBM-Thai csIBMThai }
6819     { HP-Legal csHPLegal }
6820     { HP-Pi-font csHPPiFont }
6821     { HP-Math8 csHPMath8 }
6822     { Adobe-Symbol-Encoding csHPPSMath }
6823     { HP-DeskTop csHPDesktop }
6824     { Ventura-Math csVenturaMath }
6825     { Microsoft-Publishing csMicrosoftPublishing }
6826     { Windows-31J csWindows31J }
6827     { GB2312 csGB2312 }
6828     { Big5 csBig5 }
6831 proc tcl_encoding {enc} {
6832     global encoding_aliases
6833     set names [encoding names]
6834     set lcnames [string tolower $names]
6835     set enc [string tolower $enc]
6836     set i [lsearch -exact $lcnames $enc]
6837     if {$i < 0} {
6838         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6839         if {[regsub {^iso[-_]} $enc iso encx]} {
6840             set i [lsearch -exact $lcnames $encx]
6841         }
6842     }
6843     if {$i < 0} {
6844         foreach l $encoding_aliases {
6845             set ll [string tolower $l]
6846             if {[lsearch -exact $ll $enc] < 0} continue
6847             # look through the aliases for one that tcl knows about
6848             foreach e $ll {
6849                 set i [lsearch -exact $lcnames $e]
6850                 if {$i < 0} {
6851                     if {[regsub {^iso[-_]} $e iso ex]} {
6852                         set i [lsearch -exact $lcnames $ex]
6853                     }
6854                 }
6855                 if {$i >= 0} break
6856             }
6857             break
6858         }
6859     }
6860     if {$i >= 0} {
6861         return [lindex $names $i]
6862     }
6863     return {}
6866 # defaults...
6867 set datemode 0
6868 set diffopts "-U 5 -p"
6869 set wrcomcmd "git diff-tree --stdin -p --pretty"
6871 set gitencoding {}
6872 catch {
6873     set gitencoding [exec git config --get i18n.commitencoding]
6875 if {$gitencoding == ""} {
6876     set gitencoding "utf-8"
6878 set tclencoding [tcl_encoding $gitencoding]
6879 if {$tclencoding == {}} {
6880     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6883 set mainfont {Helvetica 9}
6884 set textfont {Courier 9}
6885 set uifont {Helvetica 9 bold}
6886 set tabstop 8
6887 set findmergefiles 0
6888 set maxgraphpct 50
6889 set maxwidth 16
6890 set revlistorder 0
6891 set fastdate 0
6892 set uparrowlen 7
6893 set downarrowlen 7
6894 set mingaplen 30
6895 set cmitmode "patch"
6896 set wrapcomment "none"
6897 set showneartags 1
6898 set maxrefs 20
6900 set colors {green red blue magenta darkgrey brown orange}
6901 set bgcolor white
6902 set fgcolor black
6903 set diffcolors {red "#00a000" blue}
6904 set selectbgcolor gray85
6906 catch {source ~/.gitk}
6908 font create optionfont -family sans-serif -size -12
6910 set revtreeargs {}
6911 foreach arg $argv {
6912     switch -regexp -- $arg {
6913         "^$" { }
6914         "^-d" { set datemode 1 }
6915         default {
6916             lappend revtreeargs $arg
6917         }
6918     }
6921 # check that we can find a .git directory somewhere...
6922 set gitdir [gitdir]
6923 if {![file isdirectory $gitdir]} {
6924     show_error {} . "Cannot find the git directory \"$gitdir\"."
6925     exit 1
6928 set cmdline_files {}
6929 set i [lsearch -exact $revtreeargs "--"]
6930 if {$i >= 0} {
6931     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6932     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6933 } elseif {$revtreeargs ne {}} {
6934     if {[catch {
6935         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6936         set cmdline_files [split $f "\n"]
6937         set n [llength $cmdline_files]
6938         set revtreeargs [lrange $revtreeargs 0 end-$n]
6939     } err]} {
6940         # unfortunately we get both stdout and stderr in $err,
6941         # so look for "fatal:".
6942         set i [string first "fatal:" $err]
6943         if {$i > 0} {
6944             set err [string range $err [expr {$i + 6}] end]
6945         }
6946         show_error {} . "Bad arguments to gitk:\n$err"
6947         exit 1
6948     }
6951 set history {}
6952 set historyindex 0
6953 set fh_serial 0
6954 set nhl_names {}
6955 set highlight_paths {}
6956 set searchdirn -forwards
6957 set boldrows {}
6958 set boldnamerows {}
6959 set diffelide {0 0}
6961 set optim_delay 16
6963 set nextviewnum 1
6964 set curview 0
6965 set selectedview 0
6966 set selectedhlview None
6967 set viewfiles(0) {}
6968 set viewperm(0) 0
6969 set viewargs(0) {}
6971 set cmdlineok 0
6972 set stopped 0
6973 set stuffsaved 0
6974 set patchnum 0
6975 setcoords
6976 makewindow
6977 wm title . "[file tail $argv0]: [file tail [pwd]]"
6978 readrefs
6980 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6981     # create a view for the files/dirs specified on the command line
6982     set curview 1
6983     set selectedview 1
6984     set nextviewnum 2
6985     set viewname(1) "Command line"
6986     set viewfiles(1) $cmdline_files
6987     set viewargs(1) $revtreeargs
6988     set viewperm(1) 0
6989     addviewmenu 1
6990     .bar.view entryconf Edit* -state normal
6991     .bar.view entryconf Delete* -state normal
6994 if {[info exists permviews]} {
6995     foreach v $permviews {
6996         set n $nextviewnum
6997         incr nextviewnum
6998         set viewname($n) [lindex $v 0]
6999         set viewfiles($n) [lindex $v 1]
7000         set viewargs($n) [lindex $v 2]
7001         set viewperm($n) 1
7002         addviewmenu $n
7003     }
7005 getcommits