gitk: Highlight entries in the file list as well
[git.git] / gitk
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
5 # Copyright (C) 2005 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 ".git"
16     }
17 }
18
19 proc start_rev_list {view} {
20     global startmsecs nextupdate ncmupdate
21     global commfd leftover tclencoding datemode
22     global viewargs viewfiles commitidx
23
24     set startmsecs [clock clicks -milliseconds]
25     set nextupdate [expr {$startmsecs + 100}]
26     set ncmupdate 1
27     set commitidx($view) 0
28     set args $viewargs($view)
29     if {$viewfiles($view) ne {}} {
30         set args [concat $args "--" $viewfiles($view)]
31     }
32     set order "--topo-order"
33     if {$datemode} {
34         set order "--date-order"
35     }
36     if {[catch {
37         set fd [open [concat | git-rev-list --header $order \
38                           --parents --boundary --default HEAD $args] r]
39     } err]} {
40         puts stderr "Error executing git-rev-list: $err"
41         exit 1
42     }
43     set commfd($view) $fd
44     set leftover($view) {}
45     fconfigure $fd -blocking 0 -translation lf
46     if {$tclencoding != {}} {
47         fconfigure $fd -encoding $tclencoding
48     }
49     fileevent $fd readable [list getcommitlines $fd $view]
50     nowbusy $view
51 }
52
53 proc stop_rev_list {} {
54     global commfd curview
55
56     if {![info exists commfd($curview)]} return
57     set fd $commfd($curview)
58     catch {
59         set pid [pid $fd]
60         exec kill $pid
61     }
62     catch {close $fd}
63     unset commfd($curview)
64 }
65
66 proc getcommits {} {
67     global phase canv mainfont curview
68
69     set phase getcommits
70     initlayout
71     start_rev_list $curview
72     show_status "Reading commits..."
73 }
74
75 proc getcommitlines {fd view}  {
76     global commitlisted nextupdate
77     global leftover commfd
78     global displayorder commitidx commitrow commitdata
79     global parentlist childlist children curview hlview
80     global vparentlist vchildlist vdisporder vcmitlisted
81
82     set stuff [read $fd]
83     if {$stuff == {}} {
84         if {![eof $fd]} return
85         global viewname
86         unset commfd($view)
87         notbusy $view
88         # set it blocking so we wait for the process to terminate
89         fconfigure $fd -blocking 1
90         if {[catch {close $fd} err]} {
91             set fv {}
92             if {$view != $curview} {
93                 set fv " for the \"$viewname($view)\" view"
94             }
95             if {[string range $err 0 4] == "usage"} {
96                 set err "Gitk: error reading commits$fv:\
97                         bad arguments to git-rev-list."
98                 if {$viewname($view) eq "Command line"} {
99                     append err \
100                         "  (Note: arguments to gitk are passed to git-rev-list\
101                          to allow selection of commits to be displayed.)"
102                 }
103             } else {
104                 set err "Error reading commits$fv: $err"
105             }
106             error_popup $err
107         }
108         if {$view == $curview} {
109             after idle finishcommits
110         }
111         return
112     }
113     set start 0
114     set gotsome 0
115     while 1 {
116         set i [string first "\0" $stuff $start]
117         if {$i < 0} {
118             append leftover($view) [string range $stuff $start end]
119             break
120         }
121         if {$start == 0} {
122             set cmit $leftover($view)
123             append cmit [string range $stuff 0 [expr {$i - 1}]]
124             set leftover($view) {}
125         } else {
126             set cmit [string range $stuff $start [expr {$i - 1}]]
127         }
128         set start [expr {$i + 1}]
129         set j [string first "\n" $cmit]
130         set ok 0
131         set listed 1
132         if {$j >= 0} {
133             set ids [string range $cmit 0 [expr {$j - 1}]]
134             if {[string range $ids 0 0] == "-"} {
135                 set listed 0
136                 set ids [string range $ids 1 end]
137             }
138             set ok 1
139             foreach id $ids {
140                 if {[string length $id] != 40} {
141                     set ok 0
142                     break
143                 }
144             }
145         }
146         if {!$ok} {
147             set shortcmit $cmit
148             if {[string length $shortcmit] > 80} {
149                 set shortcmit "[string range $shortcmit 0 80]..."
150             }
151             error_popup "Can't parse git-rev-list output: {$shortcmit}"
152             exit 1
153         }
154         set id [lindex $ids 0]
155         if {$listed} {
156             set olds [lrange $ids 1 end]
157             set i 0
158             foreach p $olds {
159                 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160                     lappend children($view,$p) $id
161                 }
162                 incr i
163             }
164         } else {
165             set olds {}
166         }
167         if {![info exists children($view,$id)]} {
168             set children($view,$id) {}
169         }
170         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
171         set commitrow($view,$id) $commitidx($view)
172         incr commitidx($view)
173         if {$view == $curview} {
174             lappend parentlist $olds
175             lappend childlist $children($view,$id)
176             lappend displayorder $id
177             lappend commitlisted $listed
178         } else {
179             lappend vparentlist($view) $olds
180             lappend vchildlist($view) $children($view,$id)
181             lappend vdisporder($view) $id
182             lappend vcmitlisted($view) $listed
183         }
184         set gotsome 1
185     }
186     if {$gotsome} {
187         if {$view == $curview} {
188             layoutmore
189         } elseif {[info exists hlview] && $view == $hlview} {
190             vhighlightmore
191         }
192     }
193     if {[clock clicks -milliseconds] >= $nextupdate} {
194         doupdate
195     }
196 }
197
198 proc doupdate {} {
199     global commfd nextupdate numcommits ncmupdate
200
201     foreach v [array names commfd] {
202         fileevent $commfd($v) readable {}
203     }
204     update
205     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
206     if {$numcommits < 100} {
207         set ncmupdate [expr {$numcommits + 1}]
208     } elseif {$numcommits < 10000} {
209         set ncmupdate [expr {$numcommits + 10}]
210     } else {
211         set ncmupdate [expr {$numcommits + 100}]
212     }
213     foreach v [array names commfd] {
214         set fd $commfd($v)
215         fileevent $fd readable [list getcommitlines $fd $v]
216     }
217 }
218
219 proc readcommit {id} {
220     if {[catch {set contents [exec git-cat-file commit $id]}]} return
221     parsecommit $id $contents 0
222 }
223
224 proc updatecommits {} {
225     global viewdata curview phase displayorder
226     global children commitrow selectedline thickerline
227
228     if {$phase ne {}} {
229         stop_rev_list
230         set phase {}
231     }
232     set n $curview
233     foreach id $displayorder {
234         catch {unset children($n,$id)}
235         catch {unset commitrow($n,$id)}
236     }
237     set curview -1
238     catch {unset selectedline}
239     catch {unset thickerline}
240     catch {unset viewdata($n)}
241     readrefs
242     showview $n
243 }
244
245 proc parsecommit {id contents listed} {
246     global commitinfo cdate
247
248     set inhdr 1
249     set comment {}
250     set headline {}
251     set auname {}
252     set audate {}
253     set comname {}
254     set comdate {}
255     set hdrend [string first "\n\n" $contents]
256     if {$hdrend < 0} {
257         # should never happen...
258         set hdrend [string length $contents]
259     }
260     set header [string range $contents 0 [expr {$hdrend - 1}]]
261     set comment [string range $contents [expr {$hdrend + 2}] end]
262     foreach line [split $header "\n"] {
263         set tag [lindex $line 0]
264         if {$tag == "author"} {
265             set audate [lindex $line end-1]
266             set auname [lrange $line 1 end-2]
267         } elseif {$tag == "committer"} {
268             set comdate [lindex $line end-1]
269             set comname [lrange $line 1 end-2]
270         }
271     }
272     set headline {}
273     # take the first line of the comment as the headline
274     set i [string first "\n" $comment]
275     if {$i >= 0} {
276         set headline [string trim [string range $comment 0 $i]]
277     } else {
278         set headline $comment
279     }
280     if {!$listed} {
281         # git-rev-list indents the comment by 4 spaces;
282         # if we got this via git-cat-file, add the indentation
283         set newcomment {}
284         foreach line [split $comment "\n"] {
285             append newcomment "    "
286             append newcomment $line
287             append newcomment "\n"
288         }
289         set comment $newcomment
290     }
291     if {$comdate != {}} {
292         set cdate($id) $comdate
293     }
294     set commitinfo($id) [list $headline $auname $audate \
295                              $comname $comdate $comment]
296 }
297
298 proc getcommit {id} {
299     global commitdata commitinfo
300
301     if {[info exists commitdata($id)]} {
302         parsecommit $id $commitdata($id) 1
303     } else {
304         readcommit $id
305         if {![info exists commitinfo($id)]} {
306             set commitinfo($id) {"No commit information available"}
307         }
308     }
309     return 1
310 }
311
312 proc readrefs {} {
313     global tagids idtags headids idheads tagcontents
314     global otherrefids idotherrefs
315
316     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
317         catch {unset $v}
318     }
319     set refd [open [list | git ls-remote [gitdir]] r]
320     while {0 <= [set n [gets $refd line]]} {
321         if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
322             match id path]} {
323             continue
324         }
325         if {[regexp {^remotes/.*/HEAD$} $path match]} {
326             continue
327         }
328         if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
329             set type others
330             set name $path
331         }
332         if {[regexp {^remotes/} $path match]} {
333             set type heads
334         }
335         if {$type == "tags"} {
336             set tagids($name) $id
337             lappend idtags($id) $name
338             set obj {}
339             set type {}
340             set tag {}
341             catch {
342                 set commit [exec git-rev-parse "$id^0"]
343                 if {"$commit" != "$id"} {
344                     set tagids($name) $commit
345                     lappend idtags($commit) $name
346                 }
347             }           
348             catch {
349                 set tagcontents($name) [exec git-cat-file tag "$id"]
350             }
351         } elseif { $type == "heads" } {
352             set headids($name) $id
353             lappend idheads($id) $name
354         } else {
355             set otherrefids($name) $id
356             lappend idotherrefs($id) $name
357         }
358     }
359     close $refd
360 }
361
362 proc show_error {w msg} {
363     message $w.m -text $msg -justify center -aspect 400
364     pack $w.m -side top -fill x -padx 20 -pady 20
365     button $w.ok -text OK -command "destroy $w"
366     pack $w.ok -side bottom -fill x
367     bind $w <Visibility> "grab $w; focus $w"
368     bind $w <Key-Return> "destroy $w"
369     tkwait window $w
370 }
371
372 proc error_popup msg {
373     set w .error
374     toplevel $w
375     wm transient $w .
376     show_error $w $msg
377 }
378
379 proc makewindow {} {
380     global canv canv2 canv3 linespc charspc ctext cflist
381     global textfont mainfont uifont
382     global findtype findtypemenu findloc findstring fstring geometry
383     global entries sha1entry sha1string sha1but
384     global maincursor textcursor curtextcursor
385     global rowctxmenu mergemax
386     global highlight_files highlight_names
387
388     menu .bar
389     .bar add cascade -label "File" -menu .bar.file
390     .bar configure -font $uifont
391     menu .bar.file
392     .bar.file add command -label "Update" -command updatecommits
393     .bar.file add command -label "Reread references" -command rereadrefs
394     .bar.file add command -label "Quit" -command doquit
395     .bar.file configure -font $uifont
396     menu .bar.edit
397     .bar add cascade -label "Edit" -menu .bar.edit
398     .bar.edit add command -label "Preferences" -command doprefs
399     .bar.edit configure -font $uifont
400
401     menu .bar.view -font $uifont
402     .bar add cascade -label "View" -menu .bar.view
403     .bar.view add command -label "New view..." -command {newview 0}
404     .bar.view add command -label "Edit view..." -command editview \
405         -state disabled
406     .bar.view add command -label "Delete view" -command delview -state disabled
407     .bar.view add separator
408     .bar.view add radiobutton -label "All files" -command {showview 0} \
409         -variable selectedview -value 0
410     
411     menu .bar.help
412     .bar add cascade -label "Help" -menu .bar.help
413     .bar.help add command -label "About gitk" -command about
414     .bar.help add command -label "Key bindings" -command keys
415     .bar.help configure -font $uifont
416     . configure -menu .bar
417
418     if {![info exists geometry(canv1)]} {
419         set geometry(canv1) [expr {45 * $charspc}]
420         set geometry(canv2) [expr {30 * $charspc}]
421         set geometry(canv3) [expr {15 * $charspc}]
422         set geometry(canvh) [expr {25 * $linespc + 4}]
423         set geometry(ctextw) 80
424         set geometry(ctexth) 30
425         set geometry(cflistw) 30
426     }
427     panedwindow .ctop -orient vertical
428     if {[info exists geometry(width)]} {
429         .ctop conf -width $geometry(width) -height $geometry(height)
430         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
431         set geometry(ctexth) [expr {($texth - 8) /
432                                     [font metrics $textfont -linespace]}]
433     }
434     frame .ctop.top
435     frame .ctop.top.bar
436     frame .ctop.top.lbar
437     pack .ctop.top.lbar -side bottom -fill x
438     pack .ctop.top.bar -side bottom -fill x
439     set cscroll .ctop.top.csb
440     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
441     pack $cscroll -side right -fill y
442     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
443     pack .ctop.top.clist -side top -fill both -expand 1
444     .ctop add .ctop.top
445     set canv .ctop.top.clist.canv
446     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
447         -bg white -bd 0 \
448         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
449     .ctop.top.clist add $canv
450     set canv2 .ctop.top.clist.canv2
451     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
452         -bg white -bd 0 -yscrollincr $linespc
453     .ctop.top.clist add $canv2
454     set canv3 .ctop.top.clist.canv3
455     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
456         -bg white -bd 0 -yscrollincr $linespc
457     .ctop.top.clist add $canv3
458     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
459
460     set sha1entry .ctop.top.bar.sha1
461     set entries $sha1entry
462     set sha1but .ctop.top.bar.sha1label
463     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
464         -command gotocommit -width 8 -font $uifont
465     $sha1but conf -disabledforeground [$sha1but cget -foreground]
466     pack .ctop.top.bar.sha1label -side left
467     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
468     trace add variable sha1string write sha1change
469     pack $sha1entry -side left -pady 2
470
471     image create bitmap bm-left -data {
472         #define left_width 16
473         #define left_height 16
474         static unsigned char left_bits[] = {
475         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
476         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
477         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
478     }
479     image create bitmap bm-right -data {
480         #define right_width 16
481         #define right_height 16
482         static unsigned char right_bits[] = {
483         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
484         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
485         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
486     }
487     button .ctop.top.bar.leftbut -image bm-left -command goback \
488         -state disabled -width 26
489     pack .ctop.top.bar.leftbut -side left -fill y
490     button .ctop.top.bar.rightbut -image bm-right -command goforw \
491         -state disabled -width 26
492     pack .ctop.top.bar.rightbut -side left -fill y
493
494     button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
495     pack .ctop.top.bar.findbut -side left
496     set findstring {}
497     set fstring .ctop.top.bar.findstring
498     lappend entries $fstring
499     entry $fstring -width 30 -font $textfont -textvariable findstring
500     pack $fstring -side left -expand 1 -fill x
501     set findtype Exact
502     set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
503                           findtype Exact IgnCase Regexp]
504     .ctop.top.bar.findtype configure -font $uifont
505     .ctop.top.bar.findtype.menu configure -font $uifont
506     set findloc "All fields"
507     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
508         Comments Author Committer Files Pickaxe
509     .ctop.top.bar.findloc configure -font $uifont
510     .ctop.top.bar.findloc.menu configure -font $uifont
511
512     pack .ctop.top.bar.findloc -side right
513     pack .ctop.top.bar.findtype -side right
514     # for making sure type==Exact whenever loc==Pickaxe
515     trace add variable findloc write findlocchange
516
517     label .ctop.top.lbar.flabel -text "Highlight:  Commits touching paths:" \
518         -font $uifont
519     pack .ctop.top.lbar.flabel -side left -fill y
520     entry .ctop.top.lbar.fent -width 25 -font $textfont \
521         -textvariable highlight_files
522     trace add variable highlight_files write hfiles_change
523     lappend entries .ctop.top.lbar.fent
524     pack .ctop.top.lbar.fent -side left -fill x -expand 1
525     label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
526     pack .ctop.top.lbar.vlabel -side left -fill y
527     global viewhlmenu selectedhlview
528     set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
529     $viewhlmenu entryconf 0 -command delvhighlight
530     $viewhlmenu conf -font $uifont
531     .ctop.top.lbar.vhl conf -font $uifont
532     pack .ctop.top.lbar.vhl -side left -fill y
533     label .ctop.top.lbar.alabel -text " OR author/committer:" \
534         -font $uifont
535     pack .ctop.top.lbar.alabel -side left -fill y
536     entry .ctop.top.lbar.aent -width 20 -font $textfont \
537         -textvariable highlight_names
538     trace add variable highlight_names write hnames_change
539     lappend entries .ctop.top.lbar.aent
540     pack .ctop.top.lbar.aent -side right -fill x -expand 1
541
542     panedwindow .ctop.cdet -orient horizontal
543     .ctop add .ctop.cdet
544     frame .ctop.cdet.left
545     set ctext .ctop.cdet.left.ctext
546     text $ctext -bg white -state disabled -font $textfont \
547         -width $geometry(ctextw) -height $geometry(ctexth) \
548         -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
549     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
550     pack .ctop.cdet.left.sb -side right -fill y
551     pack $ctext -side left -fill both -expand 1
552     .ctop.cdet add .ctop.cdet.left
553
554     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
555     $ctext tag conf hunksep -fore blue
556     $ctext tag conf d0 -fore red
557     $ctext tag conf d1 -fore "#00a000"
558     $ctext tag conf m0 -fore red
559     $ctext tag conf m1 -fore blue
560     $ctext tag conf m2 -fore green
561     $ctext tag conf m3 -fore purple
562     $ctext tag conf m4 -fore brown
563     $ctext tag conf m5 -fore "#009090"
564     $ctext tag conf m6 -fore magenta
565     $ctext tag conf m7 -fore "#808000"
566     $ctext tag conf m8 -fore "#009000"
567     $ctext tag conf m9 -fore "#ff0080"
568     $ctext tag conf m10 -fore cyan
569     $ctext tag conf m11 -fore "#b07070"
570     $ctext tag conf m12 -fore "#70b0f0"
571     $ctext tag conf m13 -fore "#70f0b0"
572     $ctext tag conf m14 -fore "#f0b070"
573     $ctext tag conf m15 -fore "#ff70b0"
574     $ctext tag conf mmax -fore darkgrey
575     set mergemax 16
576     $ctext tag conf mresult -font [concat $textfont bold]
577     $ctext tag conf msep -font [concat $textfont bold]
578     $ctext tag conf found -back yellow
579
580     frame .ctop.cdet.right
581     frame .ctop.cdet.right.mode
582     radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
583         -command reselectline -variable cmitmode -value "patch"
584     radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
585         -command reselectline -variable cmitmode -value "tree"
586     grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
587     pack .ctop.cdet.right.mode -side top -fill x
588     set cflist .ctop.cdet.right.cfiles
589     set indent [font measure $mainfont "nn"]
590     text $cflist -width $geometry(cflistw) -background white -font $mainfont \
591         -tabs [list $indent [expr {2 * $indent}]] \
592         -yscrollcommand ".ctop.cdet.right.sb set" \
593         -cursor [. cget -cursor] \
594         -spacing1 1 -spacing3 1
595     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
596     pack .ctop.cdet.right.sb -side right -fill y
597     pack $cflist -side left -fill both -expand 1
598     $cflist tag configure highlight \
599         -background [$cflist cget -selectbackground]
600     $cflist tag configure bold -font [concat $mainfont bold]
601     .ctop.cdet add .ctop.cdet.right
602     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
603
604     pack .ctop -side top -fill both -expand 1
605
606     bindall <1> {selcanvline %W %x %y}
607     #bindall <B1-Motion> {selcanvline %W %x %y}
608     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
609     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
610     bindall <2> "canvscan mark %W %x %y"
611     bindall <B2-Motion> "canvscan dragto %W %x %y"
612     bindkey <Home> selfirstline
613     bindkey <End> sellastline
614     bind . <Key-Up> "selnextline -1"
615     bind . <Key-Down> "selnextline 1"
616     bindkey <Key-Right> "goforw"
617     bindkey <Key-Left> "goback"
618     bind . <Key-Prior> "selnextpage -1"
619     bind . <Key-Next> "selnextpage 1"
620     bind . <Control-Home> "allcanvs yview moveto 0.0"
621     bind . <Control-End> "allcanvs yview moveto 1.0"
622     bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
623     bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
624     bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
625     bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
626     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
627     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
628     bindkey <Key-space> "$ctext yview scroll 1 pages"
629     bindkey p "selnextline -1"
630     bindkey n "selnextline 1"
631     bindkey z "goback"
632     bindkey x "goforw"
633     bindkey i "selnextline -1"
634     bindkey k "selnextline 1"
635     bindkey j "goback"
636     bindkey l "goforw"
637     bindkey b "$ctext yview scroll -1 pages"
638     bindkey d "$ctext yview scroll 18 units"
639     bindkey u "$ctext yview scroll -18 units"
640     bindkey / {findnext 1}
641     bindkey <Key-Return> {findnext 0}
642     bindkey ? findprev
643     bindkey f nextfile
644     bind . <Control-q> doquit
645     bind . <Control-f> dofind
646     bind . <Control-g> {findnext 0}
647     bind . <Control-r> findprev
648     bind . <Control-equal> {incrfont 1}
649     bind . <Control-KP_Add> {incrfont 1}
650     bind . <Control-minus> {incrfont -1}
651     bind . <Control-KP_Subtract> {incrfont -1}
652     bind . <Destroy> {savestuff %W}
653     bind . <Button-1> "click %W"
654     bind $fstring <Key-Return> dofind
655     bind $sha1entry <Key-Return> gotocommit
656     bind $sha1entry <<PasteSelection>> clearsha1
657     bind $cflist <1> {sel_flist %W %x %y; break}
658     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
659     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
660
661     set maincursor [. cget -cursor]
662     set textcursor [$ctext cget -cursor]
663     set curtextcursor $textcursor
664
665     set rowctxmenu .rowctxmenu
666     menu $rowctxmenu -tearoff 0
667     $rowctxmenu add command -label "Diff this -> selected" \
668         -command {diffvssel 0}
669     $rowctxmenu add command -label "Diff selected -> this" \
670         -command {diffvssel 1}
671     $rowctxmenu add command -label "Make patch" -command mkpatch
672     $rowctxmenu add command -label "Create tag" -command mktag
673     $rowctxmenu add command -label "Write commit to file" -command writecommit
674 }
675
676 # mouse-2 makes all windows scan vertically, but only the one
677 # the cursor is in scans horizontally
678 proc canvscan {op w x y} {
679     global canv canv2 canv3
680     foreach c [list $canv $canv2 $canv3] {
681         if {$c == $w} {
682             $c scan $op $x $y
683         } else {
684             $c scan $op 0 $y
685         }
686     }
687 }
688
689 proc scrollcanv {cscroll f0 f1} {
690     $cscroll set $f0 $f1
691     drawfrac $f0 $f1
692     flushhighlights
693 }
694
695 # when we make a key binding for the toplevel, make sure
696 # it doesn't get triggered when that key is pressed in the
697 # find string entry widget.
698 proc bindkey {ev script} {
699     global entries
700     bind . $ev $script
701     set escript [bind Entry $ev]
702     if {$escript == {}} {
703         set escript [bind Entry <Key>]
704     }
705     foreach e $entries {
706         bind $e $ev "$escript; break"
707     }
708 }
709
710 # set the focus back to the toplevel for any click outside
711 # the entry widgets
712 proc click {w} {
713     global entries
714     foreach e $entries {
715         if {$w == $e} return
716     }
717     focus .
718 }
719
720 proc savestuff {w} {
721     global canv canv2 canv3 ctext cflist mainfont textfont uifont
722     global stuffsaved findmergefiles maxgraphpct
723     global maxwidth
724     global viewname viewfiles viewargs viewperm nextviewnum
725     global cmitmode
726
727     if {$stuffsaved} return
728     if {![winfo viewable .]} return
729     catch {
730         set f [open "~/.gitk-new" w]
731         puts $f [list set mainfont $mainfont]
732         puts $f [list set textfont $textfont]
733         puts $f [list set uifont $uifont]
734         puts $f [list set findmergefiles $findmergefiles]
735         puts $f [list set maxgraphpct $maxgraphpct]
736         puts $f [list set maxwidth $maxwidth]
737         puts $f [list set cmitmode $cmitmode]
738         puts $f "set geometry(width) [winfo width .ctop]"
739         puts $f "set geometry(height) [winfo height .ctop]"
740         puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
741         puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
742         puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
743         puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
744         set wid [expr {([winfo width $ctext] - 8) \
745                            / [font measure $textfont "0"]}]
746         puts $f "set geometry(ctextw) $wid"
747         set wid [expr {([winfo width $cflist] - 11) \
748                            / [font measure [$cflist cget -font] "0"]}]
749         puts $f "set geometry(cflistw) $wid"
750         puts -nonewline $f "set permviews {"
751         for {set v 0} {$v < $nextviewnum} {incr v} {
752             if {$viewperm($v)} {
753                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
754             }
755         }
756         puts $f "}"
757         close $f
758         file rename -force "~/.gitk-new" "~/.gitk"
759     }
760     set stuffsaved 1
761 }
762
763 proc resizeclistpanes {win w} {
764     global oldwidth
765     if {[info exists oldwidth($win)]} {
766         set s0 [$win sash coord 0]
767         set s1 [$win sash coord 1]
768         if {$w < 60} {
769             set sash0 [expr {int($w/2 - 2)}]
770             set sash1 [expr {int($w*5/6 - 2)}]
771         } else {
772             set factor [expr {1.0 * $w / $oldwidth($win)}]
773             set sash0 [expr {int($factor * [lindex $s0 0])}]
774             set sash1 [expr {int($factor * [lindex $s1 0])}]
775             if {$sash0 < 30} {
776                 set sash0 30
777             }
778             if {$sash1 < $sash0 + 20} {
779                 set sash1 [expr {$sash0 + 20}]
780             }
781             if {$sash1 > $w - 10} {
782                 set sash1 [expr {$w - 10}]
783                 if {$sash0 > $sash1 - 20} {
784                     set sash0 [expr {$sash1 - 20}]
785                 }
786             }
787         }
788         $win sash place 0 $sash0 [lindex $s0 1]
789         $win sash place 1 $sash1 [lindex $s1 1]
790     }
791     set oldwidth($win) $w
792 }
793
794 proc resizecdetpanes {win w} {
795     global oldwidth
796     if {[info exists oldwidth($win)]} {
797         set s0 [$win sash coord 0]
798         if {$w < 60} {
799             set sash0 [expr {int($w*3/4 - 2)}]
800         } else {
801             set factor [expr {1.0 * $w / $oldwidth($win)}]
802             set sash0 [expr {int($factor * [lindex $s0 0])}]
803             if {$sash0 < 45} {
804                 set sash0 45
805             }
806             if {$sash0 > $w - 15} {
807                 set sash0 [expr {$w - 15}]
808             }
809         }
810         $win sash place 0 $sash0 [lindex $s0 1]
811     }
812     set oldwidth($win) $w
813 }
814
815 proc allcanvs args {
816     global canv canv2 canv3
817     eval $canv $args
818     eval $canv2 $args
819     eval $canv3 $args
820 }
821
822 proc bindall {event action} {
823     global canv canv2 canv3
824     bind $canv $event $action
825     bind $canv2 $event $action
826     bind $canv3 $event $action
827 }
828
829 proc about {} {
830     set w .about
831     if {[winfo exists $w]} {
832         raise $w
833         return
834     }
835     toplevel $w
836     wm title $w "About gitk"
837     message $w.m -text {
838 Gitk - a commit viewer for git
839
840 Copyright Â© 2005-2006 Paul Mackerras
841
842 Use and redistribute under the terms of the GNU General Public License} \
843             -justify center -aspect 400
844     pack $w.m -side top -fill x -padx 20 -pady 20
845     button $w.ok -text Close -command "destroy $w"
846     pack $w.ok -side bottom
847 }
848
849 proc keys {} {
850     set w .keys
851     if {[winfo exists $w]} {
852         raise $w
853         return
854     }
855     toplevel $w
856     wm title $w "Gitk key bindings"
857     message $w.m -text {
858 Gitk key bindings:
859
860 <Ctrl-Q>                Quit
861 <Home>          Move to first commit
862 <End>           Move to last commit
863 <Up>, p, i      Move up one commit
864 <Down>, n, k    Move down one commit
865 <Left>, z, j    Go back in history list
866 <Right>, x, l   Go forward in history list
867 <PageUp>        Move up one page in commit list
868 <PageDown>      Move down one page in commit list
869 <Ctrl-Home>     Scroll to top of commit list
870 <Ctrl-End>      Scroll to bottom of commit list
871 <Ctrl-Up>       Scroll commit list up one line
872 <Ctrl-Down>     Scroll commit list down one line
873 <Ctrl-PageUp>   Scroll commit list up one page
874 <Ctrl-PageDown> Scroll commit list down one page
875 <Delete>, b     Scroll diff view up one page
876 <Backspace>     Scroll diff view up one page
877 <Space>         Scroll diff view down one page
878 u               Scroll diff view up 18 lines
879 d               Scroll diff view down 18 lines
880 <Ctrl-F>                Find
881 <Ctrl-G>                Move to next find hit
882 <Ctrl-R>                Move to previous find hit
883 <Return>        Move to next find hit
884 /               Move to next find hit, or redo find
885 ?               Move to previous find hit
886 f               Scroll diff view to next file
887 <Ctrl-KP+>      Increase font size
888 <Ctrl-plus>     Increase font size
889 <Ctrl-KP->      Decrease font size
890 <Ctrl-minus>    Decrease font size
891 } \
892             -justify left -bg white -border 2 -relief sunken
893     pack $w.m -side top -fill both
894     button $w.ok -text Close -command "destroy $w"
895     pack $w.ok -side bottom
896 }
897
898 # Procedures for manipulating the file list window at the
899 # bottom right of the overall window.
900
901 proc treeview {w l openlevs} {
902     global treecontents treediropen treeheight treeparent treeindex
903
904     set ix 0
905     set treeindex() 0
906     set lev 0
907     set prefix {}
908     set prefixend -1
909     set prefendstack {}
910     set htstack {}
911     set ht 0
912     set treecontents() {}
913     $w conf -state normal
914     foreach f $l {
915         while {[string range $f 0 $prefixend] ne $prefix} {
916             if {$lev <= $openlevs} {
917                 $w mark set e:$treeindex($prefix) "end -1c"
918                 $w mark gravity e:$treeindex($prefix) left
919             }
920             set treeheight($prefix) $ht
921             incr ht [lindex $htstack end]
922             set htstack [lreplace $htstack end end]
923             set prefixend [lindex $prefendstack end]
924             set prefendstack [lreplace $prefendstack end end]
925             set prefix [string range $prefix 0 $prefixend]
926             incr lev -1
927         }
928         set tail [string range $f [expr {$prefixend+1}] end]
929         while {[set slash [string first "/" $tail]] >= 0} {
930             lappend htstack $ht
931             set ht 0
932             lappend prefendstack $prefixend
933             incr prefixend [expr {$slash + 1}]
934             set d [string range $tail 0 $slash]
935             lappend treecontents($prefix) $d
936             set oldprefix $prefix
937             append prefix $d
938             set treecontents($prefix) {}
939             set treeindex($prefix) [incr ix]
940             set treeparent($prefix) $oldprefix
941             set tail [string range $tail [expr {$slash+1}] end]
942             if {$lev <= $openlevs} {
943                 set ht 1
944                 set treediropen($prefix) [expr {$lev < $openlevs}]
945                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
946                 $w mark set d:$ix "end -1c"
947                 $w mark gravity d:$ix left
948                 set str "\n"
949                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
950                 $w insert end $str
951                 $w image create end -align center -image $bm -padx 1 \
952                     -name a:$ix
953                 $w insert end $d
954                 $w mark set s:$ix "end -1c"
955                 $w mark gravity s:$ix left
956             }
957             incr lev
958         }
959         if {$tail ne {}} {
960             if {$lev <= $openlevs} {
961                 incr ht
962                 set str "\n"
963                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
964                 $w insert end $str
965                 $w insert end $tail
966             }
967             lappend treecontents($prefix) $tail
968         }
969     }
970     while {$htstack ne {}} {
971         set treeheight($prefix) $ht
972         incr ht [lindex $htstack end]
973         set htstack [lreplace $htstack end end]
974     }
975     $w conf -state disabled
976 }
977
978 proc linetoelt {l} {
979     global treeheight treecontents
980
981     set y 2
982     set prefix {}
983     while {1} {
984         foreach e $treecontents($prefix) {
985             if {$y == $l} {
986                 return "$prefix$e"
987             }
988             set n 1
989             if {[string index $e end] eq "/"} {
990                 set n $treeheight($prefix$e)
991                 if {$y + $n > $l} {
992                     append prefix $e
993                     incr y
994                     break
995                 }
996             }
997             incr y $n
998         }
999     }
1000 }
1001
1002 proc treeclosedir {w dir} {
1003     global treediropen treeheight treeparent treeindex
1004
1005     set ix $treeindex($dir)
1006     $w conf -state normal
1007     $w delete s:$ix e:$ix
1008     set treediropen($dir) 0
1009     $w image configure a:$ix -image tri-rt
1010     $w conf -state disabled
1011     set n [expr {1 - $treeheight($dir)}]
1012     while {$dir ne {}} {
1013         incr treeheight($dir) $n
1014         set dir $treeparent($dir)
1015     }
1016 }
1017
1018 proc treeopendir {w dir} {
1019     global treediropen treeheight treeparent treecontents treeindex
1020
1021     set ix $treeindex($dir)
1022     $w conf -state normal
1023     $w image configure a:$ix -image tri-dn
1024     $w mark set e:$ix s:$ix
1025     $w mark gravity e:$ix right
1026     set lev 0
1027     set str "\n"
1028     set n [llength $treecontents($dir)]
1029     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1030         incr lev
1031         append str "\t"
1032         incr treeheight($x) $n
1033     }
1034     foreach e $treecontents($dir) {
1035         if {[string index $e end] eq "/"} {
1036             set de $dir$e
1037             set iy $treeindex($de)
1038             $w mark set d:$iy e:$ix
1039             $w mark gravity d:$iy left
1040             $w insert e:$ix $str
1041             set treediropen($de) 0
1042             $w image create e:$ix -align center -image tri-rt -padx 1 \
1043                 -name a:$iy
1044             $w insert e:$ix $e
1045             $w mark set s:$iy e:$ix
1046             $w mark gravity s:$iy left
1047             set treeheight($de) 1
1048         } else {
1049             $w insert e:$ix $str
1050             $w insert e:$ix $e
1051         }
1052     }
1053     $w mark gravity e:$ix left
1054     $w conf -state disabled
1055     set treediropen($dir) 1
1056     set top [lindex [split [$w index @0,0] .] 0]
1057     set ht [$w cget -height]
1058     set l [lindex [split [$w index s:$ix] .] 0]
1059     if {$l < $top} {
1060         $w yview $l.0
1061     } elseif {$l + $n + 1 > $top + $ht} {
1062         set top [expr {$l + $n + 2 - $ht}]
1063         if {$l < $top} {
1064             set top $l
1065         }
1066         $w yview $top.0
1067     }
1068 }
1069
1070 proc treeclick {w x y} {
1071     global treediropen cmitmode ctext cflist cflist_top
1072
1073     if {$cmitmode ne "tree"} return
1074     if {![info exists cflist_top]} return
1075     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1076     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1077     $cflist tag add highlight $l.0 "$l.0 lineend"
1078     set cflist_top $l
1079     if {$l == 1} {
1080         $ctext yview 1.0
1081         return
1082     }
1083     set e [linetoelt $l]
1084     if {[string index $e end] ne "/"} {
1085         showfile $e
1086     } elseif {$treediropen($e)} {
1087         treeclosedir $w $e
1088     } else {
1089         treeopendir $w $e
1090     }
1091 }
1092
1093 proc setfilelist {id} {
1094     global treefilelist cflist
1095
1096     treeview $cflist $treefilelist($id) 0
1097 }
1098
1099 image create bitmap tri-rt -background black -foreground blue -data {
1100     #define tri-rt_width 13
1101     #define tri-rt_height 13
1102     static unsigned char tri-rt_bits[] = {
1103        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1104        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1105        0x00, 0x00};
1106 } -maskdata {
1107     #define tri-rt-mask_width 13
1108     #define tri-rt-mask_height 13
1109     static unsigned char tri-rt-mask_bits[] = {
1110        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1111        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1112        0x08, 0x00};
1113 }
1114 image create bitmap tri-dn -background black -foreground blue -data {
1115     #define tri-dn_width 13
1116     #define tri-dn_height 13
1117     static unsigned char tri-dn_bits[] = {
1118        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1119        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1120        0x00, 0x00};
1121 } -maskdata {
1122     #define tri-dn-mask_width 13
1123     #define tri-dn-mask_height 13
1124     static unsigned char tri-dn-mask_bits[] = {
1125        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1126        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1127        0x00, 0x00};
1128 }
1129
1130 proc init_flist {first} {
1131     global cflist cflist_top selectedline difffilestart
1132
1133     $cflist conf -state normal
1134     $cflist delete 0.0 end
1135     if {$first ne {}} {
1136         $cflist insert end $first
1137         set cflist_top 1
1138         $cflist tag add highlight 1.0 "1.0 lineend"
1139     } else {
1140         catch {unset cflist_top}
1141     }
1142     $cflist conf -state disabled
1143     set difffilestart {}
1144 }
1145
1146 proc highlight_tag {f} {
1147     global highlight_paths
1148
1149     foreach p $highlight_paths {
1150         if {[string match $p $f]} {
1151             return "bold"
1152         }
1153     }
1154     return {}
1155 }
1156
1157 proc highlight_filelist {} {
1158     global flistmode cflist
1159
1160     global highlight_paths
1161     if {$flistmode eq "flat"} {
1162         $cflist conf -state normal
1163         set end [lindex [split [$cflist index end] .] 0]
1164         for {set l 2} {$l < $end} {incr l} {
1165             set line [$cflist get $l.0 "$l.0 lineend"]
1166             if {[highlight_tag $line] ne {}} {
1167                 $cflist tag add bold $l.0 "$l.0 lineend"
1168             }
1169         }
1170         $cflist conf -state disabled
1171     }
1172 }
1173
1174 proc unhighlight_filelist {} {
1175     global flistmode cflist
1176
1177     if {$flistmode eq "flat"} {
1178         $cflist conf -state normal
1179         $cflist tag remove bold 1.0 end
1180         $cflist conf -state disabled
1181     }
1182 }
1183
1184 proc add_flist {fl} {
1185     global flistmode cflist
1186
1187     if {$flistmode eq "flat"} {
1188         $cflist conf -state normal
1189         foreach f $fl {
1190             $cflist insert end "\n"
1191             $cflist insert end $f [highlight_tag $f]
1192         }
1193         $cflist conf -state disabled
1194     }
1195 }
1196
1197 proc sel_flist {w x y} {
1198     global flistmode ctext difffilestart cflist cflist_top cmitmode
1199
1200     if {$cmitmode eq "tree"} return
1201     if {![info exists cflist_top]} return
1202     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1203     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1204     $cflist tag add highlight $l.0 "$l.0 lineend"
1205     set cflist_top $l
1206     if {$l == 1} {
1207         $ctext yview 1.0
1208     } else {
1209         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1210     }
1211 }
1212
1213 # Functions for adding and removing shell-type quoting
1214
1215 proc shellquote {str} {
1216     if {![string match "*\['\"\\ \t]*" $str]} {
1217         return $str
1218     }
1219     if {![string match "*\['\"\\]*" $str]} {
1220         return "\"$str\""
1221     }
1222     if {![string match "*'*" $str]} {
1223         return "'$str'"
1224     }
1225     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1226 }
1227
1228 proc shellarglist {l} {
1229     set str {}
1230     foreach a $l {
1231         if {$str ne {}} {
1232             append str " "
1233         }
1234         append str [shellquote $a]
1235     }
1236     return $str
1237 }
1238
1239 proc shelldequote {str} {
1240     set ret {}
1241     set used -1
1242     while {1} {
1243         incr used
1244         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1245             append ret [string range $str $used end]
1246             set used [string length $str]
1247             break
1248         }
1249         set first [lindex $first 0]
1250         set ch [string index $str $first]
1251         if {$first > $used} {
1252             append ret [string range $str $used [expr {$first - 1}]]
1253             set used $first
1254         }
1255         if {$ch eq " " || $ch eq "\t"} break
1256         incr used
1257         if {$ch eq "'"} {
1258             set first [string first "'" $str $used]
1259             if {$first < 0} {
1260                 error "unmatched single-quote"
1261             }
1262             append ret [string range $str $used [expr {$first - 1}]]
1263             set used $first
1264             continue
1265         }
1266         if {$ch eq "\\"} {
1267             if {$used >= [string length $str]} {
1268                 error "trailing backslash"
1269             }
1270             append ret [string index $str $used]
1271             continue
1272         }
1273         # here ch == "\""
1274         while {1} {
1275             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1276                 error "unmatched double-quote"
1277             }
1278             set first [lindex $first 0]
1279             set ch [string index $str $first]
1280             if {$first > $used} {
1281                 append ret [string range $str $used [expr {$first - 1}]]
1282                 set used $first
1283             }
1284             if {$ch eq "\""} break
1285             incr used
1286             append ret [string index $str $used]
1287             incr used
1288         }
1289     }
1290     return [list $used $ret]
1291 }
1292
1293 proc shellsplit {str} {
1294     set l {}
1295     while {1} {
1296         set str [string trimleft $str]
1297         if {$str eq {}} break
1298         set dq [shelldequote $str]
1299         set n [lindex $dq 0]
1300         set word [lindex $dq 1]
1301         set str [string range $str $n end]
1302         lappend l $word
1303     }
1304     return $l
1305 }
1306
1307 # Code to implement multiple views
1308
1309 proc newview {ishighlight} {
1310     global nextviewnum newviewname newviewperm uifont newishighlight
1311     global newviewargs revtreeargs
1312
1313     set newishighlight $ishighlight
1314     set top .gitkview
1315     if {[winfo exists $top]} {
1316         raise $top
1317         return
1318     }
1319     set newviewname($nextviewnum) "View $nextviewnum"
1320     set newviewperm($nextviewnum) 0
1321     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1322     vieweditor $top $nextviewnum "Gitk view definition" 
1323 }
1324
1325 proc editview {} {
1326     global curview
1327     global viewname viewperm newviewname newviewperm
1328     global viewargs newviewargs
1329
1330     set top .gitkvedit-$curview
1331     if {[winfo exists $top]} {
1332         raise $top
1333         return
1334     }
1335     set newviewname($curview) $viewname($curview)
1336     set newviewperm($curview) $viewperm($curview)
1337     set newviewargs($curview) [shellarglist $viewargs($curview)]
1338     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1339 }
1340
1341 proc vieweditor {top n title} {
1342     global newviewname newviewperm viewfiles
1343     global uifont
1344
1345     toplevel $top
1346     wm title $top $title
1347     label $top.nl -text "Name" -font $uifont
1348     entry $top.name -width 20 -textvariable newviewname($n)
1349     grid $top.nl $top.name -sticky w -pady 5
1350     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1351     grid $top.perm - -pady 5 -sticky w
1352     message $top.al -aspect 1000 -font $uifont \
1353         -text "Commits to include (arguments to git-rev-list):"
1354     grid $top.al - -sticky w -pady 5
1355     entry $top.args -width 50 -textvariable newviewargs($n) \
1356         -background white
1357     grid $top.args - -sticky ew -padx 5
1358     message $top.l -aspect 1000 -font $uifont \
1359         -text "Enter files and directories to include, one per line:"
1360     grid $top.l - -sticky w
1361     text $top.t -width 40 -height 10 -background white
1362     if {[info exists viewfiles($n)]} {
1363         foreach f $viewfiles($n) {
1364             $top.t insert end $f
1365             $top.t insert end "\n"
1366         }
1367         $top.t delete {end - 1c} end
1368         $top.t mark set insert 0.0
1369     }
1370     grid $top.t - -sticky ew -padx 5
1371     frame $top.buts
1372     button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1373     button $top.buts.can -text "Cancel" -command [list destroy $top]
1374     grid $top.buts.ok $top.buts.can
1375     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1376     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1377     grid $top.buts - -pady 10 -sticky ew
1378     focus $top.t
1379 }
1380
1381 proc doviewmenu {m first cmd op argv} {
1382     set nmenu [$m index end]
1383     for {set i $first} {$i <= $nmenu} {incr i} {
1384         if {[$m entrycget $i -command] eq $cmd} {
1385             eval $m $op $i $argv
1386             break
1387         }
1388     }
1389 }
1390
1391 proc allviewmenus {n op args} {
1392     global viewhlmenu
1393
1394     doviewmenu .bar.view 7 [list showview $n] $op $args
1395     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1396 }
1397
1398 proc newviewok {top n} {
1399     global nextviewnum newviewperm newviewname newishighlight
1400     global viewname viewfiles viewperm selectedview curview
1401     global viewargs newviewargs viewhlmenu
1402
1403     if {[catch {
1404         set newargs [shellsplit $newviewargs($n)]
1405     } err]} {
1406         error_popup "Error in commit selection arguments: $err"
1407         wm raise $top
1408         focus $top
1409         return
1410     }
1411     set files {}
1412     foreach f [split [$top.t get 0.0 end] "\n"] {
1413         set ft [string trim $f]
1414         if {$ft ne {}} {
1415             lappend files $ft
1416         }
1417     }
1418     if {![info exists viewfiles($n)]} {
1419         # creating a new view
1420         incr nextviewnum
1421         set viewname($n) $newviewname($n)
1422         set viewperm($n) $newviewperm($n)
1423         set viewfiles($n) $files
1424         set viewargs($n) $newargs
1425         addviewmenu $n
1426         if {!$newishighlight} {
1427             after idle showview $n
1428         } else {
1429             after idle addvhighlight $n
1430         }
1431     } else {
1432         # editing an existing view
1433         set viewperm($n) $newviewperm($n)
1434         if {$newviewname($n) ne $viewname($n)} {
1435             set viewname($n) $newviewname($n)
1436             doviewmenu .bar.view 7 [list showview $n] \
1437                 entryconf [list -label $viewname($n)]
1438             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1439                 entryconf [list -label $viewname($n) -value $viewname($n)]
1440         }
1441         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1442             set viewfiles($n) $files
1443             set viewargs($n) $newargs
1444             if {$curview == $n} {
1445                 after idle updatecommits
1446             }
1447         }
1448     }
1449     catch {destroy $top}
1450 }
1451
1452 proc delview {} {
1453     global curview viewdata viewperm hlview selectedhlview
1454
1455     if {$curview == 0} return
1456     if {[info exists hlview] && $hlview == $curview} {
1457         set selectedhlview None
1458         unset hlview
1459     }
1460     allviewmenus $curview delete
1461     set viewdata($curview) {}
1462     set viewperm($curview) 0
1463     showview 0
1464 }
1465
1466 proc addviewmenu {n} {
1467     global viewname viewhlmenu
1468
1469     .bar.view add radiobutton -label $viewname($n) \
1470         -command [list showview $n] -variable selectedview -value $n
1471     $viewhlmenu add radiobutton -label $viewname($n) \
1472         -command [list addvhighlight $n] -variable selectedhlview
1473 }
1474
1475 proc flatten {var} {
1476     global $var
1477
1478     set ret {}
1479     foreach i [array names $var] {
1480         lappend ret $i [set $var\($i\)]
1481     }
1482     return $ret
1483 }
1484
1485 proc unflatten {var l} {
1486     global $var
1487
1488     catch {unset $var}
1489     foreach {i v} $l {
1490         set $var\($i\) $v
1491     }
1492 }
1493
1494 proc showview {n} {
1495     global curview viewdata viewfiles
1496     global displayorder parentlist childlist rowidlist rowoffsets
1497     global colormap rowtextx commitrow nextcolor canvxmax
1498     global numcommits rowrangelist commitlisted idrowranges
1499     global selectedline currentid canv canvy0
1500     global matchinglines treediffs
1501     global pending_select phase
1502     global commitidx rowlaidout rowoptim linesegends
1503     global commfd nextupdate
1504     global selectedview
1505     global vparentlist vchildlist vdisporder vcmitlisted
1506     global hlview selectedhlview
1507
1508     if {$n == $curview} return
1509     set selid {}
1510     if {[info exists selectedline]} {
1511         set selid $currentid
1512         set y [yc $selectedline]
1513         set ymax [lindex [$canv cget -scrollregion] 3]
1514         set span [$canv yview]
1515         set ytop [expr {[lindex $span 0] * $ymax}]
1516         set ybot [expr {[lindex $span 1] * $ymax}]
1517         if {$ytop < $y && $y < $ybot} {
1518             set yscreen [expr {$y - $ytop}]
1519         } else {
1520             set yscreen [expr {($ybot - $ytop) / 2}]
1521         }
1522     }
1523     unselectline
1524     normalline
1525     stopfindproc
1526     if {$curview >= 0} {
1527         set vparentlist($curview) $parentlist
1528         set vchildlist($curview) $childlist
1529         set vdisporder($curview) $displayorder
1530         set vcmitlisted($curview) $commitlisted
1531         if {$phase ne {}} {
1532             set viewdata($curview) \
1533                 [list $phase $rowidlist $rowoffsets $rowrangelist \
1534                      [flatten idrowranges] [flatten idinlist] \
1535                      $rowlaidout $rowoptim $numcommits $linesegends]
1536         } elseif {![info exists viewdata($curview)]
1537                   || [lindex $viewdata($curview) 0] ne {}} {
1538             set viewdata($curview) \
1539                 [list {} $rowidlist $rowoffsets $rowrangelist]
1540         }
1541     }
1542     catch {unset matchinglines}
1543     catch {unset treediffs}
1544     clear_display
1545     if {[info exists hlview] && $hlview == $n} {
1546         unset hlview
1547         set selectedhlview None
1548     }
1549
1550     set curview $n
1551     set selectedview $n
1552     .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1553     .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1554
1555     if {![info exists viewdata($n)]} {
1556         set pending_select $selid
1557         getcommits
1558         return
1559     }
1560
1561     set v $viewdata($n)
1562     set phase [lindex $v 0]
1563     set displayorder $vdisporder($n)
1564     set parentlist $vparentlist($n)
1565     set childlist $vchildlist($n)
1566     set commitlisted $vcmitlisted($n)
1567     set rowidlist [lindex $v 1]
1568     set rowoffsets [lindex $v 2]
1569     set rowrangelist [lindex $v 3]
1570     if {$phase eq {}} {
1571         set numcommits [llength $displayorder]
1572         catch {unset idrowranges}
1573     } else {
1574         unflatten idrowranges [lindex $v 4]
1575         unflatten idinlist [lindex $v 5]
1576         set rowlaidout [lindex $v 6]
1577         set rowoptim [lindex $v 7]
1578         set numcommits [lindex $v 8]
1579         set linesegends [lindex $v 9]
1580     }
1581
1582     catch {unset colormap}
1583     catch {unset rowtextx}
1584     set nextcolor 0
1585     set canvxmax [$canv cget -width]
1586     set curview $n
1587     set row 0
1588     setcanvscroll
1589     set yf 0
1590     set row 0
1591     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1592         set row $commitrow($n,$selid)
1593         # try to get the selected row in the same position on the screen
1594         set ymax [lindex [$canv cget -scrollregion] 3]
1595         set ytop [expr {[yc $row] - $yscreen}]
1596         if {$ytop < 0} {
1597             set ytop 0
1598         }
1599         set yf [expr {$ytop * 1.0 / $ymax}]
1600     }
1601     allcanvs yview moveto $yf
1602     drawvisible
1603     selectline $row 0
1604     if {$phase ne {}} {
1605         if {$phase eq "getcommits"} {
1606             show_status "Reading commits..."
1607         }
1608         if {[info exists commfd($n)]} {
1609             layoutmore
1610         } else {
1611             finishcommits
1612         }
1613     } elseif {$numcommits == 0} {
1614         show_status "No commits selected"
1615     }
1616 }
1617
1618 # Stuff relating to the highlighting facility
1619
1620 proc ishighlighted {row} {
1621     global vhighlights fhighlights nhighlights
1622
1623     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1624         return $nhighlights($row)
1625     }
1626     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1627         return $vhighlights($row)
1628     }
1629     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1630         return $fhighlights($row)
1631     }
1632     return 0
1633 }
1634
1635 proc bolden {row font} {
1636     global canv linehtag selectedline
1637
1638     $canv itemconf $linehtag($row) -font $font
1639     if {$row == $selectedline} {
1640         $canv delete secsel
1641         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1642                    -outline {{}} -tags secsel \
1643                    -fill [$canv cget -selectbackground]]
1644         $canv lower $t
1645     }
1646 }
1647
1648 proc bolden_name {row font} {
1649     global canv2 linentag selectedline
1650
1651     $canv2 itemconf $linentag($row) -font $font
1652     if {$row == $selectedline} {
1653         $canv2 delete secsel
1654         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1655                    -outline {{}} -tags secsel \
1656                    -fill [$canv2 cget -selectbackground]]
1657         $canv2 lower $t
1658     }
1659 }
1660
1661 proc unbolden {rows} {
1662     global mainfont
1663
1664     foreach row $rows {
1665         if {![ishighlighted $row]} {
1666             bolden $row $mainfont
1667         }
1668     }
1669 }
1670
1671 proc addvhighlight {n} {
1672     global hlview curview viewdata vhl_done vhighlights commitidx
1673
1674     if {[info exists hlview]} {
1675         delvhighlight
1676     }
1677     set hlview $n
1678     if {$n != $curview && ![info exists viewdata($n)]} {
1679         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1680         set vparentlist($n) {}
1681         set vchildlist($n) {}
1682         set vdisporder($n) {}
1683         set vcmitlisted($n) {}
1684         start_rev_list $n
1685     }
1686     set vhl_done $commitidx($hlview)
1687     if {$vhl_done > 0} {
1688         drawvisible
1689     }
1690 }
1691
1692 proc delvhighlight {} {
1693     global hlview vhighlights
1694     global selectedline
1695
1696     if {![info exists hlview]} return
1697     unset hlview
1698     set rows [array names vhighlights]
1699     if {$rows ne {}} {
1700         unset vhighlights
1701         unbolden $rows
1702     }
1703 }
1704
1705 proc vhighlightmore {} {
1706     global hlview vhl_done commitidx vhighlights
1707     global displayorder vdisporder curview mainfont
1708
1709     set font [concat $mainfont bold]
1710     set max $commitidx($hlview)
1711     if {$hlview == $curview} {
1712         set disp $displayorder
1713     } else {
1714         set disp $vdisporder($hlview)
1715     }
1716     set vr [visiblerows]
1717     set r0 [lindex $vr 0]
1718     set r1 [lindex $vr 1]
1719     for {set i $vhl_done} {$i < $max} {incr i} {
1720         set id [lindex $disp $i]
1721         if {[info exists commitrow($curview,$id)]} {
1722             set row $commitrow($curview,$id)
1723             if {$r0 <= $row && $row <= $r1} {
1724                 if {![highlighted $row]} {
1725                     bolden $row $font
1726                 }
1727                 set vhighlights($row) 1
1728             }
1729         }
1730     }
1731     set vhl_done $max
1732 }
1733
1734 proc askvhighlight {row id} {
1735     global hlview vhighlights commitrow iddrawn mainfont
1736
1737     if {[info exists commitrow($hlview,$id)]} {
1738         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1739             bolden $row [concat $mainfont bold]
1740         }
1741         set vhighlights($row) 1
1742     } else {
1743         set vhighlights($row) 0
1744     }
1745 }
1746
1747 proc hfiles_change {name ix op} {
1748     global highlight_files filehighlight fhighlights fh_serial
1749     global mainfont highlight_paths
1750
1751     if {[info exists filehighlight]} {
1752         # delete previous highlights
1753         catch {close $filehighlight}
1754         unset filehighlight
1755         set rows [array names fhighlights]
1756         if {$rows ne {}} {
1757             unset fhighlights
1758             unbolden $rows
1759         }
1760         unhighlight_filelist
1761     }
1762     set highlight_paths {}
1763     after cancel do_file_hl $fh_serial
1764     incr fh_serial
1765     if {$highlight_files ne {}} {
1766         after 300 do_file_hl $fh_serial
1767     }
1768 }
1769
1770 proc makepatterns {l} {
1771     set ret {}
1772     foreach e $l {
1773         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1774         if {[string index $ee end] eq "/"} {
1775             lappend ret "$ee*"
1776         } else {
1777             lappend ret $ee
1778             lappend ret "$ee/*"
1779         }
1780     }
1781     return $ret
1782 }
1783
1784 proc do_file_hl {serial} {
1785     global highlight_files filehighlight highlight_paths
1786
1787     if {[catch {set paths [shellsplit $highlight_files]}]} return
1788     set highlight_paths [makepatterns $paths]
1789     highlight_filelist
1790     set cmd [concat | git-diff-tree -r -s --stdin -- $paths]
1791     set filehighlight [open $cmd r+]
1792     fconfigure $filehighlight -blocking 0
1793     fileevent $filehighlight readable readfhighlight
1794     drawvisible
1795     flushhighlights
1796 }
1797
1798 proc flushhighlights {} {
1799     global filehighlight
1800
1801     if {[info exists filehighlight]} {
1802         puts $filehighlight ""
1803         flush $filehighlight
1804     }
1805 }
1806
1807 proc askfilehighlight {row id} {
1808     global filehighlight fhighlights
1809
1810     set fhighlights($row) 0
1811     puts $filehighlight $id
1812 }
1813
1814 proc readfhighlight {} {
1815     global filehighlight fhighlights commitrow curview mainfont iddrawn
1816
1817     set n [gets $filehighlight line]
1818     if {$n < 0} {
1819         if {[eof $filehighlight]} {
1820             # strange...
1821             puts "oops, git-diff-tree died"
1822             catch {close $filehighlight}
1823             unset filehighlight
1824         }
1825         return
1826     }
1827     set line [string trim $line]
1828     if {$line eq {}} return
1829     if {![info exists commitrow($curview,$line)]} return
1830     set row $commitrow($curview,$line)
1831     if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1832         bolden $row [concat $mainfont bold]
1833     }
1834     set fhighlights($row) 1
1835 }
1836
1837 proc hnames_change {name ix op} {
1838     global highlight_names nhighlights nhl_names mainfont
1839
1840     # delete previous highlights, if any
1841     set rows [array names nhighlights]
1842     if {$rows ne {}} {
1843         foreach row $rows {
1844             if {$nhighlights($row) >= 2} {
1845                 bolden_name $row $mainfont
1846             }
1847         }
1848         unset nhighlights
1849         unbolden $rows
1850     }
1851     if {[catch {set nhl_names [shellsplit $highlight_names]}]} {
1852         set nhl_names {}
1853         return
1854     }
1855     drawvisible
1856 }
1857
1858 proc asknamehighlight {row id} {
1859     global nhl_names nhighlights commitinfo iddrawn mainfont
1860
1861     if {![info exists commitinfo($id)]} {
1862         getcommit $id
1863     }
1864     set isbold 0
1865     set author [lindex $commitinfo($id) 1]
1866     set committer [lindex $commitinfo($id) 3]
1867     foreach name $nhl_names {
1868         set pattern "*$name*"
1869         if {[string match -nocase $pattern $author]} {
1870             set isbold 2
1871             break
1872         }
1873         if {!$isbold && [string match -nocase $pattern $committer]} {
1874             set isbold 1
1875         }
1876     }
1877     if {[info exists iddrawn($id)]} {
1878         if {$isbold && ![ishighlighted $row]} {
1879             bolden $row [concat $mainfont bold]
1880         }
1881         if {$isbold >= 2} {
1882             bolden_name $row [concat $mainfont bold]
1883         }
1884     }
1885     set nhighlights($row) $isbold
1886 }
1887
1888 # Graph layout functions
1889
1890 proc shortids {ids} {
1891     set res {}
1892     foreach id $ids {
1893         if {[llength $id] > 1} {
1894             lappend res [shortids $id]
1895         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1896             lappend res [string range $id 0 7]
1897         } else {
1898             lappend res $id
1899         }
1900     }
1901     return $res
1902 }
1903
1904 proc incrange {l x o} {
1905     set n [llength $l]
1906     while {$x < $n} {
1907         set e [lindex $l $x]
1908         if {$e ne {}} {
1909             lset l $x [expr {$e + $o}]
1910         }
1911         incr x
1912     }
1913     return $l
1914 }
1915
1916 proc ntimes {n o} {
1917     set ret {}
1918     for {} {$n > 0} {incr n -1} {
1919         lappend ret $o
1920     }
1921     return $ret
1922 }
1923
1924 proc usedinrange {id l1 l2} {
1925     global children commitrow childlist curview
1926
1927     if {[info exists commitrow($curview,$id)]} {
1928         set r $commitrow($curview,$id)
1929         if {$l1 <= $r && $r <= $l2} {
1930             return [expr {$r - $l1 + 1}]
1931         }
1932         set kids [lindex $childlist $r]
1933     } else {
1934         set kids $children($curview,$id)
1935     }
1936     foreach c $kids {
1937         set r $commitrow($curview,$c)
1938         if {$l1 <= $r && $r <= $l2} {
1939             return [expr {$r - $l1 + 1}]
1940         }
1941     }
1942     return 0
1943 }
1944
1945 proc sanity {row {full 0}} {
1946     global rowidlist rowoffsets
1947
1948     set col -1
1949     set ids [lindex $rowidlist $row]
1950     foreach id $ids {
1951         incr col
1952         if {$id eq {}} continue
1953         if {$col < [llength $ids] - 1 &&
1954             [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1955             puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1956         }
1957         set o [lindex $rowoffsets $row $col]
1958         set y $row
1959         set x $col
1960         while {$o ne {}} {
1961             incr y -1
1962             incr x $o
1963             if {[lindex $rowidlist $y $x] != $id} {
1964                 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1965                 puts "  id=[shortids $id] check started at row $row"
1966                 for {set i $row} {$i >= $y} {incr i -1} {
1967                     puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1968                 }
1969                 break
1970             }
1971             if {!$full} break
1972             set o [lindex $rowoffsets $y $x]
1973         }
1974     }
1975 }
1976
1977 proc makeuparrow {oid x y z} {
1978     global rowidlist rowoffsets uparrowlen idrowranges
1979
1980     for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1981         incr y -1
1982         incr x $z
1983         set off0 [lindex $rowoffsets $y]
1984         for {set x0 $x} {1} {incr x0} {
1985             if {$x0 >= [llength $off0]} {
1986                 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1987                 break
1988             }
1989             set z [lindex $off0 $x0]
1990             if {$z ne {}} {
1991                 incr x0 $z
1992                 break
1993             }
1994         }
1995         set z [expr {$x0 - $x}]
1996         lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1997         lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1998     }
1999     set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2000     lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2001     lappend idrowranges($oid) $y
2002 }
2003
2004 proc initlayout {} {
2005     global rowidlist rowoffsets displayorder commitlisted
2006     global rowlaidout rowoptim
2007     global idinlist rowchk rowrangelist idrowranges
2008     global numcommits canvxmax canv
2009     global nextcolor
2010     global parentlist childlist children
2011     global colormap rowtextx
2012     global linesegends
2013
2014     set numcommits 0
2015     set displayorder {}
2016     set commitlisted {}
2017     set parentlist {}
2018     set childlist {}
2019     set rowrangelist {}
2020     set nextcolor 0
2021     set rowidlist {{}}
2022     set rowoffsets {{}}
2023     catch {unset idinlist}
2024     catch {unset rowchk}
2025     set rowlaidout 0
2026     set rowoptim 0
2027     set canvxmax [$canv cget -width]
2028     catch {unset colormap}
2029     catch {unset rowtextx}
2030     catch {unset idrowranges}
2031     set linesegends {}
2032 }
2033
2034 proc setcanvscroll {} {
2035     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2036
2037     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2038     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2039     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2040     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2041 }
2042
2043 proc visiblerows {} {
2044     global canv numcommits linespc
2045
2046     set ymax [lindex [$canv cget -scrollregion] 3]
2047     if {$ymax eq {} || $ymax == 0} return
2048     set f [$canv yview]
2049     set y0 [expr {int([lindex $f 0] * $ymax)}]
2050     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2051     if {$r0 < 0} {
2052         set r0 0
2053     }
2054     set y1 [expr {int([lindex $f 1] * $ymax)}]
2055     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2056     if {$r1 >= $numcommits} {
2057         set r1 [expr {$numcommits - 1}]
2058     }
2059     return [list $r0 $r1]
2060 }
2061
2062 proc layoutmore {} {
2063     global rowlaidout rowoptim commitidx numcommits optim_delay
2064     global uparrowlen curview
2065
2066     set row $rowlaidout
2067     set rowlaidout [layoutrows $row $commitidx($curview) 0]
2068     set orow [expr {$rowlaidout - $uparrowlen - 1}]
2069     if {$orow > $rowoptim} {
2070         optimize_rows $rowoptim 0 $orow
2071         set rowoptim $orow
2072     }
2073     set canshow [expr {$rowoptim - $optim_delay}]
2074     if {$canshow > $numcommits} {
2075         showstuff $canshow
2076     }
2077 }
2078
2079 proc showstuff {canshow} {
2080     global numcommits commitrow pending_select selectedline
2081     global linesegends idrowranges idrangedrawn curview
2082
2083     if {$numcommits == 0} {
2084         global phase
2085         set phase "incrdraw"
2086         allcanvs delete all
2087     }
2088     set row $numcommits
2089     set numcommits $canshow
2090     setcanvscroll
2091     set rows [visiblerows]
2092     set r0 [lindex $rows 0]
2093     set r1 [lindex $rows 1]
2094     set selrow -1
2095     for {set r $row} {$r < $canshow} {incr r} {
2096         foreach id [lindex $linesegends [expr {$r+1}]] {
2097             set i -1
2098             foreach {s e} [rowranges $id] {
2099                 incr i
2100                 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2101                     && ![info exists idrangedrawn($id,$i)]} {
2102                     drawlineseg $id $i
2103                     set idrangedrawn($id,$i) 1
2104                 }
2105             }
2106         }
2107     }
2108     if {$canshow > $r1} {
2109         set canshow $r1
2110     }
2111     while {$row < $canshow} {
2112         drawcmitrow $row
2113         incr row
2114     }
2115     if {[info exists pending_select] &&
2116         [info exists commitrow($curview,$pending_select)] &&
2117         $commitrow($curview,$pending_select) < $numcommits} {
2118         selectline $commitrow($curview,$pending_select) 1
2119     }
2120     if {![info exists selectedline] && ![info exists pending_select]} {
2121         selectline 0 1
2122     }
2123 }
2124
2125 proc layoutrows {row endrow last} {
2126     global rowidlist rowoffsets displayorder
2127     global uparrowlen downarrowlen maxwidth mingaplen
2128     global childlist parentlist
2129     global idrowranges linesegends
2130     global commitidx curview
2131     global idinlist rowchk rowrangelist
2132
2133     set idlist [lindex $rowidlist $row]
2134     set offs [lindex $rowoffsets $row]
2135     while {$row < $endrow} {
2136         set id [lindex $displayorder $row]
2137         set oldolds {}
2138         set newolds {}
2139         foreach p [lindex $parentlist $row] {
2140             if {![info exists idinlist($p)]} {
2141                 lappend newolds $p
2142             } elseif {!$idinlist($p)} {
2143                 lappend oldolds $p
2144             }
2145         }
2146         set lse {}
2147         set nev [expr {[llength $idlist] + [llength $newolds]
2148                        + [llength $oldolds] - $maxwidth + 1}]
2149         if {$nev > 0} {
2150             if {!$last &&
2151                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2152             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2153                 set i [lindex $idlist $x]
2154                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2155                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2156                                [expr {$row + $uparrowlen + $mingaplen}]]
2157                     if {$r == 0} {
2158                         set idlist [lreplace $idlist $x $x]
2159                         set offs [lreplace $offs $x $x]
2160                         set offs [incrange $offs $x 1]
2161                         set idinlist($i) 0
2162                         set rm1 [expr {$row - 1}]
2163                         lappend lse $i
2164                         lappend idrowranges($i) $rm1
2165                         if {[incr nev -1] <= 0} break
2166                         continue
2167                     }
2168                     set rowchk($id) [expr {$row + $r}]
2169                 }
2170             }
2171             lset rowidlist $row $idlist
2172             lset rowoffsets $row $offs
2173         }
2174         lappend linesegends $lse
2175         set col [lsearch -exact $idlist $id]
2176         if {$col < 0} {
2177             set col [llength $idlist]
2178             lappend idlist $id
2179             lset rowidlist $row $idlist
2180             set z {}
2181             if {[lindex $childlist $row] ne {}} {
2182                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2183                 unset idinlist($id)
2184             }
2185             lappend offs $z
2186             lset rowoffsets $row $offs
2187             if {$z ne {}} {
2188                 makeuparrow $id $col $row $z
2189             }
2190         } else {
2191             unset idinlist($id)
2192         }
2193         set ranges {}
2194         if {[info exists idrowranges($id)]} {
2195             set ranges $idrowranges($id)
2196             lappend ranges $row
2197             unset idrowranges($id)
2198         }
2199         lappend rowrangelist $ranges
2200         incr row
2201         set offs [ntimes [llength $idlist] 0]
2202         set l [llength $newolds]
2203         set idlist [eval lreplace \$idlist $col $col $newolds]
2204         set o 0
2205         if {$l != 1} {
2206             set offs [lrange $offs 0 [expr {$col - 1}]]
2207             foreach x $newolds {
2208                 lappend offs {}
2209                 incr o -1
2210             }
2211             incr o
2212             set tmp [expr {[llength $idlist] - [llength $offs]}]
2213             if {$tmp > 0} {
2214                 set offs [concat $offs [ntimes $tmp $o]]
2215             }
2216         } else {
2217             lset offs $col {}
2218         }
2219         foreach i $newolds {
2220             set idinlist($i) 1
2221             set idrowranges($i) $row
2222         }
2223         incr col $l
2224         foreach oid $oldolds {
2225             set idinlist($oid) 1
2226             set idlist [linsert $idlist $col $oid]
2227             set offs [linsert $offs $col $o]
2228             makeuparrow $oid $col $row $o
2229             incr col
2230         }
2231         lappend rowidlist $idlist
2232         lappend rowoffsets $offs
2233     }
2234     return $row
2235 }
2236
2237 proc addextraid {id row} {
2238     global displayorder commitrow commitinfo
2239     global commitidx commitlisted
2240     global parentlist childlist children curview
2241
2242     incr commitidx($curview)
2243     lappend displayorder $id
2244     lappend commitlisted 0
2245     lappend parentlist {}
2246     set commitrow($curview,$id) $row
2247     readcommit $id
2248     if {![info exists commitinfo($id)]} {
2249         set commitinfo($id) {"No commit information available"}
2250     }
2251     if {![info exists children($curview,$id)]} {
2252         set children($curview,$id) {}
2253     }
2254     lappend childlist $children($curview,$id)
2255 }
2256
2257 proc layouttail {} {
2258     global rowidlist rowoffsets idinlist commitidx curview
2259     global idrowranges rowrangelist
2260
2261     set row $commitidx($curview)
2262     set idlist [lindex $rowidlist $row]
2263     while {$idlist ne {}} {
2264         set col [expr {[llength $idlist] - 1}]
2265         set id [lindex $idlist $col]
2266         addextraid $id $row
2267         unset idinlist($id)
2268         lappend idrowranges($id) $row
2269         lappend rowrangelist $idrowranges($id)
2270         unset idrowranges($id)
2271         incr row
2272         set offs [ntimes $col 0]
2273         set idlist [lreplace $idlist $col $col]
2274         lappend rowidlist $idlist
2275         lappend rowoffsets $offs
2276     }
2277
2278     foreach id [array names idinlist] {
2279         addextraid $id $row
2280         lset rowidlist $row [list $id]
2281         lset rowoffsets $row 0
2282         makeuparrow $id 0 $row 0
2283         lappend idrowranges($id) $row
2284         lappend rowrangelist $idrowranges($id)
2285         unset idrowranges($id)
2286         incr row
2287         lappend rowidlist {}
2288         lappend rowoffsets {}
2289     }
2290 }
2291
2292 proc insert_pad {row col npad} {
2293     global rowidlist rowoffsets
2294
2295     set pad [ntimes $npad {}]
2296     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2297     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2298     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2299 }
2300
2301 proc optimize_rows {row col endrow} {
2302     global rowidlist rowoffsets idrowranges displayorder
2303
2304     for {} {$row < $endrow} {incr row} {
2305         set idlist [lindex $rowidlist $row]
2306         set offs [lindex $rowoffsets $row]
2307         set haspad 0
2308         for {} {$col < [llength $offs]} {incr col} {
2309             if {[lindex $idlist $col] eq {}} {
2310                 set haspad 1
2311                 continue
2312             }
2313             set z [lindex $offs $col]
2314             if {$z eq {}} continue
2315             set isarrow 0
2316             set x0 [expr {$col + $z}]
2317             set y0 [expr {$row - 1}]
2318             set z0 [lindex $rowoffsets $y0 $x0]
2319             if {$z0 eq {}} {
2320                 set id [lindex $idlist $col]
2321                 set ranges [rowranges $id]
2322                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2323                     set isarrow 1
2324                 }
2325             }
2326             if {$z < -1 || ($z < 0 && $isarrow)} {
2327                 set npad [expr {-1 - $z + $isarrow}]
2328                 set offs [incrange $offs $col $npad]
2329                 insert_pad $y0 $x0 $npad
2330                 if {$y0 > 0} {
2331                     optimize_rows $y0 $x0 $row
2332                 }
2333                 set z [lindex $offs $col]
2334                 set x0 [expr {$col + $z}]
2335                 set z0 [lindex $rowoffsets $y0 $x0]
2336             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2337                 set npad [expr {$z - 1 + $isarrow}]
2338                 set y1 [expr {$row + 1}]
2339                 set offs2 [lindex $rowoffsets $y1]
2340                 set x1 -1
2341                 foreach z $offs2 {
2342                     incr x1
2343                     if {$z eq {} || $x1 + $z < $col} continue
2344                     if {$x1 + $z > $col} {
2345                         incr npad
2346                     }
2347                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2348                     break
2349                 }
2350                 set pad [ntimes $npad {}]
2351                 set idlist [eval linsert \$idlist $col $pad]
2352                 set tmp [eval linsert \$offs $col $pad]
2353                 incr col $npad
2354                 set offs [incrange $tmp $col [expr {-$npad}]]
2355                 set z [lindex $offs $col]
2356                 set haspad 1
2357             }
2358             if {$z0 eq {} && !$isarrow} {
2359                 # this line links to its first child on row $row-2
2360                 set rm2 [expr {$row - 2}]
2361                 set id [lindex $displayorder $rm2]
2362                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2363                 if {$xc >= 0} {
2364                     set z0 [expr {$xc - $x0}]
2365                 }
2366             }
2367             if {$z0 ne {} && $z < 0 && $z0 > 0} {
2368                 insert_pad $y0 $x0 1
2369                 set offs [incrange $offs $col 1]
2370                 optimize_rows $y0 [expr {$x0 + 1}] $row
2371             }
2372         }
2373         if {!$haspad} {
2374             set o {}
2375             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2376                 set o [lindex $offs $col]
2377                 if {$o eq {}} {
2378                     # check if this is the link to the first child
2379                     set id [lindex $idlist $col]
2380                     set ranges [rowranges $id]
2381                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
2382                         # it is, work out offset to child
2383                         set y0 [expr {$row - 1}]
2384                         set id [lindex $displayorder $y0]
2385                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2386                         if {$x0 >= 0} {
2387                             set o [expr {$x0 - $col}]
2388                         }
2389                     }
2390                 }
2391                 if {$o eq {} || $o <= 0} break
2392             }
2393             if {$o ne {} && [incr col] < [llength $idlist]} {
2394                 set y1 [expr {$row + 1}]
2395                 set offs2 [lindex $rowoffsets $y1]
2396                 set x1 -1
2397                 foreach z $offs2 {
2398                     incr x1
2399                     if {$z eq {} || $x1 + $z < $col} continue
2400                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
2401                     break
2402                 }
2403                 set idlist [linsert $idlist $col {}]
2404                 set tmp [linsert $offs $col {}]
2405                 incr col
2406                 set offs [incrange $tmp $col -1]
2407             }
2408         }
2409         lset rowidlist $row $idlist
2410         lset rowoffsets $row $offs
2411         set col 0
2412     }
2413 }
2414
2415 proc xc {row col} {
2416     global canvx0 linespc
2417     return [expr {$canvx0 + $col * $linespc}]
2418 }
2419
2420 proc yc {row} {
2421     global canvy0 linespc
2422     return [expr {$canvy0 + $row * $linespc}]
2423 }
2424
2425 proc linewidth {id} {
2426     global thickerline lthickness
2427
2428     set wid $lthickness
2429     if {[info exists thickerline] && $id eq $thickerline} {
2430         set wid [expr {2 * $lthickness}]
2431     }
2432     return $wid
2433 }
2434
2435 proc rowranges {id} {
2436     global phase idrowranges commitrow rowlaidout rowrangelist curview
2437
2438     set ranges {}
2439     if {$phase eq {} ||
2440         ([info exists commitrow($curview,$id)]
2441          && $commitrow($curview,$id) < $rowlaidout)} {
2442         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2443     } elseif {[info exists idrowranges($id)]} {
2444         set ranges $idrowranges($id)
2445     }
2446     return $ranges
2447 }
2448
2449 proc drawlineseg {id i} {
2450     global rowoffsets rowidlist
2451     global displayorder
2452     global canv colormap linespc
2453     global numcommits commitrow curview
2454
2455     set ranges [rowranges $id]
2456     set downarrow 1
2457     if {[info exists commitrow($curview,$id)]
2458         && $commitrow($curview,$id) < $numcommits} {
2459         set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2460     } else {
2461         set downarrow 1
2462     }
2463     set startrow [lindex $ranges [expr {2 * $i}]]
2464     set row [lindex $ranges [expr {2 * $i + 1}]]
2465     if {$startrow == $row} return
2466     assigncolor $id
2467     set coords {}
2468     set col [lsearch -exact [lindex $rowidlist $row] $id]
2469     if {$col < 0} {
2470         puts "oops: drawline: id $id not on row $row"
2471         return
2472     }
2473     set lasto {}
2474     set ns 0
2475     while {1} {
2476         set o [lindex $rowoffsets $row $col]
2477         if {$o eq {}} break
2478         if {$o ne $lasto} {
2479             # changing direction
2480             set x [xc $row $col]
2481             set y [yc $row]
2482             lappend coords $x $y
2483             set lasto $o
2484         }
2485         incr col $o
2486         incr row -1
2487     }
2488     set x [xc $row $col]
2489     set y [yc $row]
2490     lappend coords $x $y
2491     if {$i == 0} {
2492         # draw the link to the first child as part of this line
2493         incr row -1
2494         set child [lindex $displayorder $row]
2495         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2496         if {$ccol >= 0} {
2497             set x [xc $row $ccol]
2498             set y [yc $row]
2499             if {$ccol < $col - 1} {
2500                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2501             } elseif {$ccol > $col + 1} {
2502                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2503             }
2504             lappend coords $x $y
2505         }
2506     }
2507     if {[llength $coords] < 4} return
2508     if {$downarrow} {
2509         # This line has an arrow at the lower end: check if the arrow is
2510         # on a diagonal segment, and if so, work around the Tk 8.4
2511         # refusal to draw arrows on diagonal lines.
2512         set x0 [lindex $coords 0]
2513         set x1 [lindex $coords 2]
2514         if {$x0 != $x1} {
2515             set y0 [lindex $coords 1]
2516             set y1 [lindex $coords 3]
2517             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2518                 # we have a nearby vertical segment, just trim off the diag bit
2519                 set coords [lrange $coords 2 end]
2520             } else {
2521                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2522                 set xi [expr {$x0 - $slope * $linespc / 2}]
2523                 set yi [expr {$y0 - $linespc / 2}]
2524                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2525             }
2526         }
2527     }
2528     set arrow [expr {2 * ($i > 0) + $downarrow}]
2529     set arrow [lindex {none first last both} $arrow]
2530     set t [$canv create line $coords -width [linewidth $id] \
2531                -fill $colormap($id) -tags lines.$id -arrow $arrow]
2532     $canv lower $t
2533     bindline $t $id
2534 }
2535
2536 proc drawparentlinks {id row col olds} {
2537     global rowidlist canv colormap
2538
2539     set row2 [expr {$row + 1}]
2540     set x [xc $row $col]
2541     set y [yc $row]
2542     set y2 [yc $row2]
2543     set ids [lindex $rowidlist $row2]
2544     # rmx = right-most X coord used
2545     set rmx 0
2546     foreach p $olds {
2547         set i [lsearch -exact $ids $p]
2548         if {$i < 0} {
2549             puts "oops, parent $p of $id not in list"
2550             continue
2551         }
2552         set x2 [xc $row2 $i]
2553         if {$x2 > $rmx} {
2554             set rmx $x2
2555         }
2556         set ranges [rowranges $p]
2557         if {$ranges ne {} && $row2 == [lindex $ranges 0]
2558             && $row2 < [lindex $ranges 1]} {
2559             # drawlineseg will do this one for us
2560             continue
2561         }
2562         assigncolor $p
2563         # should handle duplicated parents here...
2564         set coords [list $x $y]
2565         if {$i < $col - 1} {
2566             lappend coords [xc $row [expr {$i + 1}]] $y
2567         } elseif {$i > $col + 1} {
2568             lappend coords [xc $row [expr {$i - 1}]] $y
2569         }
2570         lappend coords $x2 $y2
2571         set t [$canv create line $coords -width [linewidth $p] \
2572                    -fill $colormap($p) -tags lines.$p]
2573         $canv lower $t
2574         bindline $t $p
2575     }
2576     return $rmx
2577 }
2578
2579 proc drawlines {id} {
2580     global colormap canv
2581     global idrangedrawn
2582     global children iddrawn commitrow rowidlist curview
2583
2584     $canv delete lines.$id
2585     set nr [expr {[llength [rowranges $id]] / 2}]
2586     for {set i 0} {$i < $nr} {incr i} {
2587         if {[info exists idrangedrawn($id,$i)]} {
2588             drawlineseg $id $i
2589         }
2590     }
2591     foreach child $children($curview,$id) {
2592         if {[info exists iddrawn($child)]} {
2593             set row $commitrow($curview,$child)
2594             set col [lsearch -exact [lindex $rowidlist $row] $child]
2595             if {$col >= 0} {
2596                 drawparentlinks $child $row $col [list $id]
2597             }
2598         }
2599     }
2600 }
2601
2602 proc drawcmittext {id row col rmx} {
2603     global linespc canv canv2 canv3 canvy0
2604     global commitlisted commitinfo rowidlist
2605     global rowtextx idpos idtags idheads idotherrefs
2606     global linehtag linentag linedtag
2607     global mainfont canvxmax
2608
2609     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2610     set x [xc $row $col]
2611     set y [yc $row]
2612     set orad [expr {$linespc / 3}]
2613     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2614                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2615                -fill $ofill -outline black -width 1]
2616     $canv raise $t
2617     $canv bind $t <1> {selcanvline {} %x %y}
2618     set xt [xc $row [llength [lindex $rowidlist $row]]]
2619     if {$xt < $rmx} {
2620         set xt $rmx
2621     }
2622     set rowtextx($row) $xt
2623     set idpos($id) [list $x $xt $y]
2624     if {[info exists idtags($id)] || [info exists idheads($id)]
2625         || [info exists idotherrefs($id)]} {
2626         set xt [drawtags $id $x $xt $y]
2627     }
2628     set headline [lindex $commitinfo($id) 0]
2629     set name [lindex $commitinfo($id) 1]
2630     set date [lindex $commitinfo($id) 2]
2631     set date [formatdate $date]
2632     set font $mainfont
2633     set nfont $mainfont
2634     set isbold [ishighlighted $row]
2635     if {$isbold > 0} {
2636         lappend font bold
2637         if {$isbold > 1} {
2638             lappend nfont bold
2639         }
2640     }
2641     set linehtag($row) [$canv create text $xt $y -anchor w \
2642                             -text $headline -font $font]
2643     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2644     set linentag($row) [$canv2 create text 3 $y -anchor w \
2645                             -text $name -font $nfont]
2646     set linedtag($row) [$canv3 create text 3 $y -anchor w \
2647                             -text $date -font $mainfont]
2648     set xr [expr {$xt + [font measure $mainfont $headline]}]
2649     if {$xr > $canvxmax} {
2650         set canvxmax $xr
2651         setcanvscroll
2652     }
2653 }
2654
2655 proc drawcmitrow {row} {
2656     global displayorder rowidlist
2657     global idrangedrawn iddrawn
2658     global commitinfo parentlist numcommits
2659     global filehighlight fhighlights nhl_names nhighlights
2660     global hlview vhighlights
2661
2662     if {$row >= $numcommits} return
2663     foreach id [lindex $rowidlist $row] {
2664         if {$id eq {}} continue
2665         set i -1
2666         foreach {s e} [rowranges $id] {
2667             incr i
2668             if {$row < $s} continue
2669             if {$e eq {}} break
2670             if {$row <= $e} {
2671                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2672                     drawlineseg $id $i
2673                     set idrangedrawn($id,$i) 1
2674                 }
2675                 break
2676             }
2677         }
2678     }
2679
2680     set id [lindex $displayorder $row]
2681     if {[info exists hlview] && ![info exists vhighlights($row)]} {
2682         askvhighlight $row $id
2683     }
2684     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2685         askfilehighlight $row $id
2686     }
2687     if {$nhl_names ne {} && ![info exists nhighlights($row)]} {
2688         asknamehighlight $row $id
2689     }
2690     if {[info exists iddrawn($id)]} return
2691     set col [lsearch -exact [lindex $rowidlist $row] $id]
2692     if {$col < 0} {
2693         puts "oops, row $row id $id not in list"
2694         return
2695     }
2696     if {![info exists commitinfo($id)]} {
2697         getcommit $id
2698     }
2699     assigncolor $id
2700     set olds [lindex $parentlist $row]
2701     if {$olds ne {}} {
2702         set rmx [drawparentlinks $id $row $col $olds]
2703     } else {
2704         set rmx 0
2705     }
2706     drawcmittext $id $row $col $rmx
2707     set iddrawn($id) 1
2708 }
2709
2710 proc drawfrac {f0 f1} {
2711     global numcommits canv
2712     global linespc
2713
2714     set ymax [lindex [$canv cget -scrollregion] 3]
2715     if {$ymax eq {} || $ymax == 0} return
2716     set y0 [expr {int($f0 * $ymax)}]
2717     set row [expr {int(($y0 - 3) / $linespc) - 1}]
2718     if {$row < 0} {
2719         set row 0
2720     }
2721     set y1 [expr {int($f1 * $ymax)}]
2722     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2723     if {$endrow >= $numcommits} {
2724         set endrow [expr {$numcommits - 1}]
2725     }
2726     for {} {$row <= $endrow} {incr row} {
2727         drawcmitrow $row
2728     }
2729 }
2730
2731 proc drawvisible {} {
2732     global canv
2733     eval drawfrac [$canv yview]
2734 }
2735
2736 proc clear_display {} {
2737     global iddrawn idrangedrawn
2738     global vhighlights fhighlights nhighlights
2739
2740     allcanvs delete all
2741     catch {unset iddrawn}
2742     catch {unset idrangedrawn}
2743     catch {unset vhighlights}
2744     catch {unset fhighlights}
2745     catch {unset nhighlights}
2746 }
2747
2748 proc findcrossings {id} {
2749     global rowidlist parentlist numcommits rowoffsets displayorder
2750
2751     set cross {}
2752     set ccross {}
2753     foreach {s e} [rowranges $id] {
2754         if {$e >= $numcommits} {
2755             set e [expr {$numcommits - 1}]
2756         }
2757         if {$e <= $s} continue
2758         set x [lsearch -exact [lindex $rowidlist $e] $id]
2759         if {$x < 0} {
2760             puts "findcrossings: oops, no [shortids $id] in row $e"
2761             continue
2762         }
2763         for {set row $e} {[incr row -1] >= $s} {} {
2764             set olds [lindex $parentlist $row]
2765             set kid [lindex $displayorder $row]
2766             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2767             if {$kidx < 0} continue
2768             set nextrow [lindex $rowidlist [expr {$row + 1}]]
2769             foreach p $olds {
2770                 set px [lsearch -exact $nextrow $p]
2771                 if {$px < 0} continue
2772                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2773                     if {[lsearch -exact $ccross $p] >= 0} continue
2774                     if {$x == $px + ($kidx < $px? -1: 1)} {
2775                         lappend ccross $p
2776                     } elseif {[lsearch -exact $cross $p] < 0} {
2777                         lappend cross $p
2778                     }
2779                 }
2780             }
2781             set inc [lindex $rowoffsets $row $x]
2782             if {$inc eq {}} break
2783             incr x $inc
2784         }
2785     }
2786     return [concat $ccross {{}} $cross]
2787 }
2788
2789 proc assigncolor {id} {
2790     global colormap colors nextcolor
2791     global commitrow parentlist children children curview
2792
2793     if {[info exists colormap($id)]} return
2794     set ncolors [llength $colors]
2795     if {[info exists children($curview,$id)]} {
2796         set kids $children($curview,$id)
2797     } else {
2798         set kids {}
2799     }
2800     if {[llength $kids] == 1} {
2801         set child [lindex $kids 0]
2802         if {[info exists colormap($child)]
2803             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2804             set colormap($id) $colormap($child)
2805             return
2806         }
2807     }
2808     set badcolors {}
2809     set origbad {}
2810     foreach x [findcrossings $id] {
2811         if {$x eq {}} {
2812             # delimiter between corner crossings and other crossings
2813             if {[llength $badcolors] >= $ncolors - 1} break
2814             set origbad $badcolors
2815         }
2816         if {[info exists colormap($x)]
2817             && [lsearch -exact $badcolors $colormap($x)] < 0} {
2818             lappend badcolors $colormap($x)
2819         }
2820     }
2821     if {[llength $badcolors] >= $ncolors} {
2822         set badcolors $origbad
2823     }
2824     set origbad $badcolors
2825     if {[llength $badcolors] < $ncolors - 1} {
2826         foreach child $kids {
2827             if {[info exists colormap($child)]
2828                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2829                 lappend badcolors $colormap($child)
2830             }
2831             foreach p [lindex $parentlist $commitrow($curview,$child)] {
2832                 if {[info exists colormap($p)]
2833                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
2834                     lappend badcolors $colormap($p)
2835                 }
2836             }
2837         }
2838         if {[llength $badcolors] >= $ncolors} {
2839             set badcolors $origbad
2840         }
2841     }
2842     for {set i 0} {$i <= $ncolors} {incr i} {
2843         set c [lindex $colors $nextcolor]
2844         if {[incr nextcolor] >= $ncolors} {
2845             set nextcolor 0
2846         }
2847         if {[lsearch -exact $badcolors $c]} break
2848     }
2849     set colormap($id) $c
2850 }
2851
2852 proc bindline {t id} {
2853     global canv
2854
2855     $canv bind $t <Enter> "lineenter %x %y $id"
2856     $canv bind $t <Motion> "linemotion %x %y $id"
2857     $canv bind $t <Leave> "lineleave $id"
2858     $canv bind $t <Button-1> "lineclick %x %y $id 1"
2859 }
2860
2861 proc drawtags {id x xt y1} {
2862     global idtags idheads idotherrefs
2863     global linespc lthickness
2864     global canv mainfont commitrow rowtextx curview
2865
2866     set marks {}
2867     set ntags 0
2868     set nheads 0
2869     if {[info exists idtags($id)]} {
2870         set marks $idtags($id)
2871         set ntags [llength $marks]
2872     }
2873     if {[info exists idheads($id)]} {
2874         set marks [concat $marks $idheads($id)]
2875         set nheads [llength $idheads($id)]
2876     }
2877     if {[info exists idotherrefs($id)]} {
2878         set marks [concat $marks $idotherrefs($id)]
2879     }
2880     if {$marks eq {}} {
2881         return $xt
2882     }
2883
2884     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2885     set yt [expr {$y1 - 0.5 * $linespc}]
2886     set yb [expr {$yt + $linespc - 1}]
2887     set xvals {}
2888     set wvals {}
2889     foreach tag $marks {
2890         set wid [font measure $mainfont $tag]
2891         lappend xvals $xt
2892         lappend wvals $wid
2893         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2894     }
2895     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2896                -width $lthickness -fill black -tags tag.$id]
2897     $canv lower $t
2898     foreach tag $marks x $xvals wid $wvals {
2899         set xl [expr {$x + $delta}]
2900         set xr [expr {$x + $delta + $wid + $lthickness}]
2901         if {[incr ntags -1] >= 0} {
2902             # draw a tag
2903             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2904                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2905                        -width 1 -outline black -fill yellow -tags tag.$id]
2906             $canv bind $t <1> [list showtag $tag 1]
2907             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2908         } else {
2909             # draw a head or other ref
2910             if {[incr nheads -1] >= 0} {
2911                 set col green
2912             } else {
2913                 set col "#ddddff"
2914             }
2915             set xl [expr {$xl - $delta/2}]
2916             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2917                 -width 1 -outline black -fill $col -tags tag.$id
2918             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2919                 set rwid [font measure $mainfont $remoteprefix]
2920                 set xi [expr {$x + 1}]
2921                 set yti [expr {$yt + 1}]
2922                 set xri [expr {$x + $rwid}]
2923                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2924                         -width 0 -fill "#ffddaa" -tags tag.$id
2925             }
2926         }
2927         set t [$canv create text $xl $y1 -anchor w -text $tag \
2928                    -font $mainfont -tags tag.$id]
2929         if {$ntags >= 0} {
2930             $canv bind $t <1> [list showtag $tag 1]
2931         }
2932     }
2933     return $xt
2934 }
2935
2936 proc xcoord {i level ln} {
2937     global canvx0 xspc1 xspc2
2938
2939     set x [expr {$canvx0 + $i * $xspc1($ln)}]
2940     if {$i > 0 && $i == $level} {
2941         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2942     } elseif {$i > $level} {
2943         set x [expr {$x + $xspc2 - $xspc1($ln)}]
2944     }
2945     return $x
2946 }
2947
2948 proc show_status {msg} {
2949     global canv mainfont
2950
2951     clear_display
2952     $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2953 }
2954
2955 proc finishcommits {} {
2956     global commitidx phase curview
2957     global canv mainfont ctext maincursor textcursor
2958     global findinprogress pending_select
2959
2960     if {$commitidx($curview) > 0} {
2961         drawrest
2962     } else {
2963         show_status "No commits selected"
2964     }
2965     set phase {}
2966     catch {unset pending_select}
2967 }
2968
2969 # Don't change the text pane cursor if it is currently the hand cursor,
2970 # showing that we are over a sha1 ID link.
2971 proc settextcursor {c} {
2972     global ctext curtextcursor
2973
2974     if {[$ctext cget -cursor] == $curtextcursor} {
2975         $ctext config -cursor $c
2976     }
2977     set curtextcursor $c
2978 }
2979
2980 proc nowbusy {what} {
2981     global isbusy
2982
2983     if {[array names isbusy] eq {}} {
2984         . config -cursor watch
2985         settextcursor watch
2986     }
2987     set isbusy($what) 1
2988 }
2989
2990 proc notbusy {what} {
2991     global isbusy maincursor textcursor
2992
2993     catch {unset isbusy($what)}
2994     if {[array names isbusy] eq {}} {
2995         . config -cursor $maincursor
2996         settextcursor $textcursor
2997     }
2998 }
2999
3000 proc drawrest {} {
3001     global numcommits
3002     global startmsecs
3003     global canvy0 numcommits linespc
3004     global rowlaidout commitidx curview
3005     global pending_select
3006
3007     set row $rowlaidout
3008     layoutrows $rowlaidout $commitidx($curview) 1
3009     layouttail
3010     optimize_rows $row 0 $commitidx($curview)
3011     showstuff $commitidx($curview)
3012     if {[info exists pending_select]} {
3013         selectline 0 1
3014     }
3015
3016     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3017     #puts "overall $drawmsecs ms for $numcommits commits"
3018 }
3019
3020 proc findmatches {f} {
3021     global findtype foundstring foundstrlen
3022     if {$findtype == "Regexp"} {
3023         set matches [regexp -indices -all -inline $foundstring $f]
3024     } else {
3025         if {$findtype == "IgnCase"} {
3026             set str [string tolower $f]
3027         } else {
3028             set str $f
3029         }
3030         set matches {}
3031         set i 0
3032         while {[set j [string first $foundstring $str $i]] >= 0} {
3033             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3034             set i [expr {$j + $foundstrlen}]
3035         }
3036     }
3037     return $matches
3038 }
3039
3040 proc dofind {} {
3041     global findtype findloc findstring markedmatches commitinfo
3042     global numcommits displayorder linehtag linentag linedtag
3043     global mainfont canv canv2 canv3 selectedline
3044     global matchinglines foundstring foundstrlen matchstring
3045     global commitdata
3046
3047     stopfindproc
3048     unmarkmatches
3049     focus .
3050     set matchinglines {}
3051     if {$findloc == "Pickaxe"} {
3052         findpatches
3053         return
3054     }
3055     if {$findtype == "IgnCase"} {
3056         set foundstring [string tolower $findstring]
3057     } else {
3058         set foundstring $findstring
3059     }
3060     set foundstrlen [string length $findstring]
3061     if {$foundstrlen == 0} return
3062     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3063     set matchstring "*$matchstring*"
3064     if {$findloc == "Files"} {
3065         findfiles
3066         return
3067     }
3068     if {![info exists selectedline]} {
3069         set oldsel -1
3070     } else {
3071         set oldsel $selectedline
3072     }
3073     set didsel 0
3074     set fldtypes {Headline Author Date Committer CDate Comment}
3075     set l -1
3076     foreach id $displayorder {
3077         set d $commitdata($id)
3078         incr l
3079         if {$findtype == "Regexp"} {
3080             set doesmatch [regexp $foundstring $d]
3081         } elseif {$findtype == "IgnCase"} {
3082             set doesmatch [string match -nocase $matchstring $d]
3083         } else {
3084             set doesmatch [string match $matchstring $d]
3085         }
3086         if {!$doesmatch} continue
3087         if {![info exists commitinfo($id)]} {
3088             getcommit $id
3089         }
3090         set info $commitinfo($id)
3091         set doesmatch 0
3092         foreach f $info ty $fldtypes {
3093             if {$findloc != "All fields" && $findloc != $ty} {
3094                 continue
3095             }
3096             set matches [findmatches $f]
3097             if {$matches == {}} continue
3098             set doesmatch 1
3099             if {$ty == "Headline"} {
3100                 drawcmitrow $l
3101                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3102             } elseif {$ty == "Author"} {
3103                 drawcmitrow $l
3104                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3105             } elseif {$ty == "Date"} {
3106                 drawcmitrow $l
3107                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3108             }
3109         }
3110         if {$doesmatch} {
3111             lappend matchinglines $l
3112             if {!$didsel && $l > $oldsel} {
3113                 findselectline $l
3114                 set didsel 1
3115             }
3116         }
3117     }
3118     if {$matchinglines == {}} {
3119         bell
3120     } elseif {!$didsel} {
3121         findselectline [lindex $matchinglines 0]
3122     }
3123 }
3124
3125 proc findselectline {l} {
3126     global findloc commentend ctext
3127     selectline $l 1
3128     if {$findloc == "All fields" || $findloc == "Comments"} {
3129         # highlight the matches in the comments
3130         set f [$ctext get 1.0 $commentend]
3131         set matches [findmatches $f]
3132         foreach match $matches {
3133             set start [lindex $match 0]
3134             set end [expr {[lindex $match 1] + 1}]
3135             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3136         }
3137     }
3138 }
3139
3140 proc findnext {restart} {
3141     global matchinglines selectedline
3142     if {![info exists matchinglines]} {
3143         if {$restart} {
3144             dofind
3145         }
3146         return
3147     }
3148     if {![info exists selectedline]} return
3149     foreach l $matchinglines {
3150         if {$l > $selectedline} {
3151             findselectline $l
3152             return
3153         }
3154     }
3155     bell
3156 }
3157
3158 proc findprev {} {
3159     global matchinglines selectedline
3160     if {![info exists matchinglines]} {
3161         dofind
3162         return
3163     }
3164     if {![info exists selectedline]} return
3165     set prev {}
3166     foreach l $matchinglines {
3167         if {$l >= $selectedline} break
3168         set prev $l
3169     }
3170     if {$prev != {}} {
3171         findselectline $prev
3172     } else {
3173         bell
3174     }
3175 }
3176
3177 proc findlocchange {name ix op} {
3178     global findloc findtype findtypemenu
3179     if {$findloc == "Pickaxe"} {
3180         set findtype Exact
3181         set state disabled
3182     } else {
3183         set state normal
3184     }
3185     $findtypemenu entryconf 1 -state $state
3186     $findtypemenu entryconf 2 -state $state
3187 }
3188
3189 proc stopfindproc {{done 0}} {
3190     global findprocpid findprocfile findids
3191     global ctext findoldcursor phase maincursor textcursor
3192     global findinprogress
3193
3194     catch {unset findids}
3195     if {[info exists findprocpid]} {
3196         if {!$done} {
3197             catch {exec kill $findprocpid}
3198         }
3199         catch {close $findprocfile}
3200         unset findprocpid
3201     }
3202     catch {unset findinprogress}
3203     notbusy find
3204 }
3205
3206 proc findpatches {} {
3207     global findstring selectedline numcommits
3208     global findprocpid findprocfile
3209     global finddidsel ctext displayorder findinprogress
3210     global findinsertpos
3211
3212     if {$numcommits == 0} return
3213
3214     # make a list of all the ids to search, starting at the one
3215     # after the selected line (if any)
3216     if {[info exists selectedline]} {
3217         set l $selectedline
3218     } else {
3219         set l -1
3220     }
3221     set inputids {}
3222     for {set i 0} {$i < $numcommits} {incr i} {
3223         if {[incr l] >= $numcommits} {
3224             set l 0
3225         }
3226         append inputids [lindex $displayorder $l] "\n"
3227     }
3228
3229     if {[catch {
3230         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
3231                          << $inputids] r]
3232     } err]} {
3233         error_popup "Error starting search process: $err"
3234         return
3235     }
3236
3237     set findinsertpos end
3238     set findprocfile $f
3239     set findprocpid [pid $f]
3240     fconfigure $f -blocking 0
3241     fileevent $f readable readfindproc
3242     set finddidsel 0
3243     nowbusy find
3244     set findinprogress 1
3245 }
3246
3247 proc readfindproc {} {
3248     global findprocfile finddidsel
3249     global commitrow matchinglines findinsertpos curview
3250
3251     set n [gets $findprocfile line]
3252     if {$n < 0} {
3253         if {[eof $findprocfile]} {
3254             stopfindproc 1
3255             if {!$finddidsel} {
3256                 bell
3257             }
3258         }
3259         return
3260     }
3261     if {![regexp {^[0-9a-f]{40}} $line id]} {
3262         error_popup "Can't parse git-diff-tree output: $line"
3263         stopfindproc
3264         return
3265     }
3266     if {![info exists commitrow($curview,$id)]} {
3267         puts stderr "spurious id: $id"
3268         return
3269     }
3270     set l $commitrow($curview,$id)
3271     insertmatch $l $id
3272 }
3273
3274 proc insertmatch {l id} {
3275     global matchinglines findinsertpos finddidsel
3276
3277     if {$findinsertpos == "end"} {
3278         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
3279             set matchinglines [linsert $matchinglines 0 $l]
3280             set findinsertpos 1
3281         } else {
3282             lappend matchinglines $l
3283         }
3284     } else {
3285         set matchinglines [linsert $matchinglines $findinsertpos $l]
3286         incr findinsertpos
3287     }
3288     markheadline $l $id
3289     if {!$finddidsel} {
3290         findselectline $l
3291         set finddidsel 1
3292     }
3293 }
3294
3295 proc findfiles {} {
3296     global selectedline numcommits displayorder ctext
3297     global ffileline finddidsel parentlist
3298     global findinprogress findstartline findinsertpos
3299     global treediffs fdiffid fdiffsneeded fdiffpos
3300     global findmergefiles
3301
3302     if {$numcommits == 0} return
3303
3304     if {[info exists selectedline]} {
3305         set l [expr {$selectedline + 1}]
3306     } else {
3307         set l 0
3308     }
3309     set ffileline $l
3310     set findstartline $l
3311     set diffsneeded {}
3312     set fdiffsneeded {}
3313     while 1 {
3314         set id [lindex $displayorder $l]
3315         if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3316             if {![info exists treediffs($id)]} {
3317                 append diffsneeded "$id\n"
3318                 lappend fdiffsneeded $id
3319             }
3320         }
3321         if {[incr l] >= $numcommits} {
3322             set l 0
3323         }
3324         if {$l == $findstartline} break
3325     }
3326
3327     # start off a git-diff-tree process if needed
3328     if {$diffsneeded ne {}} {
3329         if {[catch {
3330             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3331         } err ]} {
3332             error_popup "Error starting search process: $err"
3333             return
3334         }
3335         catch {unset fdiffid}
3336         set fdiffpos 0
3337         fconfigure $df -blocking 0
3338         fileevent $df readable [list readfilediffs $df]
3339     }
3340
3341     set finddidsel 0
3342     set findinsertpos end
3343     set id [lindex $displayorder $l]
3344     nowbusy find
3345     set findinprogress 1
3346     findcont
3347     update
3348 }
3349
3350 proc readfilediffs {df} {
3351     global findid fdiffid fdiffs
3352
3353     set n [gets $df line]
3354     if {$n < 0} {
3355         if {[eof $df]} {
3356             donefilediff
3357             if {[catch {close $df} err]} {
3358                 stopfindproc
3359                 bell
3360                 error_popup "Error in git-diff-tree: $err"
3361             } elseif {[info exists findid]} {
3362                 set id $findid
3363                 stopfindproc
3364                 bell
3365                 error_popup "Couldn't find diffs for $id"
3366             }
3367         }
3368         return
3369     }
3370     if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3371         # start of a new string of diffs
3372         donefilediff
3373         set fdiffid $id
3374         set fdiffs {}
3375     } elseif {[string match ":*" $line]} {
3376         lappend fdiffs [lindex $line 5]
3377     }
3378 }
3379
3380 proc donefilediff {} {
3381     global fdiffid fdiffs treediffs findid
3382     global fdiffsneeded fdiffpos
3383
3384     if {[info exists fdiffid]} {
3385         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3386                && $fdiffpos < [llength $fdiffsneeded]} {
3387             # git-diff-tree doesn't output anything for a commit
3388             # which doesn't change anything
3389             set nullid [lindex $fdiffsneeded $fdiffpos]
3390             set treediffs($nullid) {}
3391             if {[info exists findid] && $nullid eq $findid} {
3392                 unset findid
3393                 findcont
3394             }
3395             incr fdiffpos
3396         }
3397         incr fdiffpos
3398
3399         if {![info exists treediffs($fdiffid)]} {
3400             set treediffs($fdiffid) $fdiffs
3401         }
3402         if {[info exists findid] && $fdiffid eq $findid} {
3403             unset findid
3404             findcont
3405         }
3406     }
3407 }
3408
3409 proc findcont {} {
3410     global findid treediffs parentlist
3411     global ffileline findstartline finddidsel
3412     global displayorder numcommits matchinglines findinprogress
3413     global findmergefiles
3414
3415     set l $ffileline
3416     while {1} {
3417         set id [lindex $displayorder $l]
3418         if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3419             if {![info exists treediffs($id)]} {
3420                 set findid $id
3421                 set ffileline $l
3422                 return
3423             }
3424             set doesmatch 0
3425             foreach f $treediffs($id) {
3426                 set x [findmatches $f]
3427                 if {$x != {}} {
3428                     set doesmatch 1
3429                     break
3430                 }
3431             }
3432             if {$doesmatch} {
3433                 insertmatch $l $id
3434             }
3435         }
3436         if {[incr l] >= $numcommits} {
3437             set l 0
3438         }
3439         if {$l == $findstartline} break
3440     }
3441     stopfindproc
3442     if {!$finddidsel} {
3443         bell
3444     }
3445 }
3446
3447 # mark a commit as matching by putting a yellow background
3448 # behind the headline
3449 proc markheadline {l id} {
3450     global canv mainfont linehtag
3451
3452     drawcmitrow $l
3453     set bbox [$canv bbox $linehtag($l)]
3454     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3455     $canv lower $t
3456 }
3457
3458 # mark the bits of a headline, author or date that match a find string
3459 proc markmatches {canv l str tag matches font} {
3460     set bbox [$canv bbox $tag]
3461     set x0 [lindex $bbox 0]
3462     set y0 [lindex $bbox 1]
3463     set y1 [lindex $bbox 3]
3464     foreach match $matches {
3465         set start [lindex $match 0]
3466         set end [lindex $match 1]
3467         if {$start > $end} continue
3468         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3469         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3470         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3471                    [expr {$x0+$xlen+2}] $y1 \
3472                    -outline {} -tags matches -fill yellow]
3473         $canv lower $t
3474     }
3475 }
3476
3477 proc unmarkmatches {} {
3478     global matchinglines findids
3479     allcanvs delete matches
3480     catch {unset matchinglines}
3481     catch {unset findids}
3482 }
3483
3484 proc selcanvline {w x y} {
3485     global canv canvy0 ctext linespc
3486     global rowtextx
3487     set ymax [lindex [$canv cget -scrollregion] 3]
3488     if {$ymax == {}} return
3489     set yfrac [lindex [$canv yview] 0]
3490     set y [expr {$y + $yfrac * $ymax}]
3491     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3492     if {$l < 0} {
3493         set l 0
3494     }
3495     if {$w eq $canv} {
3496         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3497     }
3498     unmarkmatches
3499     selectline $l 1
3500 }
3501
3502 proc commit_descriptor {p} {
3503     global commitinfo
3504     if {![info exists commitinfo($p)]} {
3505         getcommit $p
3506     }
3507     set l "..."
3508     if {[llength $commitinfo($p)] > 1} {
3509         set l [lindex $commitinfo($p) 0]
3510     }
3511     return "$p ($l)"
3512 }
3513
3514 # append some text to the ctext widget, and make any SHA1 ID
3515 # that we know about be a clickable link.
3516 proc appendwithlinks {text} {
3517     global ctext commitrow linknum curview
3518
3519     set start [$ctext index "end - 1c"]
3520     $ctext insert end $text
3521     $ctext insert end "\n"
3522     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3523     foreach l $links {
3524         set s [lindex $l 0]
3525         set e [lindex $l 1]
3526         set linkid [string range $text $s $e]
3527         if {![info exists commitrow($curview,$linkid)]} continue
3528         incr e
3529         $ctext tag add link "$start + $s c" "$start + $e c"
3530         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3531         $ctext tag bind link$linknum <1> \
3532             [list selectline $commitrow($curview,$linkid) 1]
3533         incr linknum
3534     }
3535     $ctext tag conf link -foreground blue -underline 1
3536     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3537     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3538 }
3539
3540 proc viewnextline {dir} {
3541     global canv linespc
3542
3543     $canv delete hover
3544     set ymax [lindex [$canv cget -scrollregion] 3]
3545     set wnow [$canv yview]
3546     set wtop [expr {[lindex $wnow 0] * $ymax}]
3547     set newtop [expr {$wtop + $dir * $linespc}]
3548     if {$newtop < 0} {
3549         set newtop 0
3550     } elseif {$newtop > $ymax} {
3551         set newtop $ymax
3552     }
3553     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3554 }
3555
3556 proc selectline {l isnew} {
3557     global canv canv2 canv3 ctext commitinfo selectedline
3558     global displayorder linehtag linentag linedtag
3559     global canvy0 linespc parentlist childlist
3560     global currentid sha1entry
3561     global commentend idtags linknum
3562     global mergemax numcommits pending_select
3563     global cmitmode
3564
3565     catch {unset pending_select}
3566     $canv delete hover
3567     normalline
3568     if {$l < 0 || $l >= $numcommits} return
3569     set y [expr {$canvy0 + $l * $linespc}]
3570     set ymax [lindex [$canv cget -scrollregion] 3]
3571     set ytop [expr {$y - $linespc - 1}]
3572     set ybot [expr {$y + $linespc + 1}]
3573     set wnow [$canv yview]
3574     set wtop [expr {[lindex $wnow 0] * $ymax}]
3575     set wbot [expr {[lindex $wnow 1] * $ymax}]
3576     set wh [expr {$wbot - $wtop}]
3577     set newtop $wtop
3578     if {$ytop < $wtop} {
3579         if {$ybot < $wtop} {
3580             set newtop [expr {$y - $wh / 2.0}]
3581         } else {
3582             set newtop $ytop
3583             if {$newtop > $wtop - $linespc} {
3584                 set newtop [expr {$wtop - $linespc}]
3585             }
3586         }
3587     } elseif {$ybot > $wbot} {
3588         if {$ytop > $wbot} {
3589             set newtop [expr {$y - $wh / 2.0}]
3590         } else {
3591             set newtop [expr {$ybot - $wh}]
3592             if {$newtop < $wtop + $linespc} {
3593                 set newtop [expr {$wtop + $linespc}]
3594             }
3595         }
3596     }
3597     if {$newtop != $wtop} {
3598         if {$newtop < 0} {
3599             set newtop 0
3600         }
3601         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3602         drawvisible
3603     }
3604
3605     if {![info exists linehtag($l)]} return
3606     $canv delete secsel
3607     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3608                -tags secsel -fill [$canv cget -selectbackground]]
3609     $canv lower $t
3610     $canv2 delete secsel
3611     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3612                -tags secsel -fill [$canv2 cget -selectbackground]]
3613     $canv2 lower $t
3614     $canv3 delete secsel
3615     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3616                -tags secsel -fill [$canv3 cget -selectbackground]]
3617     $canv3 lower $t
3618
3619     if {$isnew} {
3620         addtohistory [list selectline $l 0]
3621     }
3622
3623     set selectedline $l
3624
3625     set id [lindex $displayorder $l]
3626     set currentid $id
3627     $sha1entry delete 0 end
3628     $sha1entry insert 0 $id
3629     $sha1entry selection from 0
3630     $sha1entry selection to end
3631
3632     $ctext conf -state normal
3633     $ctext delete 0.0 end
3634     set linknum 0
3635     set info $commitinfo($id)
3636     set date [formatdate [lindex $info 2]]
3637     $ctext insert end "Author: [lindex $info 1]  $date\n"
3638     set date [formatdate [lindex $info 4]]
3639     $ctext insert end "Committer: [lindex $info 3]  $date\n"
3640     if {[info exists idtags($id)]} {
3641         $ctext insert end "Tags:"
3642         foreach tag $idtags($id) {
3643             $ctext insert end " $tag"
3644         }
3645         $ctext insert end "\n"
3646     }
3647  
3648     set comment {}
3649     set olds [lindex $parentlist $l]
3650     if {[llength $olds] > 1} {
3651         set np 0
3652         foreach p $olds {
3653             if {$np >= $mergemax} {
3654                 set tag mmax
3655             } else {
3656                 set tag m$np
3657             }
3658             $ctext insert end "Parent: " $tag
3659             appendwithlinks [commit_descriptor $p]
3660             incr np
3661         }
3662     } else {
3663         foreach p $olds {
3664             append comment "Parent: [commit_descriptor $p]\n"
3665         }
3666     }
3667
3668     foreach c [lindex $childlist $l] {
3669         append comment "Child:  [commit_descriptor $c]\n"
3670     }
3671     append comment "\n"
3672     append comment [lindex $info 5]
3673
3674     # make anything that looks like a SHA1 ID be a clickable link
3675     appendwithlinks $comment
3676
3677     $ctext tag delete Comments
3678     $ctext tag remove found 1.0 end
3679     $ctext conf -state disabled
3680     set commentend [$ctext index "end - 1c"]
3681
3682     init_flist "Comments"
3683     if {$cmitmode eq "tree"} {
3684         gettree $id
3685     } elseif {[llength $olds] <= 1} {
3686         startdiff $id
3687     } else {
3688         mergediff $id $l
3689     }
3690 }
3691
3692 proc selfirstline {} {
3693     unmarkmatches
3694     selectline 0 1
3695 }
3696
3697 proc sellastline {} {
3698     global numcommits
3699     unmarkmatches
3700     set l [expr {$numcommits - 1}]
3701     selectline $l 1
3702 }
3703
3704 proc selnextline {dir} {
3705     global selectedline
3706     if {![info exists selectedline]} return
3707     set l [expr {$selectedline + $dir}]
3708     unmarkmatches
3709     selectline $l 1
3710 }
3711
3712 proc selnextpage {dir} {
3713     global canv linespc selectedline numcommits
3714
3715     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3716     if {$lpp < 1} {
3717         set lpp 1
3718     }
3719     allcanvs yview scroll [expr {$dir * $lpp}] units
3720     drawvisible
3721     if {![info exists selectedline]} return
3722     set l [expr {$selectedline + $dir * $lpp}]
3723     if {$l < 0} {
3724         set l 0
3725     } elseif {$l >= $numcommits} {
3726         set l [expr $numcommits - 1]
3727     }
3728     unmarkmatches
3729     selectline $l 1    
3730 }
3731
3732 proc unselectline {} {
3733     global selectedline currentid
3734
3735     catch {unset selectedline}
3736     catch {unset currentid}
3737     allcanvs delete secsel
3738 }
3739
3740 proc reselectline {} {
3741     global selectedline
3742
3743     if {[info exists selectedline]} {
3744         selectline $selectedline 0
3745     }
3746 }
3747
3748 proc addtohistory {cmd} {
3749     global history historyindex curview
3750
3751     set elt [list $curview $cmd]
3752     if {$historyindex > 0
3753         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3754         return
3755     }
3756
3757     if {$historyindex < [llength $history]} {
3758         set history [lreplace $history $historyindex end $elt]
3759     } else {
3760         lappend history $elt
3761     }
3762     incr historyindex
3763     if {$historyindex > 1} {
3764         .ctop.top.bar.leftbut conf -state normal
3765     } else {
3766         .ctop.top.bar.leftbut conf -state disabled
3767     }
3768     .ctop.top.bar.rightbut conf -state disabled
3769 }
3770
3771 proc godo {elt} {
3772     global curview
3773
3774     set view [lindex $elt 0]
3775     set cmd [lindex $elt 1]
3776     if {$curview != $view} {
3777         showview $view
3778     }
3779     eval $cmd
3780 }
3781
3782 proc goback {} {
3783     global history historyindex
3784
3785     if {$historyindex > 1} {
3786         incr historyindex -1
3787         godo [lindex $history [expr {$historyindex - 1}]]
3788         .ctop.top.bar.rightbut conf -state normal
3789     }
3790     if {$historyindex <= 1} {
3791         .ctop.top.bar.leftbut conf -state disabled
3792     }
3793 }
3794
3795 proc goforw {} {
3796     global history historyindex
3797
3798     if {$historyindex < [llength $history]} {
3799         set cmd [lindex $history $historyindex]
3800         incr historyindex
3801         godo $cmd
3802         .ctop.top.bar.leftbut conf -state normal
3803     }
3804     if {$historyindex >= [llength $history]} {
3805         .ctop.top.bar.rightbut conf -state disabled
3806     }
3807 }
3808
3809 proc gettree {id} {
3810     global treefilelist treeidlist diffids diffmergeid treepending
3811
3812     set diffids $id
3813     catch {unset diffmergeid}
3814     if {![info exists treefilelist($id)]} {
3815         if {![info exists treepending]} {
3816             if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3817                 return
3818             }
3819             set treepending $id
3820             set treefilelist($id) {}
3821             set treeidlist($id) {}
3822             fconfigure $gtf -blocking 0
3823             fileevent $gtf readable [list gettreeline $gtf $id]
3824         }
3825     } else {
3826         setfilelist $id
3827     }
3828 }
3829
3830 proc gettreeline {gtf id} {
3831     global treefilelist treeidlist treepending cmitmode diffids
3832
3833     while {[gets $gtf line] >= 0} {
3834         if {[lindex $line 1] ne "blob"} continue
3835         set sha1 [lindex $line 2]
3836         set fname [lindex $line 3]
3837         lappend treefilelist($id) $fname
3838         lappend treeidlist($id) $sha1
3839     }
3840     if {![eof $gtf]} return
3841     close $gtf
3842     unset treepending
3843     if {$cmitmode ne "tree"} {
3844         if {![info exists diffmergeid]} {
3845             gettreediffs $diffids
3846         }
3847     } elseif {$id ne $diffids} {
3848         gettree $diffids
3849     } else {
3850         setfilelist $id
3851     }
3852 }
3853
3854 proc showfile {f} {
3855     global treefilelist treeidlist diffids
3856     global ctext commentend
3857
3858     set i [lsearch -exact $treefilelist($diffids) $f]
3859     if {$i < 0} {
3860         puts "oops, $f not in list for id $diffids"
3861         return
3862     }
3863     set blob [lindex $treeidlist($diffids) $i]
3864     if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3865         puts "oops, error reading blob $blob: $err"
3866         return
3867     }
3868     fconfigure $bf -blocking 0
3869     fileevent $bf readable [list getblobline $bf $diffids]
3870     $ctext config -state normal
3871     $ctext delete $commentend end
3872     $ctext insert end "\n"
3873     $ctext insert end "$f\n" filesep
3874     $ctext config -state disabled
3875     $ctext yview $commentend
3876 }
3877
3878 proc getblobline {bf id} {
3879     global diffids cmitmode ctext
3880
3881     if {$id ne $diffids || $cmitmode ne "tree"} {
3882         catch {close $bf}
3883         return
3884     }
3885     $ctext config -state normal
3886     while {[gets $bf line] >= 0} {
3887         $ctext insert end "$line\n"
3888     }
3889     if {[eof $bf]} {
3890         # delete last newline
3891         $ctext delete "end - 2c" "end - 1c"
3892         close $bf
3893     }
3894     $ctext config -state disabled
3895 }
3896
3897 proc mergediff {id l} {
3898     global diffmergeid diffopts mdifffd
3899     global diffids
3900     global parentlist
3901
3902     set diffmergeid $id
3903     set diffids $id
3904     # this doesn't seem to actually affect anything...
3905     set env(GIT_DIFF_OPTS) $diffopts
3906     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3907     if {[catch {set mdf [open $cmd r]} err]} {
3908         error_popup "Error getting merge diffs: $err"
3909         return
3910     }
3911     fconfigure $mdf -blocking 0
3912     set mdifffd($id) $mdf
3913     set np [llength [lindex $parentlist $l]]
3914     fileevent $mdf readable [list getmergediffline $mdf $id $np]
3915     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3916 }
3917
3918 proc getmergediffline {mdf id np} {
3919     global diffmergeid ctext cflist nextupdate mergemax
3920     global difffilestart mdifffd
3921
3922     set n [gets $mdf line]
3923     if {$n < 0} {
3924         if {[eof $mdf]} {
3925             close $mdf
3926         }
3927         return
3928     }
3929     if {![info exists diffmergeid] || $id != $diffmergeid
3930         || $mdf != $mdifffd($id)} {
3931         return
3932     }
3933     $ctext conf -state normal
3934     if {[regexp {^diff --cc (.*)} $line match fname]} {
3935         # start of a new file
3936         $ctext insert end "\n"
3937         set here [$ctext index "end - 1c"]
3938         lappend difffilestart $here
3939         add_flist [list $fname]
3940         set l [expr {(78 - [string length $fname]) / 2}]
3941         set pad [string range "----------------------------------------" 1 $l]
3942         $ctext insert end "$pad $fname $pad\n" filesep
3943     } elseif {[regexp {^@@} $line]} {
3944         $ctext insert end "$line\n" hunksep
3945     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3946         # do nothing
3947     } else {
3948         # parse the prefix - one ' ', '-' or '+' for each parent
3949         set spaces {}
3950         set minuses {}
3951         set pluses {}
3952         set isbad 0
3953         for {set j 0} {$j < $np} {incr j} {
3954             set c [string range $line $j $j]
3955             if {$c == " "} {
3956                 lappend spaces $j
3957             } elseif {$c == "-"} {
3958                 lappend minuses $j
3959             } elseif {$c == "+"} {
3960                 lappend pluses $j
3961             } else {
3962                 set isbad 1
3963                 break
3964             }
3965         }
3966         set tags {}
3967         set num {}
3968         if {!$isbad && $minuses ne {} && $pluses eq {}} {
3969             # line doesn't appear in result, parents in $minuses have the line
3970             set num [lindex $minuses 0]
3971         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3972             # line appears in result, parents in $pluses don't have the line
3973             lappend tags mresult
3974             set num [lindex $spaces 0]
3975         }
3976         if {$num ne {}} {
3977             if {$num >= $mergemax} {
3978                 set num "max"
3979             }
3980             lappend tags m$num
3981         }
3982         $ctext insert end "$line\n" $tags
3983     }
3984     $ctext conf -state disabled
3985     if {[clock clicks -milliseconds] >= $nextupdate} {
3986         incr nextupdate 100
3987         fileevent $mdf readable {}
3988         update
3989         fileevent $mdf readable [list getmergediffline $mdf $id $np]
3990     }
3991 }
3992
3993 proc startdiff {ids} {
3994     global treediffs diffids treepending diffmergeid
3995
3996     set diffids $ids
3997     catch {unset diffmergeid}
3998     if {![info exists treediffs($ids)]} {
3999         if {![info exists treepending]} {
4000             gettreediffs $ids
4001         }
4002     } else {
4003         addtocflist $ids
4004     }
4005 }
4006
4007 proc addtocflist {ids} {
4008     global treediffs cflist
4009     add_flist $treediffs($ids)
4010     getblobdiffs $ids
4011 }
4012
4013 proc gettreediffs {ids} {
4014     global treediff treepending
4015     set treepending $ids
4016     set treediff {}
4017     if {[catch \
4018          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4019         ]} return
4020     fconfigure $gdtf -blocking 0
4021     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4022 }
4023
4024 proc gettreediffline {gdtf ids} {
4025     global treediff treediffs treepending diffids diffmergeid
4026     global cmitmode
4027
4028     set n [gets $gdtf line]
4029     if {$n < 0} {
4030         if {![eof $gdtf]} return
4031         close $gdtf
4032         set treediffs($ids) $treediff
4033         unset treepending
4034         if {$cmitmode eq "tree"} {
4035             gettree $diffids
4036         } elseif {$ids != $diffids} {
4037             if {![info exists diffmergeid]} {
4038                 gettreediffs $diffids
4039             }
4040         } else {
4041             addtocflist $ids
4042         }
4043         return
4044     }
4045     set file [lindex $line 5]
4046     lappend treediff $file
4047 }
4048
4049 proc getblobdiffs {ids} {
4050     global diffopts blobdifffd diffids env curdifftag curtagstart
4051     global nextupdate diffinhdr treediffs
4052
4053     set env(GIT_DIFF_OPTS) $diffopts
4054     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4055     if {[catch {set bdf [open $cmd r]} err]} {
4056         puts "error getting diffs: $err"
4057         return
4058     }
4059     set diffinhdr 0
4060     fconfigure $bdf -blocking 0
4061     set blobdifffd($ids) $bdf
4062     set curdifftag Comments
4063     set curtagstart 0.0
4064     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4065     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4066 }
4067
4068 proc setinlist {var i val} {
4069     global $var
4070
4071     while {[llength [set $var]] < $i} {
4072         lappend $var {}
4073     }
4074     if {[llength [set $var]] == $i} {
4075         lappend $var $val
4076     } else {
4077         lset $var $i $val
4078     }
4079 }
4080
4081 proc getblobdiffline {bdf ids} {
4082     global diffids blobdifffd ctext curdifftag curtagstart
4083     global diffnexthead diffnextnote difffilestart
4084     global nextupdate diffinhdr treediffs
4085
4086     set n [gets $bdf line]
4087     if {$n < 0} {
4088         if {[eof $bdf]} {
4089             close $bdf
4090             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4091                 $ctext tag add $curdifftag $curtagstart end
4092             }
4093         }
4094         return
4095     }
4096     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4097         return
4098     }
4099     $ctext conf -state normal
4100     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4101         # start of a new file
4102         $ctext insert end "\n"
4103         $ctext tag add $curdifftag $curtagstart end
4104         set here [$ctext index "end - 1c"]
4105         set curtagstart $here
4106         set header $newname
4107         set i [lsearch -exact $treediffs($ids) $fname]
4108         if {$i >= 0} {
4109             setinlist difffilestart $i $here
4110         }
4111         if {$newname ne $fname} {
4112             set i [lsearch -exact $treediffs($ids) $newname]
4113             if {$i >= 0} {
4114                 setinlist difffilestart $i $here
4115             }
4116         }
4117         set curdifftag "f:$fname"
4118         $ctext tag delete $curdifftag
4119         set l [expr {(78 - [string length $header]) / 2}]
4120         set pad [string range "----------------------------------------" 1 $l]
4121         $ctext insert end "$pad $header $pad\n" filesep
4122         set diffinhdr 1
4123     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4124         # do nothing
4125     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4126         set diffinhdr 0
4127     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4128                    $line match f1l f1c f2l f2c rest]} {
4129         $ctext insert end "$line\n" hunksep
4130         set diffinhdr 0
4131     } else {
4132         set x [string range $line 0 0]
4133         if {$x == "-" || $x == "+"} {
4134             set tag [expr {$x == "+"}]
4135             $ctext insert end "$line\n" d$tag
4136         } elseif {$x == " "} {
4137             $ctext insert end "$line\n"
4138         } elseif {$diffinhdr || $x == "\\"} {
4139             # e.g. "\ No newline at end of file"
4140             $ctext insert end "$line\n" filesep
4141         } else {
4142             # Something else we don't recognize
4143             if {$curdifftag != "Comments"} {
4144                 $ctext insert end "\n"
4145                 $ctext tag add $curdifftag $curtagstart end
4146                 set curtagstart [$ctext index "end - 1c"]
4147                 set curdifftag Comments
4148             }
4149             $ctext insert end "$line\n" filesep
4150         }
4151     }
4152     $ctext conf -state disabled
4153     if {[clock clicks -milliseconds] >= $nextupdate} {
4154         incr nextupdate 100
4155         fileevent $bdf readable {}
4156         update
4157         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4158     }
4159 }
4160
4161 proc nextfile {} {
4162     global difffilestart ctext
4163     set here [$ctext index @0,0]
4164     foreach loc $difffilestart {
4165         if {[$ctext compare $loc > $here]} {
4166             $ctext yview $loc
4167         }
4168     }
4169 }
4170
4171 proc setcoords {} {
4172     global linespc charspc canvx0 canvy0 mainfont
4173     global xspc1 xspc2 lthickness
4174
4175     set linespc [font metrics $mainfont -linespace]
4176     set charspc [font measure $mainfont "m"]
4177     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4178     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4179     set lthickness [expr {int($linespc / 9) + 1}]
4180     set xspc1(0) $linespc
4181     set xspc2 $linespc
4182 }
4183
4184 proc redisplay {} {
4185     global canv
4186     global selectedline
4187
4188     set ymax [lindex [$canv cget -scrollregion] 3]
4189     if {$ymax eq {} || $ymax == 0} return
4190     set span [$canv yview]
4191     clear_display
4192     setcanvscroll
4193     allcanvs yview moveto [lindex $span 0]
4194     drawvisible
4195     if {[info exists selectedline]} {
4196         selectline $selectedline 0
4197     }
4198 }
4199
4200 proc incrfont {inc} {
4201     global mainfont textfont ctext canv phase
4202     global stopped entries
4203     unmarkmatches
4204     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4205     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4206     setcoords
4207     $ctext conf -font $textfont
4208     $ctext tag conf filesep -font [concat $textfont bold]
4209     foreach e $entries {
4210         $e conf -font $mainfont
4211     }
4212     if {$phase eq "getcommits"} {
4213         $canv itemconf textitems -font $mainfont
4214     }
4215     redisplay
4216 }
4217
4218 proc clearsha1 {} {
4219     global sha1entry sha1string
4220     if {[string length $sha1string] == 40} {
4221         $sha1entry delete 0 end
4222     }
4223 }
4224
4225 proc sha1change {n1 n2 op} {
4226     global sha1string currentid sha1but
4227     if {$sha1string == {}
4228         || ([info exists currentid] && $sha1string == $currentid)} {
4229         set state disabled
4230     } else {
4231         set state normal
4232     }
4233     if {[$sha1but cget -state] == $state} return
4234     if {$state == "normal"} {
4235         $sha1but conf -state normal -relief raised -text "Goto: "
4236     } else {
4237         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4238     }
4239 }
4240
4241 proc gotocommit {} {
4242     global sha1string currentid commitrow tagids headids
4243     global displayorder numcommits curview
4244
4245     if {$sha1string == {}
4246         || ([info exists currentid] && $sha1string == $currentid)} return
4247     if {[info exists tagids($sha1string)]} {
4248         set id $tagids($sha1string)
4249     } elseif {[info exists headids($sha1string)]} {
4250         set id $headids($sha1string)
4251     } else {
4252         set id [string tolower $sha1string]
4253         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4254             set matches {}
4255             foreach i $displayorder {
4256                 if {[string match $id* $i]} {
4257                     lappend matches $i
4258                 }
4259             }
4260             if {$matches ne {}} {
4261                 if {[llength $matches] > 1} {
4262                     error_popup "Short SHA1 id $id is ambiguous"
4263                     return
4264                 }
4265                 set id [lindex $matches 0]
4266             }
4267         }
4268     }
4269     if {[info exists commitrow($curview,$id)]} {
4270         selectline $commitrow($curview,$id) 1
4271         return
4272     }
4273     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4274         set type "SHA1 id"
4275     } else {
4276         set type "Tag/Head"
4277     }
4278     error_popup "$type $sha1string is not known"
4279 }
4280
4281 proc lineenter {x y id} {
4282     global hoverx hovery hoverid hovertimer
4283     global commitinfo canv
4284
4285     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4286     set hoverx $x
4287     set hovery $y
4288     set hoverid $id
4289     if {[info exists hovertimer]} {
4290         after cancel $hovertimer
4291     }
4292     set hovertimer [after 500 linehover]
4293     $canv delete hover
4294 }
4295
4296 proc linemotion {x y id} {
4297     global hoverx hovery hoverid hovertimer
4298
4299     if {[info exists hoverid] && $id == $hoverid} {
4300         set hoverx $x
4301         set hovery $y
4302         if {[info exists hovertimer]} {
4303             after cancel $hovertimer
4304         }
4305         set hovertimer [after 500 linehover]
4306     }
4307 }
4308
4309 proc lineleave {id} {
4310     global hoverid hovertimer canv
4311
4312     if {[info exists hoverid] && $id == $hoverid} {
4313         $canv delete hover
4314         if {[info exists hovertimer]} {
4315             after cancel $hovertimer
4316             unset hovertimer
4317         }
4318         unset hoverid
4319     }
4320 }
4321
4322 proc linehover {} {
4323     global hoverx hovery hoverid hovertimer
4324     global canv linespc lthickness
4325     global commitinfo mainfont
4326
4327     set text [lindex $commitinfo($hoverid) 0]
4328     set ymax [lindex [$canv cget -scrollregion] 3]
4329     if {$ymax == {}} return
4330     set yfrac [lindex [$canv yview] 0]
4331     set x [expr {$hoverx + 2 * $linespc}]
4332     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4333     set x0 [expr {$x - 2 * $lthickness}]
4334     set y0 [expr {$y - 2 * $lthickness}]
4335     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4336     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4337     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4338                -fill \#ffff80 -outline black -width 1 -tags hover]
4339     $canv raise $t
4340     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4341     $canv raise $t
4342 }
4343
4344 proc clickisonarrow {id y} {
4345     global lthickness
4346
4347     set ranges [rowranges $id]
4348     set thresh [expr {2 * $lthickness + 6}]
4349     set n [expr {[llength $ranges] - 1}]
4350     for {set i 1} {$i < $n} {incr i} {
4351         set row [lindex $ranges $i]
4352         if {abs([yc $row] - $y) < $thresh} {
4353             return $i
4354         }
4355     }
4356     return {}
4357 }
4358
4359 proc arrowjump {id n y} {
4360     global canv
4361
4362     # 1 <-> 2, 3 <-> 4, etc...
4363     set n [expr {(($n - 1) ^ 1) + 1}]
4364     set row [lindex [rowranges $id] $n]
4365     set yt [yc $row]
4366     set ymax [lindex [$canv cget -scrollregion] 3]
4367     if {$ymax eq {} || $ymax <= 0} return
4368     set view [$canv yview]
4369     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4370     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4371     if {$yfrac < 0} {
4372         set yfrac 0
4373     }
4374     allcanvs yview moveto $yfrac
4375 }
4376
4377 proc lineclick {x y id isnew} {
4378     global ctext commitinfo children canv thickerline curview
4379
4380     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4381     unmarkmatches
4382     unselectline
4383     normalline
4384     $canv delete hover
4385     # draw this line thicker than normal
4386     set thickerline $id
4387     drawlines $id
4388     if {$isnew} {
4389         set ymax [lindex [$canv cget -scrollregion] 3]
4390         if {$ymax eq {}} return
4391         set yfrac [lindex [$canv yview] 0]
4392         set y [expr {$y + $yfrac * $ymax}]
4393     }
4394     set dirn [clickisonarrow $id $y]
4395     if {$dirn ne {}} {
4396         arrowjump $id $dirn $y
4397         return
4398     }
4399
4400     if {$isnew} {
4401         addtohistory [list lineclick $x $y $id 0]
4402     }
4403     # fill the details pane with info about this line
4404     $ctext conf -state normal
4405     $ctext delete 0.0 end
4406     $ctext tag conf link -foreground blue -underline 1
4407     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4408     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4409     $ctext insert end "Parent:\t"
4410     $ctext insert end $id [list link link0]
4411     $ctext tag bind link0 <1> [list selbyid $id]
4412     set info $commitinfo($id)
4413     $ctext insert end "\n\t[lindex $info 0]\n"
4414     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4415     set date [formatdate [lindex $info 2]]
4416     $ctext insert end "\tDate:\t$date\n"
4417     set kids $children($curview,$id)
4418     if {$kids ne {}} {
4419         $ctext insert end "\nChildren:"
4420         set i 0
4421         foreach child $kids {
4422             incr i
4423             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4424             set info $commitinfo($child)
4425             $ctext insert end "\n\t"
4426             $ctext insert end $child [list link link$i]
4427             $ctext tag bind link$i <1> [list selbyid $child]
4428             $ctext insert end "\n\t[lindex $info 0]"
4429             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4430             set date [formatdate [lindex $info 2]]
4431             $ctext insert end "\n\tDate:\t$date\n"
4432         }
4433     }
4434     $ctext conf -state disabled
4435     init_flist {}
4436 }
4437
4438 proc normalline {} {
4439     global thickerline
4440     if {[info exists thickerline]} {
4441         set id $thickerline
4442         unset thickerline
4443         drawlines $id
4444     }
4445 }
4446
4447 proc selbyid {id} {
4448     global commitrow curview
4449     if {[info exists commitrow($curview,$id)]} {
4450         selectline $commitrow($curview,$id) 1
4451     }
4452 }
4453
4454 proc mstime {} {
4455     global startmstime
4456     if {![info exists startmstime]} {
4457         set startmstime [clock clicks -milliseconds]
4458     }
4459     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4460 }
4461
4462 proc rowmenu {x y id} {
4463     global rowctxmenu commitrow selectedline rowmenuid curview
4464
4465     if {![info exists selectedline]
4466         || $commitrow($curview,$id) eq $selectedline} {
4467         set state disabled
4468     } else {
4469         set state normal
4470     }
4471     $rowctxmenu entryconfigure 0 -state $state
4472     $rowctxmenu entryconfigure 1 -state $state
4473     $rowctxmenu entryconfigure 2 -state $state
4474     set rowmenuid $id
4475     tk_popup $rowctxmenu $x $y
4476 }
4477
4478 proc diffvssel {dirn} {
4479     global rowmenuid selectedline displayorder
4480
4481     if {![info exists selectedline]} return
4482     if {$dirn} {
4483         set oldid [lindex $displayorder $selectedline]
4484         set newid $rowmenuid
4485     } else {
4486         set oldid $rowmenuid
4487         set newid [lindex $displayorder $selectedline]
4488     }
4489     addtohistory [list doseldiff $oldid $newid]
4490     doseldiff $oldid $newid
4491 }
4492
4493 proc doseldiff {oldid newid} {
4494     global ctext
4495     global commitinfo
4496
4497     $ctext conf -state normal
4498     $ctext delete 0.0 end
4499     init_flist "Top"
4500     $ctext insert end "From "
4501     $ctext tag conf link -foreground blue -underline 1
4502     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4503     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4504     $ctext tag bind link0 <1> [list selbyid $oldid]
4505     $ctext insert end $oldid [list link link0]
4506     $ctext insert end "\n     "
4507     $ctext insert end [lindex $commitinfo($oldid) 0]
4508     $ctext insert end "\n\nTo   "
4509     $ctext tag bind link1 <1> [list selbyid $newid]
4510     $ctext insert end $newid [list link link1]
4511     $ctext insert end "\n     "
4512     $ctext insert end [lindex $commitinfo($newid) 0]
4513     $ctext insert end "\n"
4514     $ctext conf -state disabled
4515     $ctext tag delete Comments
4516     $ctext tag remove found 1.0 end
4517     startdiff [list $oldid $newid]
4518 }
4519
4520 proc mkpatch {} {
4521     global rowmenuid currentid commitinfo patchtop patchnum
4522
4523     if {![info exists currentid]} return
4524     set oldid $currentid
4525     set oldhead [lindex $commitinfo($oldid) 0]
4526     set newid $rowmenuid
4527     set newhead [lindex $commitinfo($newid) 0]
4528     set top .patch
4529     set patchtop $top
4530     catch {destroy $top}
4531     toplevel $top
4532     label $top.title -text "Generate patch"
4533     grid $top.title - -pady 10
4534     label $top.from -text "From:"
4535     entry $top.fromsha1 -width 40 -relief flat
4536     $top.fromsha1 insert 0 $oldid
4537     $top.fromsha1 conf -state readonly
4538     grid $top.from $top.fromsha1 -sticky w
4539     entry $top.fromhead -width 60 -relief flat
4540     $top.fromhead insert 0 $oldhead
4541     $top.fromhead conf -state readonly
4542     grid x $top.fromhead -sticky w
4543     label $top.to -text "To:"
4544     entry $top.tosha1 -width 40 -relief flat
4545     $top.tosha1 insert 0 $newid
4546     $top.tosha1 conf -state readonly
4547     grid $top.to $top.tosha1 -sticky w
4548     entry $top.tohead -width 60 -relief flat
4549     $top.tohead insert 0 $newhead
4550     $top.tohead conf -state readonly
4551     grid x $top.tohead -sticky w
4552     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4553     grid $top.rev x -pady 10
4554     label $top.flab -text "Output file:"
4555     entry $top.fname -width 60
4556     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4557     incr patchnum
4558     grid $top.flab $top.fname -sticky w
4559     frame $top.buts
4560     button $top.buts.gen -text "Generate" -command mkpatchgo
4561     button $top.buts.can -text "Cancel" -command mkpatchcan
4562     grid $top.buts.gen $top.buts.can
4563     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4564     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4565     grid $top.buts - -pady 10 -sticky ew
4566     focus $top.fname
4567 }
4568
4569 proc mkpatchrev {} {
4570     global patchtop
4571
4572     set oldid [$patchtop.fromsha1 get]
4573     set oldhead [$patchtop.fromhead get]
4574     set newid [$patchtop.tosha1 get]
4575     set newhead [$patchtop.tohead get]
4576     foreach e [list fromsha1 fromhead tosha1 tohead] \
4577             v [list $newid $newhead $oldid $oldhead] {
4578         $patchtop.$e conf -state normal
4579         $patchtop.$e delete 0 end
4580         $patchtop.$e insert 0 $v
4581         $patchtop.$e conf -state readonly
4582     }
4583 }
4584
4585 proc mkpatchgo {} {
4586     global patchtop
4587
4588     set oldid [$patchtop.fromsha1 get]
4589     set newid [$patchtop.tosha1 get]
4590     set fname [$patchtop.fname get]
4591     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4592         error_popup "Error creating patch: $err"
4593     }
4594     catch {destroy $patchtop}
4595     unset patchtop
4596 }
4597
4598 proc mkpatchcan {} {
4599     global patchtop
4600
4601     catch {destroy $patchtop}
4602     unset patchtop
4603 }
4604
4605 proc mktag {} {
4606     global rowmenuid mktagtop commitinfo
4607
4608     set top .maketag
4609     set mktagtop $top
4610     catch {destroy $top}
4611     toplevel $top
4612     label $top.title -text "Create tag"
4613     grid $top.title - -pady 10
4614     label $top.id -text "ID:"
4615     entry $top.sha1 -width 40 -relief flat
4616     $top.sha1 insert 0 $rowmenuid
4617     $top.sha1 conf -state readonly
4618     grid $top.id $top.sha1 -sticky w
4619     entry $top.head -width 60 -relief flat
4620     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4621     $top.head conf -state readonly
4622     grid x $top.head -sticky w
4623     label $top.tlab -text "Tag name:"
4624     entry $top.tag -width 60
4625     grid $top.tlab $top.tag -sticky w
4626     frame $top.buts
4627     button $top.buts.gen -text "Create" -command mktaggo
4628     button $top.buts.can -text "Cancel" -command mktagcan
4629     grid $top.buts.gen $top.buts.can
4630     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4631     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4632     grid $top.buts - -pady 10 -sticky ew
4633     focus $top.tag
4634 }
4635
4636 proc domktag {} {
4637     global mktagtop env tagids idtags
4638
4639     set id [$mktagtop.sha1 get]
4640     set tag [$mktagtop.tag get]
4641     if {$tag == {}} {
4642         error_popup "No tag name specified"
4643         return
4644     }
4645     if {[info exists tagids($tag)]} {
4646         error_popup "Tag \"$tag\" already exists"
4647         return
4648     }
4649     if {[catch {
4650         set dir [gitdir]
4651         set fname [file join $dir "refs/tags" $tag]
4652         set f [open $fname w]
4653         puts $f $id
4654         close $f
4655     } err]} {
4656         error_popup "Error creating tag: $err"
4657         return
4658     }
4659
4660     set tagids($tag) $id
4661     lappend idtags($id) $tag
4662     redrawtags $id
4663 }
4664
4665 proc redrawtags {id} {
4666     global canv linehtag commitrow idpos selectedline curview
4667
4668     if {![info exists commitrow($curview,$id)]} return
4669     drawcmitrow $commitrow($curview,$id)
4670     $canv delete tag.$id
4671     set xt [eval drawtags $id $idpos($id)]
4672     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4673     if {[info exists selectedline]
4674         && $selectedline == $commitrow($curview,$id)} {
4675         selectline $selectedline 0
4676     }
4677 }
4678
4679 proc mktagcan {} {
4680     global mktagtop
4681
4682     catch {destroy $mktagtop}
4683     unset mktagtop
4684 }
4685
4686 proc mktaggo {} {
4687     domktag
4688     mktagcan
4689 }
4690
4691 proc writecommit {} {
4692     global rowmenuid wrcomtop commitinfo wrcomcmd
4693
4694     set top .writecommit
4695     set wrcomtop $top
4696     catch {destroy $top}
4697     toplevel $top
4698     label $top.title -text "Write commit to file"
4699     grid $top.title - -pady 10
4700     label $top.id -text "ID:"
4701     entry $top.sha1 -width 40 -relief flat
4702     $top.sha1 insert 0 $rowmenuid
4703     $top.sha1 conf -state readonly
4704     grid $top.id $top.sha1 -sticky w
4705     entry $top.head -width 60 -relief flat
4706     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4707     $top.head conf -state readonly
4708     grid x $top.head -sticky w
4709     label $top.clab -text "Command:"
4710     entry $top.cmd -width 60 -textvariable wrcomcmd
4711     grid $top.clab $top.cmd -sticky w -pady 10
4712     label $top.flab -text "Output file:"
4713     entry $top.fname -width 60
4714     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4715     grid $top.flab $top.fname -sticky w
4716     frame $top.buts
4717     button $top.buts.gen -text "Write" -command wrcomgo
4718     button $top.buts.can -text "Cancel" -command wrcomcan
4719     grid $top.buts.gen $top.buts.can
4720     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4721     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4722     grid $top.buts - -pady 10 -sticky ew
4723     focus $top.fname
4724 }
4725
4726 proc wrcomgo {} {
4727     global wrcomtop
4728
4729     set id [$wrcomtop.sha1 get]
4730     set cmd "echo $id | [$wrcomtop.cmd get]"
4731     set fname [$wrcomtop.fname get]
4732     if {[catch {exec sh -c $cmd >$fname &} err]} {
4733         error_popup "Error writing commit: $err"
4734     }
4735     catch {destroy $wrcomtop}
4736     unset wrcomtop
4737 }
4738
4739 proc wrcomcan {} {
4740     global wrcomtop
4741
4742     catch {destroy $wrcomtop}
4743     unset wrcomtop
4744 }
4745
4746 proc listrefs {id} {
4747     global idtags idheads idotherrefs
4748
4749     set x {}
4750     if {[info exists idtags($id)]} {
4751         set x $idtags($id)
4752     }
4753     set y {}
4754     if {[info exists idheads($id)]} {
4755         set y $idheads($id)
4756     }
4757     set z {}
4758     if {[info exists idotherrefs($id)]} {
4759         set z $idotherrefs($id)
4760     }
4761     return [list $x $y $z]
4762 }
4763
4764 proc rereadrefs {} {
4765     global idtags idheads idotherrefs
4766
4767     set refids [concat [array names idtags] \
4768                     [array names idheads] [array names idotherrefs]]
4769     foreach id $refids {
4770         if {![info exists ref($id)]} {
4771             set ref($id) [listrefs $id]
4772         }
4773     }
4774     readrefs
4775     set refids [lsort -unique [concat $refids [array names idtags] \
4776                         [array names idheads] [array names idotherrefs]]]
4777     foreach id $refids {
4778         set v [listrefs $id]
4779         if {![info exists ref($id)] || $ref($id) != $v} {
4780             redrawtags $id
4781         }
4782     }
4783 }
4784
4785 proc showtag {tag isnew} {
4786     global ctext tagcontents tagids linknum
4787
4788     if {$isnew} {
4789         addtohistory [list showtag $tag 0]
4790     }
4791     $ctext conf -state normal
4792     $ctext delete 0.0 end
4793     set linknum 0
4794     if {[info exists tagcontents($tag)]} {
4795         set text $tagcontents($tag)
4796     } else {
4797         set text "Tag: $tag\nId:  $tagids($tag)"
4798     }
4799     appendwithlinks $text
4800     $ctext conf -state disabled
4801     init_flist {}
4802 }
4803
4804 proc doquit {} {
4805     global stopped
4806     set stopped 100
4807     destroy .
4808 }
4809
4810 proc doprefs {} {
4811     global maxwidth maxgraphpct diffopts findmergefiles
4812     global oldprefs prefstop
4813
4814     set top .gitkprefs
4815     set prefstop $top
4816     if {[winfo exists $top]} {
4817         raise $top
4818         return
4819     }
4820     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4821         set oldprefs($v) [set $v]
4822     }
4823     toplevel $top
4824     wm title $top "Gitk preferences"
4825     label $top.ldisp -text "Commit list display options"
4826     grid $top.ldisp - -sticky w -pady 10
4827     label $top.spacer -text " "
4828     label $top.maxwidthl -text "Maximum graph width (lines)" \
4829         -font optionfont
4830     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4831     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4832     label $top.maxpctl -text "Maximum graph width (% of pane)" \
4833         -font optionfont
4834     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4835     grid x $top.maxpctl $top.maxpct -sticky w
4836     checkbutton $top.findm -variable findmergefiles
4837     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4838         -font optionfont
4839     grid $top.findm $top.findml - -sticky w
4840     label $top.ddisp -text "Diff display options"
4841     grid $top.ddisp - -sticky w -pady 10
4842     label $top.diffoptl -text "Options for diff program" \
4843         -font optionfont
4844     entry $top.diffopt -width 20 -textvariable diffopts
4845     grid x $top.diffoptl $top.diffopt -sticky w
4846     frame $top.buts
4847     button $top.buts.ok -text "OK" -command prefsok
4848     button $top.buts.can -text "Cancel" -command prefscan
4849     grid $top.buts.ok $top.buts.can
4850     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4851     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4852     grid $top.buts - - -pady 10 -sticky ew
4853 }
4854
4855 proc prefscan {} {
4856     global maxwidth maxgraphpct diffopts findmergefiles
4857     global oldprefs prefstop
4858
4859     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4860         set $v $oldprefs($v)
4861     }
4862     catch {destroy $prefstop}
4863     unset prefstop
4864 }
4865
4866 proc prefsok {} {
4867     global maxwidth maxgraphpct
4868     global oldprefs prefstop
4869
4870     catch {destroy $prefstop}
4871     unset prefstop
4872     if {$maxwidth != $oldprefs(maxwidth)
4873         || $maxgraphpct != $oldprefs(maxgraphpct)} {
4874         redisplay
4875     }
4876 }
4877
4878 proc formatdate {d} {
4879     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4880 }
4881
4882 # This list of encoding names and aliases is distilled from
4883 # http://www.iana.org/assignments/character-sets.
4884 # Not all of them are supported by Tcl.
4885 set encoding_aliases {
4886     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4887       ISO646-US US-ASCII us IBM367 cp367 csASCII }
4888     { ISO-10646-UTF-1 csISO10646UTF1 }
4889     { ISO_646.basic:1983 ref csISO646basic1983 }
4890     { INVARIANT csINVARIANT }
4891     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4892     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4893     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4894     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4895     { NATS-DANO iso-ir-9-1 csNATSDANO }
4896     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4897     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4898     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4899     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4900     { ISO-2022-KR csISO2022KR }
4901     { EUC-KR csEUCKR }
4902     { ISO-2022-JP csISO2022JP }
4903     { ISO-2022-JP-2 csISO2022JP2 }
4904     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4905       csISO13JISC6220jp }
4906     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4907     { IT iso-ir-15 ISO646-IT csISO15Italian }
4908     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4909     { ES iso-ir-17 ISO646-ES csISO17Spanish }
4910     { greek7-old iso-ir-18 csISO18Greek7Old }
4911     { latin-greek iso-ir-19 csISO19LatinGreek }
4912     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4913     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4914     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4915     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4916     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4917     { BS_viewdata iso-ir-47 csISO47BSViewdata }
4918     { INIS iso-ir-49 csISO49INIS }
4919     { INIS-8 iso-ir-50 csISO50INIS8 }
4920     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4921     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4922     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4923     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4924     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4925     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4926       csISO60Norwegian1 }
4927     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4928     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4929     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4930     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4931     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4932     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4933     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4934     { greek7 iso-ir-88 csISO88Greek7 }
4935     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4936     { iso-ir-90 csISO90 }
4937     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4938     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4939       csISO92JISC62991984b }
4940     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4941     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4942     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4943       csISO95JIS62291984handadd }
4944     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4945     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4946     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4947     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4948       CP819 csISOLatin1 }
4949     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4950     { T.61-7bit iso-ir-102 csISO102T617bit }
4951     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4952     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4953     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4954     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4955     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4956     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4957     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4958     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4959       arabic csISOLatinArabic }
4960     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4961     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4962     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4963       greek greek8 csISOLatinGreek }
4964     { T.101-G2 iso-ir-128 csISO128T101G2 }
4965     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4966       csISOLatinHebrew }
4967     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4968     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4969     { CSN_369103 iso-ir-139 csISO139CSN369103 }
4970     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4971     { ISO_6937-2-add iso-ir-142 csISOTextComm }
4972     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4973     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4974       csISOLatinCyrillic }
4975     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4976     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4977     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4978     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4979     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4980     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4981     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4982     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4983     { ISO_10367-box iso-ir-155 csISO10367Box }
4984     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4985     { latin-lap lap iso-ir-158 csISO158Lap }
4986     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4987     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4988     { us-dk csUSDK }
4989     { dk-us csDKUS }
4990     { JIS_X0201 X0201 csHalfWidthKatakana }
4991     { KSC5636 ISO646-KR csKSC5636 }
4992     { ISO-10646-UCS-2 csUnicode }
4993     { ISO-10646-UCS-4 csUCS4 }
4994     { DEC-MCS dec csDECMCS }
4995     { hp-roman8 roman8 r8 csHPRoman8 }
4996     { macintosh mac csMacintosh }
4997     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4998       csIBM037 }
4999     { IBM038 EBCDIC-INT cp038 csIBM038 }
5000     { IBM273 CP273 csIBM273 }
5001     { IBM274 EBCDIC-BE CP274 csIBM274 }
5002     { IBM275 EBCDIC-BR cp275 csIBM275 }
5003     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5004     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5005     { IBM280 CP280 ebcdic-cp-it csIBM280 }
5006     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5007     { IBM284 CP284 ebcdic-cp-es csIBM284 }
5008     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5009     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5010     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5011     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5012     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5013     { IBM424 cp424 ebcdic-cp-he csIBM424 }
5014     { IBM437 cp437 437 csPC8CodePage437 }
5015     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5016     { IBM775 cp775 csPC775Baltic }
5017     { IBM850 cp850 850 csPC850Multilingual }
5018     { IBM851 cp851 851 csIBM851 }
5019     { IBM852 cp852 852 csPCp852 }
5020     { IBM855 cp855 855 csIBM855 }
5021     { IBM857 cp857 857 csIBM857 }
5022     { IBM860 cp860 860 csIBM860 }
5023     { IBM861 cp861 861 cp-is csIBM861 }
5024     { IBM862 cp862 862 csPC862LatinHebrew }
5025     { IBM863 cp863 863 csIBM863 }
5026     { IBM864 cp864 csIBM864 }
5027     { IBM865 cp865 865 csIBM865 }
5028     { IBM866 cp866 866 csIBM866 }
5029     { IBM868 CP868 cp-ar csIBM868 }
5030     { IBM869 cp869 869 cp-gr csIBM869 }
5031     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5032     { IBM871 CP871 ebcdic-cp-is csIBM871 }
5033     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5034     { IBM891 cp891 csIBM891 }
5035     { IBM903 cp903 csIBM903 }
5036     { IBM904 cp904 904 csIBBM904 }
5037     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5038     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5039     { IBM1026 CP1026 csIBM1026 }
5040     { EBCDIC-AT-DE csIBMEBCDICATDE }
5041     { EBCDIC-AT-DE-A csEBCDICATDEA }
5042     { EBCDIC-CA-FR csEBCDICCAFR }
5043     { EBCDIC-DK-NO csEBCDICDKNO }
5044     { EBCDIC-DK-NO-A csEBCDICDKNOA }
5045     { EBCDIC-FI-SE csEBCDICFISE }
5046     { EBCDIC-FI-SE-A csEBCDICFISEA }
5047     { EBCDIC-FR csEBCDICFR }
5048     { EBCDIC-IT csEBCDICIT }
5049     { EBCDIC-PT csEBCDICPT }
5050     { EBCDIC-ES csEBCDICES }
5051     { EBCDIC-ES-A csEBCDICESA }
5052     { EBCDIC-ES-S csEBCDICESS }
5053     { EBCDIC-UK csEBCDICUK }
5054     { EBCDIC-US csEBCDICUS }
5055     { UNKNOWN-8BIT csUnknown8BiT }
5056     { MNEMONIC csMnemonic }
5057     { MNEM csMnem }
5058     { VISCII csVISCII }
5059     { VIQR csVIQR }
5060     { KOI8-R csKOI8R }
5061     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5062     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5063     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5064     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5065     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5066     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5067     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5068     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5069     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5070     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5071     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5072     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5073     { IBM1047 IBM-1047 }
5074     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5075     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5076     { UNICODE-1-1 csUnicode11 }
5077     { CESU-8 csCESU-8 }
5078     { BOCU-1 csBOCU-1 }
5079     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5080     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5081       l8 }
5082     { ISO-8859-15 ISO_8859-15 Latin-9 }
5083     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5084     { GBK CP936 MS936 windows-936 }
5085     { JIS_Encoding csJISEncoding }
5086     { Shift_JIS MS_Kanji csShiftJIS }
5087     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5088       EUC-JP }
5089     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5090     { ISO-10646-UCS-Basic csUnicodeASCII }
5091     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5092     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5093     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5094     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5095     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5096     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5097     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5098     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5099     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5100     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5101     { Adobe-Standard-Encoding csAdobeStandardEncoding }
5102     { Ventura-US csVenturaUS }
5103     { Ventura-International csVenturaInternational }
5104     { PC8-Danish-Norwegian csPC8DanishNorwegian }
5105     { PC8-Turkish csPC8Turkish }
5106     { IBM-Symbols csIBMSymbols }
5107     { IBM-Thai csIBMThai }
5108     { HP-Legal csHPLegal }
5109     { HP-Pi-font csHPPiFont }
5110     { HP-Math8 csHPMath8 }
5111     { Adobe-Symbol-Encoding csHPPSMath }
5112     { HP-DeskTop csHPDesktop }
5113     { Ventura-Math csVenturaMath }
5114     { Microsoft-Publishing csMicrosoftPublishing }
5115     { Windows-31J csWindows31J }
5116     { GB2312 csGB2312 }
5117     { Big5 csBig5 }
5118 }
5119
5120 proc tcl_encoding {enc} {
5121     global encoding_aliases
5122     set names [encoding names]
5123     set lcnames [string tolower $names]
5124     set enc [string tolower $enc]
5125     set i [lsearch -exact $lcnames $enc]
5126     if {$i < 0} {
5127         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5128         if {[regsub {^iso[-_]} $enc iso encx]} {
5129             set i [lsearch -exact $lcnames $encx]
5130         }
5131     }
5132     if {$i < 0} {
5133         foreach l $encoding_aliases {
5134             set ll [string tolower $l]
5135             if {[lsearch -exact $ll $enc] < 0} continue
5136             # look through the aliases for one that tcl knows about
5137             foreach e $ll {
5138                 set i [lsearch -exact $lcnames $e]
5139                 if {$i < 0} {
5140                     if {[regsub {^iso[-_]} $e iso ex]} {
5141                         set i [lsearch -exact $lcnames $ex]
5142                     }
5143                 }
5144                 if {$i >= 0} break
5145             }
5146             break
5147         }
5148     }
5149     if {$i >= 0} {
5150         return [lindex $names $i]
5151     }
5152     return {}
5153 }
5154
5155 # defaults...
5156 set datemode 0
5157 set diffopts "-U 5 -p"
5158 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5159
5160 set gitencoding {}
5161 catch {
5162     set gitencoding [exec git-repo-config --get i18n.commitencoding]
5163 }
5164 if {$gitencoding == ""} {
5165     set gitencoding "utf-8"
5166 }
5167 set tclencoding [tcl_encoding $gitencoding]
5168 if {$tclencoding == {}} {
5169     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5170 }
5171
5172 set mainfont {Helvetica 9}
5173 set textfont {Courier 9}
5174 set uifont {Helvetica 9 bold}
5175 set findmergefiles 0
5176 set maxgraphpct 50
5177 set maxwidth 16
5178 set revlistorder 0
5179 set fastdate 0
5180 set uparrowlen 7
5181 set downarrowlen 7
5182 set mingaplen 30
5183 set flistmode "flat"
5184 set cmitmode "patch"
5185
5186 set colors {green red blue magenta darkgrey brown orange}
5187
5188 catch {source ~/.gitk}
5189
5190 font create optionfont -family sans-serif -size -12
5191
5192 set revtreeargs {}
5193 foreach arg $argv {
5194     switch -regexp -- $arg {
5195         "^$" { }
5196         "^-d" { set datemode 1 }
5197         default {
5198             lappend revtreeargs $arg
5199         }
5200     }
5201 }
5202
5203 # check that we can find a .git directory somewhere...
5204 set gitdir [gitdir]
5205 if {![file isdirectory $gitdir]} {
5206     show_error . "Cannot find the git directory \"$gitdir\"."
5207     exit 1
5208 }
5209
5210 set cmdline_files {}
5211 set i [lsearch -exact $revtreeargs "--"]
5212 if {$i >= 0} {
5213     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5214     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5215 } elseif {$revtreeargs ne {}} {
5216     if {[catch {
5217         set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5218         set cmdline_files [split $f "\n"]
5219         set n [llength $cmdline_files]
5220         set revtreeargs [lrange $revtreeargs 0 end-$n]
5221     } err]} {
5222         # unfortunately we get both stdout and stderr in $err,
5223         # so look for "fatal:".
5224         set i [string first "fatal:" $err]
5225         if {$i > 0} {
5226             set err [string range [expr {$i + 6}] end]
5227         }
5228         show_error . "Bad arguments to gitk:\n$err"
5229         exit 1
5230     }
5231 }
5232
5233 set history {}
5234 set historyindex 0
5235 set fh_serial 0
5236 set highlight_names {}
5237 set nhl_names {}
5238 set highlight_paths {}
5239
5240 set optim_delay 16
5241
5242 set nextviewnum 1
5243 set curview 0
5244 set selectedview 0
5245 set selectedhlview None
5246 set viewfiles(0) {}
5247 set viewperm(0) 0
5248 set viewargs(0) {}
5249
5250 set cmdlineok 0
5251 set stopped 0
5252 set stuffsaved 0
5253 set patchnum 0
5254 setcoords
5255 makewindow
5256 readrefs
5257
5258 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5259     # create a view for the files/dirs specified on the command line
5260     set curview 1
5261     set selectedview 1
5262     set nextviewnum 2
5263     set viewname(1) "Command line"
5264     set viewfiles(1) $cmdline_files
5265     set viewargs(1) $revtreeargs
5266     set viewperm(1) 0
5267     addviewmenu 1
5268     .bar.view entryconf 2 -state normal
5269     .bar.view entryconf 3 -state normal
5270 }
5271
5272 if {[info exists permviews]} {
5273     foreach v $permviews {
5274         set n $nextviewnum
5275         incr nextviewnum
5276         set viewname($n) [lindex $v 0]
5277         set viewfiles($n) [lindex $v 1]
5278         set viewargs($n) [lindex $v 2]
5279         set viewperm($n) 1
5280         addviewmenu $n
5281     }
5282 }
5283 getcommits