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