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