1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec 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
10proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17}
18
19proc start_rev_list {rlargs} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22
23 set startmsecs [clock clicks -milliseconds]
24 set nextupdate [expr {$startmsecs + 100}]
25 set ncmupdate 1
26 initlayout
27 set order "--topo-order"
28 if {$datemode} {
29 set order "--date-order"
30 }
31 if {[catch {
32 set commfd [open [concat | git-rev-list --header $order \
33 --parents --boundary --default HEAD $rlargs] r]
34 } err]} {
35 puts stderr "Error executing git-rev-list: $err"
36 exit 1
37 }
38 set leftover {}
39 fconfigure $commfd -blocking 0 -translation lf
40 if {$tclencoding != {}} {
41 fconfigure $commfd -encoding $tclencoding
42 }
43 fileevent $commfd readable [list getcommitlines $commfd]
44 . config -cursor watch
45 settextcursor watch
46}
47
48proc getcommits {rargs} {
49 global phase canv mainfont
50
51 set phase getcommits
52 start_rev_list $rargs
53 $canv delete all
54 $canv create text 3 3 -anchor nw -text "Reading commits..." \
55 -font $mainfont -tags textitems
56}
57
58proc getcommitlines {commfd} {
59 global commitlisted nextupdate
60 global leftover
61 global displayorder commitidx commitrow commitdata
62 global parentlist childlist children
63
64 set stuff [read $commfd]
65 if {$stuff == {}} {
66 if {![eof $commfd]} return
67 # set it blocking so we wait for the process to terminate
68 fconfigure $commfd -blocking 1
69 if {![catch {close $commfd} err]} {
70 after idle finishcommits
71 return
72 }
73 if {[string range $err 0 4] == "usage"} {
74 set err \
75 "Gitk: error reading commits: bad arguments to git-rev-list.\
76 (Note: arguments to gitk are passed to git-rev-list\
77 to allow selection of commits to be displayed.)"
78 } else {
79 set err "Error reading commits: $err"
80 }
81 error_popup $err
82 exit 1
83 }
84 set start 0
85 set gotsome 0
86 while 1 {
87 set i [string first "\0" $stuff $start]
88 if {$i < 0} {
89 append leftover [string range $stuff $start end]
90 break
91 }
92 if {$start == 0} {
93 set cmit $leftover
94 append cmit [string range $stuff 0 [expr {$i - 1}]]
95 set leftover {}
96 } else {
97 set cmit [string range $stuff $start [expr {$i - 1}]]
98 }
99 set start [expr {$i + 1}]
100 set j [string first "\n" $cmit]
101 set ok 0
102 set listed 1
103 if {$j >= 0} {
104 set ids [string range $cmit 0 [expr {$j - 1}]]
105 if {[string range $ids 0 0] == "-"} {
106 set listed 0
107 set ids [string range $ids 1 end]
108 }
109 set ok 1
110 foreach id $ids {
111 if {[string length $id] != 40} {
112 set ok 0
113 break
114 }
115 }
116 }
117 if {!$ok} {
118 set shortcmit $cmit
119 if {[string length $shortcmit] > 80} {
120 set shortcmit "[string range $shortcmit 0 80]..."
121 }
122 error_popup "Can't parse git-rev-list output: {$shortcmit}"
123 exit 1
124 }
125 set id [lindex $ids 0]
126 if {$listed} {
127 set olds [lrange $ids 1 end]
128 if {[llength $olds] > 1} {
129 set olds [lsort -unique $olds]
130 }
131 foreach p $olds {
132 lappend children($p) $id
133 }
134 } else {
135 set olds {}
136 }
137 lappend parentlist $olds
138 if {[info exists children($id)]} {
139 lappend childlist $children($id)
140 } else {
141 lappend childlist {}
142 }
143 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
144 set commitrow($id) $commitidx
145 incr commitidx
146 lappend displayorder $id
147 lappend commitlisted $listed
148 set gotsome 1
149 }
150 if {$gotsome} {
151 layoutmore
152 }
153 if {[clock clicks -milliseconds] >= $nextupdate} {
154 doupdate 1
155 }
156}
157
158proc doupdate {reading} {
159 global commfd nextupdate numcommits ncmupdate
160
161 if {$reading} {
162 fileevent $commfd readable {}
163 }
164 update
165 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
166 if {$numcommits < 100} {
167 set ncmupdate [expr {$numcommits + 1}]
168 } elseif {$numcommits < 10000} {
169 set ncmupdate [expr {$numcommits + 10}]
170 } else {
171 set ncmupdate [expr {$numcommits + 100}]
172 }
173 if {$reading} {
174 fileevent $commfd readable [list getcommitlines $commfd]
175 }
176}
177
178proc readcommit {id} {
179 if {[catch {set contents [exec git-cat-file commit $id]}]} return
180 parsecommit $id $contents 0
181}
182
183proc updatecommits {rargs} {
184 stopfindproc
185 foreach v {colormap selectedline matchinglines treediffs
186 mergefilelist currentid rowtextx commitrow
187 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
188 linesegends crossings cornercrossings} {
189 global $v
190 catch {unset $v}
191 }
192 allcanvs delete all
193 readrefs
194 getcommits $rargs
195}
196
197proc parsecommit {id contents listed} {
198 global commitinfo cdate
199
200 set inhdr 1
201 set comment {}
202 set headline {}
203 set auname {}
204 set audate {}
205 set comname {}
206 set comdate {}
207 set hdrend [string first "\n\n" $contents]
208 if {$hdrend < 0} {
209 # should never happen...
210 set hdrend [string length $contents]
211 }
212 set header [string range $contents 0 [expr {$hdrend - 1}]]
213 set comment [string range $contents [expr {$hdrend + 2}] end]
214 foreach line [split $header "\n"] {
215 set tag [lindex $line 0]
216 if {$tag == "author"} {
217 set audate [lindex $line end-1]
218 set auname [lrange $line 1 end-2]
219 } elseif {$tag == "committer"} {
220 set comdate [lindex $line end-1]
221 set comname [lrange $line 1 end-2]
222 }
223 }
224 set headline {}
225 # take the first line of the comment as the headline
226 set i [string first "\n" $comment]
227 if {$i >= 0} {
228 set headline [string trim [string range $comment 0 $i]]
229 } else {
230 set headline $comment
231 }
232 if {!$listed} {
233 # git-rev-list indents the comment by 4 spaces;
234 # if we got this via git-cat-file, add the indentation
235 set newcomment {}
236 foreach line [split $comment "\n"] {
237 append newcomment " "
238 append newcomment $line
239 append newcomment "\n"
240 }
241 set comment $newcomment
242 }
243 if {$comdate != {}} {
244 set cdate($id) $comdate
245 }
246 set commitinfo($id) [list $headline $auname $audate \
247 $comname $comdate $comment]
248}
249
250proc getcommit {id} {
251 global commitdata commitinfo
252
253 if {[info exists commitdata($id)]} {
254 parsecommit $id $commitdata($id) 1
255 } else {
256 readcommit $id
257 if {![info exists commitinfo($id)]} {
258 set commitinfo($id) {"No commit information available"}
259 }
260 }
261 return 1
262}
263
264proc readrefs {} {
265 global tagids idtags headids idheads tagcontents
266 global otherrefids idotherrefs
267
268 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
269 catch {unset $v}
270 }
271 set refd [open [list | git ls-remote [gitdir]] r]
272 while {0 <= [set n [gets $refd line]]} {
273 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
274 match id path]} {
275 continue
276 }
277 if {[regexp {^remotes/.*/HEAD$} $path match]} {
278 continue
279 }
280 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
281 set type others
282 set name $path
283 }
284 if {[regexp {^remotes/} $path match]} {
285 set type heads
286 }
287 if {$type == "tags"} {
288 set tagids($name) $id
289 lappend idtags($id) $name
290 set obj {}
291 set type {}
292 set tag {}
293 catch {
294 set commit [exec git-rev-parse "$id^0"]
295 if {"$commit" != "$id"} {
296 set tagids($name) $commit
297 lappend idtags($commit) $name
298 }
299 }
300 catch {
301 set tagcontents($name) [exec git-cat-file tag "$id"]
302 }
303 } elseif { $type == "heads" } {
304 set headids($name) $id
305 lappend idheads($id) $name
306 } else {
307 set otherrefids($name) $id
308 lappend idotherrefs($id) $name
309 }
310 }
311 close $refd
312}
313
314proc error_popup msg {
315 set w .error
316 toplevel $w
317 wm transient $w .
318 message $w.m -text $msg -justify center -aspect 400
319 pack $w.m -side top -fill x -padx 20 -pady 20
320 button $w.ok -text OK -command "destroy $w"
321 pack $w.ok -side bottom -fill x
322 bind $w <Visibility> "grab $w; focus $w"
323 bind $w <Key-Return> "destroy $w"
324 tkwait window $w
325}
326
327proc makewindow {rargs} {
328 global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont
329 global findtype findtypemenu findloc findstring fstring geometry
330 global entries sha1entry sha1string sha1but
331 global maincursor textcursor curtextcursor
332 global rowctxmenu mergemax
333
334 menu .bar
335 .bar add cascade -label "File" -menu .bar.file
336 .bar configure -font $uifont
337 menu .bar.file
338 .bar.file add command -label "Update" -command [list updatecommits $rargs]
339 .bar.file add command -label "Reread references" -command rereadrefs
340 .bar.file add command -label "Quit" -command doquit
341 .bar.file configure -font $uifont
342 menu .bar.edit
343 .bar add cascade -label "Edit" -menu .bar.edit
344 .bar.edit add command -label "Preferences" -command doprefs
345 .bar.edit configure -font $uifont
346 menu .bar.help
347 .bar add cascade -label "Help" -menu .bar.help
348 .bar.help add command -label "About gitk" -command about
349 .bar.help add command -label "Key bindings" -command keys
350 .bar.help configure -font $uifont
351 . configure -menu .bar
352
353 if {![info exists geometry(canv1)]} {
354 set geometry(canv1) [expr {45 * $charspc}]
355 set geometry(canv2) [expr {30 * $charspc}]
356 set geometry(canv3) [expr {15 * $charspc}]
357 set geometry(canvh) [expr {25 * $linespc + 4}]
358 set geometry(ctextw) 80
359 set geometry(ctexth) 30
360 set geometry(cflistw) 30
361 }
362 panedwindow .ctop -orient vertical
363 if {[info exists geometry(width)]} {
364 .ctop conf -width $geometry(width) -height $geometry(height)
365 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
366 set geometry(ctexth) [expr {($texth - 8) /
367 [font metrics $textfont -linespace]}]
368 }
369 frame .ctop.top
370 frame .ctop.top.bar
371 pack .ctop.top.bar -side bottom -fill x
372 set cscroll .ctop.top.csb
373 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
374 pack $cscroll -side right -fill y
375 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
376 pack .ctop.top.clist -side top -fill both -expand 1
377 .ctop add .ctop.top
378 set canv .ctop.top.clist.canv
379 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
380 -bg white -bd 0 \
381 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
382 .ctop.top.clist add $canv
383 set canv2 .ctop.top.clist.canv2
384 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
385 -bg white -bd 0 -yscrollincr $linespc
386 .ctop.top.clist add $canv2
387 set canv3 .ctop.top.clist.canv3
388 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
389 -bg white -bd 0 -yscrollincr $linespc
390 .ctop.top.clist add $canv3
391 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
392
393 set sha1entry .ctop.top.bar.sha1
394 set entries $sha1entry
395 set sha1but .ctop.top.bar.sha1label
396 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
397 -command gotocommit -width 8 -font $uifont
398 $sha1but conf -disabledforeground [$sha1but cget -foreground]
399 pack .ctop.top.bar.sha1label -side left
400 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
401 trace add variable sha1string write sha1change
402 pack $sha1entry -side left -pady 2
403
404 image create bitmap bm-left -data {
405 #define left_width 16
406 #define left_height 16
407 static unsigned char left_bits[] = {
408 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
409 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
410 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
411 }
412 image create bitmap bm-right -data {
413 #define right_width 16
414 #define right_height 16
415 static unsigned char right_bits[] = {
416 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
417 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
418 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
419 }
420 button .ctop.top.bar.leftbut -image bm-left -command goback \
421 -state disabled -width 26
422 pack .ctop.top.bar.leftbut -side left -fill y
423 button .ctop.top.bar.rightbut -image bm-right -command goforw \
424 -state disabled -width 26
425 pack .ctop.top.bar.rightbut -side left -fill y
426
427 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
428 pack .ctop.top.bar.findbut -side left
429 set findstring {}
430 set fstring .ctop.top.bar.findstring
431 lappend entries $fstring
432 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
433 pack $fstring -side left -expand 1 -fill x
434 set findtype Exact
435 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
436 findtype Exact IgnCase Regexp]
437 .ctop.top.bar.findtype configure -font $uifont
438 .ctop.top.bar.findtype.menu configure -font $uifont
439 set findloc "All fields"
440 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
441 Comments Author Committer Files Pickaxe
442 .ctop.top.bar.findloc configure -font $uifont
443 .ctop.top.bar.findloc.menu configure -font $uifont
444
445 pack .ctop.top.bar.findloc -side right
446 pack .ctop.top.bar.findtype -side right
447 # for making sure type==Exact whenever loc==Pickaxe
448 trace add variable findloc write findlocchange
449
450 panedwindow .ctop.cdet -orient horizontal
451 .ctop add .ctop.cdet
452 frame .ctop.cdet.left
453 set ctext .ctop.cdet.left.ctext
454 text $ctext -bg white -state disabled -font $textfont \
455 -width $geometry(ctextw) -height $geometry(ctexth) \
456 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
457 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
458 pack .ctop.cdet.left.sb -side right -fill y
459 pack $ctext -side left -fill both -expand 1
460 .ctop.cdet add .ctop.cdet.left
461
462 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
463 $ctext tag conf hunksep -fore blue
464 $ctext tag conf d0 -fore red
465 $ctext tag conf d1 -fore "#00a000"
466 $ctext tag conf m0 -fore red
467 $ctext tag conf m1 -fore blue
468 $ctext tag conf m2 -fore green
469 $ctext tag conf m3 -fore purple
470 $ctext tag conf m4 -fore brown
471 $ctext tag conf m5 -fore "#009090"
472 $ctext tag conf m6 -fore magenta
473 $ctext tag conf m7 -fore "#808000"
474 $ctext tag conf m8 -fore "#009000"
475 $ctext tag conf m9 -fore "#ff0080"
476 $ctext tag conf m10 -fore cyan
477 $ctext tag conf m11 -fore "#b07070"
478 $ctext tag conf m12 -fore "#70b0f0"
479 $ctext tag conf m13 -fore "#70f0b0"
480 $ctext tag conf m14 -fore "#f0b070"
481 $ctext tag conf m15 -fore "#ff70b0"
482 $ctext tag conf mmax -fore darkgrey
483 set mergemax 16
484 $ctext tag conf mresult -font [concat $textfont bold]
485 $ctext tag conf msep -font [concat $textfont bold]
486 $ctext tag conf found -back yellow
487
488 frame .ctop.cdet.right
489 set cflist .ctop.cdet.right.cfiles
490 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
491 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
492 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
493 pack .ctop.cdet.right.sb -side right -fill y
494 pack $cflist -side left -fill both -expand 1
495 .ctop.cdet add .ctop.cdet.right
496 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
497
498 pack .ctop -side top -fill both -expand 1
499
500 bindall <1> {selcanvline %W %x %y}
501 #bindall <B1-Motion> {selcanvline %W %x %y}
502 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
503 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
504 bindall <2> "canvscan mark %W %x %y"
505 bindall <B2-Motion> "canvscan dragto %W %x %y"
506 bindkey <Home> selfirstline
507 bindkey <End> sellastline
508 bind . <Key-Up> "selnextline -1"
509 bind . <Key-Down> "selnextline 1"
510 bindkey <Key-Right> "goforw"
511 bindkey <Key-Left> "goback"
512 bind . <Key-Prior> "selnextpage -1"
513 bind . <Key-Next> "selnextpage 1"
514 bind . <Control-Home> "allcanvs yview moveto 0.0"
515 bind . <Control-End> "allcanvs yview moveto 1.0"
516 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
517 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
518 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
519 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
520 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
521 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
522 bindkey <Key-space> "$ctext yview scroll 1 pages"
523 bindkey p "selnextline -1"
524 bindkey n "selnextline 1"
525 bindkey z "goback"
526 bindkey x "goforw"
527 bindkey i "selnextline -1"
528 bindkey k "selnextline 1"
529 bindkey j "goback"
530 bindkey l "goforw"
531 bindkey b "$ctext yview scroll -1 pages"
532 bindkey d "$ctext yview scroll 18 units"
533 bindkey u "$ctext yview scroll -18 units"
534 bindkey / {findnext 1}
535 bindkey <Key-Return> {findnext 0}
536 bindkey ? findprev
537 bindkey f nextfile
538 bind . <Control-q> doquit
539 bind . <Control-f> dofind
540 bind . <Control-g> {findnext 0}
541 bind . <Control-r> findprev
542 bind . <Control-equal> {incrfont 1}
543 bind . <Control-KP_Add> {incrfont 1}
544 bind . <Control-minus> {incrfont -1}
545 bind . <Control-KP_Subtract> {incrfont -1}
546 bind $cflist <<ListboxSelect>> listboxsel
547 bind . <Destroy> {savestuff %W}
548 bind . <Button-1> "click %W"
549 bind $fstring <Key-Return> dofind
550 bind $sha1entry <Key-Return> gotocommit
551 bind $sha1entry <<PasteSelection>> clearsha1
552
553 set maincursor [. cget -cursor]
554 set textcursor [$ctext cget -cursor]
555 set curtextcursor $textcursor
556
557 set rowctxmenu .rowctxmenu
558 menu $rowctxmenu -tearoff 0
559 $rowctxmenu add command -label "Diff this -> selected" \
560 -command {diffvssel 0}
561 $rowctxmenu add command -label "Diff selected -> this" \
562 -command {diffvssel 1}
563 $rowctxmenu add command -label "Make patch" -command mkpatch
564 $rowctxmenu add command -label "Create tag" -command mktag
565 $rowctxmenu add command -label "Write commit to file" -command writecommit
566}
567
568# mouse-2 makes all windows scan vertically, but only the one
569# the cursor is in scans horizontally
570proc canvscan {op w x y} {
571 global canv canv2 canv3
572 foreach c [list $canv $canv2 $canv3] {
573 if {$c == $w} {
574 $c scan $op $x $y
575 } else {
576 $c scan $op 0 $y
577 }
578 }
579}
580
581proc scrollcanv {cscroll f0 f1} {
582 $cscroll set $f0 $f1
583 drawfrac $f0 $f1
584}
585
586# when we make a key binding for the toplevel, make sure
587# it doesn't get triggered when that key is pressed in the
588# find string entry widget.
589proc bindkey {ev script} {
590 global entries
591 bind . $ev $script
592 set escript [bind Entry $ev]
593 if {$escript == {}} {
594 set escript [bind Entry <Key>]
595 }
596 foreach e $entries {
597 bind $e $ev "$escript; break"
598 }
599}
600
601# set the focus back to the toplevel for any click outside
602# the entry widgets
603proc click {w} {
604 global entries
605 foreach e $entries {
606 if {$w == $e} return
607 }
608 focus .
609}
610
611proc savestuff {w} {
612 global canv canv2 canv3 ctext cflist mainfont textfont uifont
613 global stuffsaved findmergefiles maxgraphpct
614 global maxwidth
615
616 if {$stuffsaved} return
617 if {![winfo viewable .]} return
618 catch {
619 set f [open "~/.gitk-new" w]
620 puts $f [list set mainfont $mainfont]
621 puts $f [list set textfont $textfont]
622 puts $f [list set uifont $uifont]
623 puts $f [list set findmergefiles $findmergefiles]
624 puts $f [list set maxgraphpct $maxgraphpct]
625 puts $f [list set maxwidth $maxwidth]
626 puts $f "set geometry(width) [winfo width .ctop]"
627 puts $f "set geometry(height) [winfo height .ctop]"
628 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
629 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
630 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
631 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
632 set wid [expr {([winfo width $ctext] - 8) \
633 / [font measure $textfont "0"]}]
634 puts $f "set geometry(ctextw) $wid"
635 set wid [expr {([winfo width $cflist] - 11) \
636 / [font measure [$cflist cget -font] "0"]}]
637 puts $f "set geometry(cflistw) $wid"
638 close $f
639 file rename -force "~/.gitk-new" "~/.gitk"
640 }
641 set stuffsaved 1
642}
643
644proc resizeclistpanes {win w} {
645 global oldwidth
646 if {[info exists oldwidth($win)]} {
647 set s0 [$win sash coord 0]
648 set s1 [$win sash coord 1]
649 if {$w < 60} {
650 set sash0 [expr {int($w/2 - 2)}]
651 set sash1 [expr {int($w*5/6 - 2)}]
652 } else {
653 set factor [expr {1.0 * $w / $oldwidth($win)}]
654 set sash0 [expr {int($factor * [lindex $s0 0])}]
655 set sash1 [expr {int($factor * [lindex $s1 0])}]
656 if {$sash0 < 30} {
657 set sash0 30
658 }
659 if {$sash1 < $sash0 + 20} {
660 set sash1 [expr {$sash0 + 20}]
661 }
662 if {$sash1 > $w - 10} {
663 set sash1 [expr {$w - 10}]
664 if {$sash0 > $sash1 - 20} {
665 set sash0 [expr {$sash1 - 20}]
666 }
667 }
668 }
669 $win sash place 0 $sash0 [lindex $s0 1]
670 $win sash place 1 $sash1 [lindex $s1 1]
671 }
672 set oldwidth($win) $w
673}
674
675proc resizecdetpanes {win w} {
676 global oldwidth
677 if {[info exists oldwidth($win)]} {
678 set s0 [$win sash coord 0]
679 if {$w < 60} {
680 set sash0 [expr {int($w*3/4 - 2)}]
681 } else {
682 set factor [expr {1.0 * $w / $oldwidth($win)}]
683 set sash0 [expr {int($factor * [lindex $s0 0])}]
684 if {$sash0 < 45} {
685 set sash0 45
686 }
687 if {$sash0 > $w - 15} {
688 set sash0 [expr {$w - 15}]
689 }
690 }
691 $win sash place 0 $sash0 [lindex $s0 1]
692 }
693 set oldwidth($win) $w
694}
695
696proc allcanvs args {
697 global canv canv2 canv3
698 eval $canv $args
699 eval $canv2 $args
700 eval $canv3 $args
701}
702
703proc bindall {event action} {
704 global canv canv2 canv3
705 bind $canv $event $action
706 bind $canv2 $event $action
707 bind $canv3 $event $action
708}
709
710proc about {} {
711 set w .about
712 if {[winfo exists $w]} {
713 raise $w
714 return
715 }
716 toplevel $w
717 wm title $w "About gitk"
718 message $w.m -text {
719Gitk - a commit viewer for git
720
721Copyright © 2005-2006 Paul Mackerras
722
723Use and redistribute under the terms of the GNU General Public License} \
724 -justify center -aspect 400
725 pack $w.m -side top -fill x -padx 20 -pady 20
726 button $w.ok -text Close -command "destroy $w"
727 pack $w.ok -side bottom
728}
729
730proc keys {} {
731 set w .keys
732 if {[winfo exists $w]} {
733 raise $w
734 return
735 }
736 toplevel $w
737 wm title $w "Gitk key bindings"
738 message $w.m -text {
739Gitk key bindings:
740
741<Ctrl-Q> Quit
742<Home> Move to first commit
743<End> Move to last commit
744<Up>, p, i Move up one commit
745<Down>, n, k Move down one commit
746<Left>, z, j Go back in history list
747<Right>, x, l Go forward in history list
748<PageUp> Move up one page in commit list
749<PageDown> Move down one page in commit list
750<Ctrl-Home> Scroll to top of commit list
751<Ctrl-End> Scroll to bottom of commit list
752<Ctrl-Up> Scroll commit list up one line
753<Ctrl-Down> Scroll commit list down one line
754<Ctrl-PageUp> Scroll commit list up one page
755<Ctrl-PageDown> Scroll commit list down one page
756<Delete>, b Scroll diff view up one page
757<Backspace> Scroll diff view up one page
758<Space> Scroll diff view down one page
759u Scroll diff view up 18 lines
760d Scroll diff view down 18 lines
761<Ctrl-F> Find
762<Ctrl-G> Move to next find hit
763<Ctrl-R> Move to previous find hit
764<Return> Move to next find hit
765/ Move to next find hit, or redo find
766? Move to previous find hit
767f Scroll diff view to next file
768<Ctrl-KP+> Increase font size
769<Ctrl-plus> Increase font size
770<Ctrl-KP-> Decrease font size
771<Ctrl-minus> Decrease font size
772} \
773 -justify left -bg white -border 2 -relief sunken
774 pack $w.m -side top -fill both
775 button $w.ok -text Close -command "destroy $w"
776 pack $w.ok -side bottom
777}
778
779proc shortids {ids} {
780 set res {}
781 foreach id $ids {
782 if {[llength $id] > 1} {
783 lappend res [shortids $id]
784 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
785 lappend res [string range $id 0 7]
786 } else {
787 lappend res $id
788 }
789 }
790 return $res
791}
792
793proc incrange {l x o} {
794 set n [llength $l]
795 while {$x < $n} {
796 set e [lindex $l $x]
797 if {$e ne {}} {
798 lset l $x [expr {$e + $o}]
799 }
800 incr x
801 }
802 return $l
803}
804
805proc ntimes {n o} {
806 set ret {}
807 for {} {$n > 0} {incr n -1} {
808 lappend ret $o
809 }
810 return $ret
811}
812
813proc usedinrange {id l1 l2} {
814 global children commitrow
815
816 if {[info exists commitrow($id)]} {
817 set r $commitrow($id)
818 if {$l1 <= $r && $r <= $l2} {
819 return [expr {$r - $l1 + 1}]
820 }
821 }
822 foreach c $children($id) {
823 if {[info exists commitrow($c)]} {
824 set r $commitrow($c)
825 if {$l1 <= $r && $r <= $l2} {
826 return [expr {$r - $l1 + 1}]
827 }
828 }
829 }
830 return 0
831}
832
833proc sanity {row {full 0}} {
834 global rowidlist rowoffsets
835
836 set col -1
837 set ids [lindex $rowidlist $row]
838 foreach id $ids {
839 incr col
840 if {$id eq {}} continue
841 if {$col < [llength $ids] - 1 &&
842 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
843 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
844 }
845 set o [lindex $rowoffsets $row $col]
846 set y $row
847 set x $col
848 while {$o ne {}} {
849 incr y -1
850 incr x $o
851 if {[lindex $rowidlist $y $x] != $id} {
852 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
853 puts " id=[shortids $id] check started at row $row"
854 for {set i $row} {$i >= $y} {incr i -1} {
855 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
856 }
857 break
858 }
859 if {!$full} break
860 set o [lindex $rowoffsets $y $x]
861 }
862 }
863}
864
865proc makeuparrow {oid x y z} {
866 global rowidlist rowoffsets uparrowlen idrowranges
867
868 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
869 incr y -1
870 incr x $z
871 set off0 [lindex $rowoffsets $y]
872 for {set x0 $x} {1} {incr x0} {
873 if {$x0 >= [llength $off0]} {
874 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
875 break
876 }
877 set z [lindex $off0 $x0]
878 if {$z ne {}} {
879 incr x0 $z
880 break
881 }
882 }
883 set z [expr {$x0 - $x}]
884 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
885 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
886 }
887 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
888 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
889 lappend idrowranges($oid) $y
890}
891
892proc initlayout {} {
893 global rowidlist rowoffsets displayorder commitlisted
894 global rowlaidout rowoptim
895 global idinlist rowchk
896 global commitidx numcommits canvxmax canv
897 global nextcolor
898 global parentlist childlist children
899
900 set commitidx 0
901 set numcommits 0
902 set displayorder {}
903 set commitlisted {}
904 set parentlist {}
905 set childlist {}
906 catch {unset children}
907 set nextcolor 0
908 set rowidlist {{}}
909 set rowoffsets {{}}
910 catch {unset idinlist}
911 catch {unset rowchk}
912 set rowlaidout 0
913 set rowoptim 0
914 set canvxmax [$canv cget -width]
915}
916
917proc setcanvscroll {} {
918 global canv canv2 canv3 numcommits linespc canvxmax canvy0
919
920 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
921 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
922 $canv2 conf -scrollregion [list 0 0 0 $ymax]
923 $canv3 conf -scrollregion [list 0 0 0 $ymax]
924}
925
926proc visiblerows {} {
927 global canv numcommits linespc
928
929 set ymax [lindex [$canv cget -scrollregion] 3]
930 if {$ymax eq {} || $ymax == 0} return
931 set f [$canv yview]
932 set y0 [expr {int([lindex $f 0] * $ymax)}]
933 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
934 if {$r0 < 0} {
935 set r0 0
936 }
937 set y1 [expr {int([lindex $f 1] * $ymax)}]
938 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
939 if {$r1 >= $numcommits} {
940 set r1 [expr {$numcommits - 1}]
941 }
942 return [list $r0 $r1]
943}
944
945proc layoutmore {} {
946 global rowlaidout rowoptim commitidx numcommits optim_delay
947 global uparrowlen
948
949 set row $rowlaidout
950 set rowlaidout [layoutrows $row $commitidx 0]
951 set orow [expr {$rowlaidout - $uparrowlen - 1}]
952 if {$orow > $rowoptim} {
953 checkcrossings $rowoptim $orow
954 optimize_rows $rowoptim 0 $orow
955 set rowoptim $orow
956 }
957 set canshow [expr {$rowoptim - $optim_delay}]
958 if {$canshow > $numcommits} {
959 showstuff $canshow
960 }
961}
962
963proc showstuff {canshow} {
964 global numcommits
965 global linesegends idrowranges idrangedrawn
966
967 if {$numcommits == 0} {
968 global phase
969 set phase "incrdraw"
970 allcanvs delete all
971 }
972 set row $numcommits
973 set numcommits $canshow
974 setcanvscroll
975 set rows [visiblerows]
976 set r0 [lindex $rows 0]
977 set r1 [lindex $rows 1]
978 for {set r $row} {$r < $canshow} {incr r} {
979 if {[info exists linesegends($r)]} {
980 foreach id $linesegends($r) {
981 set i -1
982 foreach {s e} $idrowranges($id) {
983 incr i
984 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
985 && ![info exists idrangedrawn($id,$i)]} {
986 drawlineseg $id $i
987 set idrangedrawn($id,$i) 1
988 }
989 }
990 }
991 }
992 }
993 if {$canshow > $r1} {
994 set canshow $r1
995 }
996 while {$row < $canshow} {
997 drawcmitrow $row
998 incr row
999 }
1000}
1001
1002proc layoutrows {row endrow last} {
1003 global rowidlist rowoffsets displayorder
1004 global uparrowlen downarrowlen maxwidth mingaplen
1005 global childlist parentlist
1006 global idrowranges linesegends
1007 global commitidx
1008 global idinlist rowchk
1009
1010 set idlist [lindex $rowidlist $row]
1011 set offs [lindex $rowoffsets $row]
1012 while {$row < $endrow} {
1013 set id [lindex $displayorder $row]
1014 set oldolds {}
1015 set newolds {}
1016 foreach p [lindex $parentlist $row] {
1017 if {![info exists idinlist($p)]} {
1018 lappend newolds $p
1019 } elseif {!$idinlist($p)} {
1020 lappend oldolds $p
1021 }
1022 }
1023 set nev [expr {[llength $idlist] + [llength $newolds]
1024 + [llength $oldolds] - $maxwidth + 1}]
1025 if {$nev > 0} {
1026 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1027 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1028 set i [lindex $idlist $x]
1029 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1030 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1031 [expr {$row + $uparrowlen + $mingaplen}]]
1032 if {$r == 0} {
1033 set idlist [lreplace $idlist $x $x]
1034 set offs [lreplace $offs $x $x]
1035 set offs [incrange $offs $x 1]
1036 set idinlist($i) 0
1037 set rm1 [expr {$row - 1}]
1038 lappend linesegends($rm1) $i
1039 lappend idrowranges($i) $rm1
1040 if {[incr nev -1] <= 0} break
1041 continue
1042 }
1043 set rowchk($id) [expr {$row + $r}]
1044 }
1045 }
1046 lset rowidlist $row $idlist
1047 lset rowoffsets $row $offs
1048 }
1049 set col [lsearch -exact $idlist $id]
1050 if {$col < 0} {
1051 set col [llength $idlist]
1052 lappend idlist $id
1053 lset rowidlist $row $idlist
1054 set z {}
1055 if {[lindex $childlist $row] ne {}} {
1056 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1057 unset idinlist($id)
1058 }
1059 lappend offs $z
1060 lset rowoffsets $row $offs
1061 if {$z ne {}} {
1062 makeuparrow $id $col $row $z
1063 }
1064 } else {
1065 unset idinlist($id)
1066 }
1067 if {[info exists idrowranges($id)]} {
1068 lappend idrowranges($id) $row
1069 }
1070 incr row
1071 set offs [ntimes [llength $idlist] 0]
1072 set l [llength $newolds]
1073 set idlist [eval lreplace \$idlist $col $col $newolds]
1074 set o 0
1075 if {$l != 1} {
1076 set offs [lrange $offs 0 [expr {$col - 1}]]
1077 foreach x $newolds {
1078 lappend offs {}
1079 incr o -1
1080 }
1081 incr o
1082 set tmp [expr {[llength $idlist] - [llength $offs]}]
1083 if {$tmp > 0} {
1084 set offs [concat $offs [ntimes $tmp $o]]
1085 }
1086 } else {
1087 lset offs $col {}
1088 }
1089 foreach i $newolds {
1090 set idinlist($i) 1
1091 set idrowranges($i) $row
1092 }
1093 incr col $l
1094 foreach oid $oldolds {
1095 set idinlist($oid) 1
1096 set idlist [linsert $idlist $col $oid]
1097 set offs [linsert $offs $col $o]
1098 makeuparrow $oid $col $row $o
1099 incr col
1100 }
1101 lappend rowidlist $idlist
1102 lappend rowoffsets $offs
1103 }
1104 return $row
1105}
1106
1107proc addextraid {id row} {
1108 global displayorder commitrow commitinfo
1109 global commitidx commitlisted
1110 global parentlist childlist children
1111
1112 incr commitidx
1113 lappend displayorder $id
1114 lappend commitlisted 0
1115 lappend parentlist {}
1116 set commitrow($id) $row
1117 readcommit $id
1118 if {![info exists commitinfo($id)]} {
1119 set commitinfo($id) {"No commit information available"}
1120 }
1121 if {[info exists children($id)]} {
1122 lappend childlist $children($id)
1123 } else {
1124 lappend childlist {}
1125 }
1126}
1127
1128proc layouttail {} {
1129 global rowidlist rowoffsets idinlist commitidx
1130 global idrowranges
1131
1132 set row $commitidx
1133 set idlist [lindex $rowidlist $row]
1134 while {$idlist ne {}} {
1135 set col [expr {[llength $idlist] - 1}]
1136 set id [lindex $idlist $col]
1137 addextraid $id $row
1138 unset idinlist($id)
1139 lappend idrowranges($id) $row
1140 incr row
1141 set offs [ntimes $col 0]
1142 set idlist [lreplace $idlist $col $col]
1143 lappend rowidlist $idlist
1144 lappend rowoffsets $offs
1145 }
1146
1147 foreach id [array names idinlist] {
1148 addextraid $id $row
1149 lset rowidlist $row [list $id]
1150 lset rowoffsets $row 0
1151 makeuparrow $id 0 $row 0
1152 lappend idrowranges($id) $row
1153 incr row
1154 lappend rowidlist {}
1155 lappend rowoffsets {}
1156 }
1157}
1158
1159proc insert_pad {row col npad} {
1160 global rowidlist rowoffsets
1161
1162 set pad [ntimes $npad {}]
1163 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1164 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1165 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1166}
1167
1168proc optimize_rows {row col endrow} {
1169 global rowidlist rowoffsets idrowranges linesegends displayorder
1170
1171 for {} {$row < $endrow} {incr row} {
1172 set idlist [lindex $rowidlist $row]
1173 set offs [lindex $rowoffsets $row]
1174 set haspad 0
1175 for {} {$col < [llength $offs]} {incr col} {
1176 if {[lindex $idlist $col] eq {}} {
1177 set haspad 1
1178 continue
1179 }
1180 set z [lindex $offs $col]
1181 if {$z eq {}} continue
1182 set isarrow 0
1183 set x0 [expr {$col + $z}]
1184 set y0 [expr {$row - 1}]
1185 set z0 [lindex $rowoffsets $y0 $x0]
1186 if {$z0 eq {}} {
1187 set id [lindex $idlist $col]
1188 if {[info exists idrowranges($id)] &&
1189 $y0 > [lindex $idrowranges($id) 0]} {
1190 set isarrow 1
1191 }
1192 }
1193 if {$z < -1 || ($z < 0 && $isarrow)} {
1194 set npad [expr {-1 - $z + $isarrow}]
1195 set offs [incrange $offs $col $npad]
1196 insert_pad $y0 $x0 $npad
1197 if {$y0 > 0} {
1198 optimize_rows $y0 $x0 $row
1199 }
1200 set z [lindex $offs $col]
1201 set x0 [expr {$col + $z}]
1202 set z0 [lindex $rowoffsets $y0 $x0]
1203 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1204 set npad [expr {$z - 1 + $isarrow}]
1205 set y1 [expr {$row + 1}]
1206 set offs2 [lindex $rowoffsets $y1]
1207 set x1 -1
1208 foreach z $offs2 {
1209 incr x1
1210 if {$z eq {} || $x1 + $z < $col} continue
1211 if {$x1 + $z > $col} {
1212 incr npad
1213 }
1214 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1215 break
1216 }
1217 set pad [ntimes $npad {}]
1218 set idlist [eval linsert \$idlist $col $pad]
1219 set tmp [eval linsert \$offs $col $pad]
1220 incr col $npad
1221 set offs [incrange $tmp $col [expr {-$npad}]]
1222 set z [lindex $offs $col]
1223 set haspad 1
1224 }
1225 if {$z0 eq {} && !$isarrow} {
1226 # this line links to its first child on row $row-2
1227 set rm2 [expr {$row - 2}]
1228 set id [lindex $displayorder $rm2]
1229 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1230 if {$xc >= 0} {
1231 set z0 [expr {$xc - $x0}]
1232 }
1233 }
1234 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1235 insert_pad $y0 $x0 1
1236 set offs [incrange $offs $col 1]
1237 optimize_rows $y0 [expr {$x0 + 1}] $row
1238 }
1239 }
1240 if {!$haspad} {
1241 set o {}
1242 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1243 set o [lindex $offs $col]
1244 if {$o eq {}} {
1245 # check if this is the link to the first child
1246 set id [lindex $idlist $col]
1247 if {[info exists idrowranges($id)] &&
1248 $row == [lindex $idrowranges($id) 0]} {
1249 # it is, work out offset to child
1250 set y0 [expr {$row - 1}]
1251 set id [lindex $displayorder $y0]
1252 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1253 if {$x0 >= 0} {
1254 set o [expr {$x0 - $col}]
1255 }
1256 }
1257 }
1258 if {$o eq {} || $o <= 0} break
1259 }
1260 if {$o ne {} && [incr col] < [llength $idlist]} {
1261 set y1 [expr {$row + 1}]
1262 set offs2 [lindex $rowoffsets $y1]
1263 set x1 -1
1264 foreach z $offs2 {
1265 incr x1
1266 if {$z eq {} || $x1 + $z < $col} continue
1267 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1268 break
1269 }
1270 set idlist [linsert $idlist $col {}]
1271 set tmp [linsert $offs $col {}]
1272 incr col
1273 set offs [incrange $tmp $col -1]
1274 }
1275 }
1276 lset rowidlist $row $idlist
1277 lset rowoffsets $row $offs
1278 set col 0
1279 }
1280}
1281
1282proc xc {row col} {
1283 global canvx0 linespc
1284 return [expr {$canvx0 + $col * $linespc}]
1285}
1286
1287proc yc {row} {
1288 global canvy0 linespc
1289 return [expr {$canvy0 + $row * $linespc}]
1290}
1291
1292proc linewidth {id} {
1293 global thickerline lthickness
1294
1295 set wid $lthickness
1296 if {[info exists thickerline] && $id eq $thickerline} {
1297 set wid [expr {2 * $lthickness}]
1298 }
1299 return $wid
1300}
1301
1302proc drawlineseg {id i} {
1303 global rowoffsets rowidlist idrowranges
1304 global displayorder
1305 global canv colormap linespc
1306
1307 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1308 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1309 if {$startrow == $row} return
1310 assigncolor $id
1311 set coords {}
1312 set col [lsearch -exact [lindex $rowidlist $row] $id]
1313 if {$col < 0} {
1314 puts "oops: drawline: id $id not on row $row"
1315 return
1316 }
1317 set lasto {}
1318 set ns 0
1319 while {1} {
1320 set o [lindex $rowoffsets $row $col]
1321 if {$o eq {}} break
1322 if {$o ne $lasto} {
1323 # changing direction
1324 set x [xc $row $col]
1325 set y [yc $row]
1326 lappend coords $x $y
1327 set lasto $o
1328 }
1329 incr col $o
1330 incr row -1
1331 }
1332 set x [xc $row $col]
1333 set y [yc $row]
1334 lappend coords $x $y
1335 if {$i == 0} {
1336 # draw the link to the first child as part of this line
1337 incr row -1
1338 set child [lindex $displayorder $row]
1339 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1340 if {$ccol >= 0} {
1341 set x [xc $row $ccol]
1342 set y [yc $row]
1343 if {$ccol < $col - 1} {
1344 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1345 } elseif {$ccol > $col + 1} {
1346 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1347 }
1348 lappend coords $x $y
1349 }
1350 }
1351 if {[llength $coords] < 4} return
1352 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1353 if {$i < $last} {
1354 # This line has an arrow at the lower end: check if the arrow is
1355 # on a diagonal segment, and if so, work around the Tk 8.4
1356 # refusal to draw arrows on diagonal lines.
1357 set x0 [lindex $coords 0]
1358 set x1 [lindex $coords 2]
1359 if {$x0 != $x1} {
1360 set y0 [lindex $coords 1]
1361 set y1 [lindex $coords 3]
1362 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1363 # we have a nearby vertical segment, just trim off the diag bit
1364 set coords [lrange $coords 2 end]
1365 } else {
1366 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1367 set xi [expr {$x0 - $slope * $linespc / 2}]
1368 set yi [expr {$y0 - $linespc / 2}]
1369 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1370 }
1371 }
1372 }
1373 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1374 set arrow [lindex {none first last both} $arrow]
1375 set t [$canv create line $coords -width [linewidth $id] \
1376 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1377 $canv lower $t
1378 bindline $t $id
1379}
1380
1381proc drawparentlinks {id row col olds} {
1382 global rowidlist canv colormap idrowranges
1383
1384 set row2 [expr {$row + 1}]
1385 set x [xc $row $col]
1386 set y [yc $row]
1387 set y2 [yc $row2]
1388 set ids [lindex $rowidlist $row2]
1389 # rmx = right-most X coord used
1390 set rmx 0
1391 foreach p $olds {
1392 set i [lsearch -exact $ids $p]
1393 if {$i < 0} {
1394 puts "oops, parent $p of $id not in list"
1395 continue
1396 }
1397 set x2 [xc $row2 $i]
1398 if {$x2 > $rmx} {
1399 set rmx $x2
1400 }
1401 if {[info exists idrowranges($p)] &&
1402 $row2 == [lindex $idrowranges($p) 0] &&
1403 $row2 < [lindex $idrowranges($p) 1]} {
1404 # drawlineseg will do this one for us
1405 continue
1406 }
1407 assigncolor $p
1408 # should handle duplicated parents here...
1409 set coords [list $x $y]
1410 if {$i < $col - 1} {
1411 lappend coords [xc $row [expr {$i + 1}]] $y
1412 } elseif {$i > $col + 1} {
1413 lappend coords [xc $row [expr {$i - 1}]] $y
1414 }
1415 lappend coords $x2 $y2
1416 set t [$canv create line $coords -width [linewidth $p] \
1417 -fill $colormap($p) -tags lines.$p]
1418 $canv lower $t
1419 bindline $t $p
1420 }
1421 return $rmx
1422}
1423
1424proc drawlines {id} {
1425 global colormap canv
1426 global idrowranges idrangedrawn
1427 global childlist iddrawn commitrow rowidlist
1428
1429 $canv delete lines.$id
1430 set nr [expr {[llength $idrowranges($id)] / 2}]
1431 for {set i 0} {$i < $nr} {incr i} {
1432 if {[info exists idrangedrawn($id,$i)]} {
1433 drawlineseg $id $i
1434 }
1435 }
1436 foreach child [lindex $childlist $commitrow($id)] {
1437 if {[info exists iddrawn($child)]} {
1438 set row $commitrow($child)
1439 set col [lsearch -exact [lindex $rowidlist $row] $child]
1440 if {$col >= 0} {
1441 drawparentlinks $child $row $col [list $id]
1442 }
1443 }
1444 }
1445}
1446
1447proc drawcmittext {id row col rmx} {
1448 global linespc canv canv2 canv3 canvy0
1449 global commitlisted commitinfo rowidlist
1450 global rowtextx idpos idtags idheads idotherrefs
1451 global linehtag linentag linedtag
1452 global mainfont namefont canvxmax
1453
1454 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1455 set x [xc $row $col]
1456 set y [yc $row]
1457 set orad [expr {$linespc / 3}]
1458 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1459 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1460 -fill $ofill -outline black -width 1]
1461 $canv raise $t
1462 $canv bind $t <1> {selcanvline {} %x %y}
1463 set xt [xc $row [llength [lindex $rowidlist $row]]]
1464 if {$xt < $rmx} {
1465 set xt $rmx
1466 }
1467 set rowtextx($row) $xt
1468 set idpos($id) [list $x $xt $y]
1469 if {[info exists idtags($id)] || [info exists idheads($id)]
1470 || [info exists idotherrefs($id)]} {
1471 set xt [drawtags $id $x $xt $y]
1472 }
1473 set headline [lindex $commitinfo($id) 0]
1474 set name [lindex $commitinfo($id) 1]
1475 set date [lindex $commitinfo($id) 2]
1476 set date [formatdate $date]
1477 set linehtag($row) [$canv create text $xt $y -anchor w \
1478 -text $headline -font $mainfont ]
1479 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1480 set linentag($row) [$canv2 create text 3 $y -anchor w \
1481 -text $name -font $namefont]
1482 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1483 -text $date -font $mainfont]
1484 set xr [expr {$xt + [font measure $mainfont $headline]}]
1485 if {$xr > $canvxmax} {
1486 set canvxmax $xr
1487 setcanvscroll
1488 }
1489}
1490
1491proc drawcmitrow {row} {
1492 global displayorder rowidlist
1493 global idrowranges idrangedrawn iddrawn
1494 global commitinfo parentlist numcommits
1495
1496 if {$row >= $numcommits} return
1497 foreach id [lindex $rowidlist $row] {
1498 if {![info exists idrowranges($id)]} continue
1499 set i -1
1500 foreach {s e} $idrowranges($id) {
1501 incr i
1502 if {$row < $s} continue
1503 if {$e eq {}} break
1504 if {$row <= $e} {
1505 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1506 drawlineseg $id $i
1507 set idrangedrawn($id,$i) 1
1508 }
1509 break
1510 }
1511 }
1512 }
1513
1514 set id [lindex $displayorder $row]
1515 if {[info exists iddrawn($id)]} return
1516 set col [lsearch -exact [lindex $rowidlist $row] $id]
1517 if {$col < 0} {
1518 puts "oops, row $row id $id not in list"
1519 return
1520 }
1521 if {![info exists commitinfo($id)]} {
1522 getcommit $id
1523 }
1524 assigncolor $id
1525 set olds [lindex $parentlist $row]
1526 if {$olds ne {}} {
1527 set rmx [drawparentlinks $id $row $col $olds]
1528 } else {
1529 set rmx 0
1530 }
1531 drawcmittext $id $row $col $rmx
1532 set iddrawn($id) 1
1533}
1534
1535proc drawfrac {f0 f1} {
1536 global numcommits canv
1537 global linespc
1538
1539 set ymax [lindex [$canv cget -scrollregion] 3]
1540 if {$ymax eq {} || $ymax == 0} return
1541 set y0 [expr {int($f0 * $ymax)}]
1542 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1543 if {$row < 0} {
1544 set row 0
1545 }
1546 set y1 [expr {int($f1 * $ymax)}]
1547 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1548 if {$endrow >= $numcommits} {
1549 set endrow [expr {$numcommits - 1}]
1550 }
1551 for {} {$row <= $endrow} {incr row} {
1552 drawcmitrow $row
1553 }
1554}
1555
1556proc drawvisible {} {
1557 global canv
1558 eval drawfrac [$canv yview]
1559}
1560
1561proc clear_display {} {
1562 global iddrawn idrangedrawn
1563
1564 allcanvs delete all
1565 catch {unset iddrawn}
1566 catch {unset idrangedrawn}
1567}
1568
1569proc assigncolor {id} {
1570 global colormap colors nextcolor
1571 global commitrow parentlist children childlist
1572 global cornercrossings crossings
1573
1574 if {[info exists colormap($id)]} return
1575 set ncolors [llength $colors]
1576 if {[info exists commitrow($id)]} {
1577 set kids [lindex $childlist $commitrow($id)]
1578 } elseif {[info exists children($id)]} {
1579 set kids $children($id)
1580 } else {
1581 set kids {}
1582 }
1583 if {[llength $kids] == 1} {
1584 set child [lindex $kids 0]
1585 if {[info exists colormap($child)]
1586 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1587 set colormap($id) $colormap($child)
1588 return
1589 }
1590 }
1591 set badcolors {}
1592 if {[info exists cornercrossings($id)]} {
1593 foreach x $cornercrossings($id) {
1594 if {[info exists colormap($x)]
1595 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1596 lappend badcolors $colormap($x)
1597 }
1598 }
1599 if {[llength $badcolors] >= $ncolors} {
1600 set badcolors {}
1601 }
1602 }
1603 set origbad $badcolors
1604 if {[llength $badcolors] < $ncolors - 1} {
1605 if {[info exists crossings($id)]} {
1606 foreach x $crossings($id) {
1607 if {[info exists colormap($x)]
1608 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1609 lappend badcolors $colormap($x)
1610 }
1611 }
1612 if {[llength $badcolors] >= $ncolors} {
1613 set badcolors $origbad
1614 }
1615 }
1616 set origbad $badcolors
1617 }
1618 if {[llength $badcolors] < $ncolors - 1} {
1619 foreach child $kids {
1620 if {[info exists colormap($child)]
1621 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1622 lappend badcolors $colormap($child)
1623 }
1624 foreach p [lindex $parentlist $commitrow($child)] {
1625 if {[info exists colormap($p)]
1626 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1627 lappend badcolors $colormap($p)
1628 }
1629 }
1630 }
1631 if {[llength $badcolors] >= $ncolors} {
1632 set badcolors $origbad
1633 }
1634 }
1635 for {set i 0} {$i <= $ncolors} {incr i} {
1636 set c [lindex $colors $nextcolor]
1637 if {[incr nextcolor] >= $ncolors} {
1638 set nextcolor 0
1639 }
1640 if {[lsearch -exact $badcolors $c]} break
1641 }
1642 set colormap($id) $c
1643}
1644
1645proc bindline {t id} {
1646 global canv
1647
1648 $canv bind $t <Enter> "lineenter %x %y $id"
1649 $canv bind $t <Motion> "linemotion %x %y $id"
1650 $canv bind $t <Leave> "lineleave $id"
1651 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1652}
1653
1654proc drawtags {id x xt y1} {
1655 global idtags idheads idotherrefs
1656 global linespc lthickness
1657 global canv mainfont commitrow rowtextx
1658
1659 set marks {}
1660 set ntags 0
1661 set nheads 0
1662 if {[info exists idtags($id)]} {
1663 set marks $idtags($id)
1664 set ntags [llength $marks]
1665 }
1666 if {[info exists idheads($id)]} {
1667 set marks [concat $marks $idheads($id)]
1668 set nheads [llength $idheads($id)]
1669 }
1670 if {[info exists idotherrefs($id)]} {
1671 set marks [concat $marks $idotherrefs($id)]
1672 }
1673 if {$marks eq {}} {
1674 return $xt
1675 }
1676
1677 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1678 set yt [expr {$y1 - 0.5 * $linespc}]
1679 set yb [expr {$yt + $linespc - 1}]
1680 set xvals {}
1681 set wvals {}
1682 foreach tag $marks {
1683 set wid [font measure $mainfont $tag]
1684 lappend xvals $xt
1685 lappend wvals $wid
1686 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1687 }
1688 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1689 -width $lthickness -fill black -tags tag.$id]
1690 $canv lower $t
1691 foreach tag $marks x $xvals wid $wvals {
1692 set xl [expr {$x + $delta}]
1693 set xr [expr {$x + $delta + $wid + $lthickness}]
1694 if {[incr ntags -1] >= 0} {
1695 # draw a tag
1696 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1697 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1698 -width 1 -outline black -fill yellow -tags tag.$id]
1699 $canv bind $t <1> [list showtag $tag 1]
1700 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1701 } else {
1702 # draw a head or other ref
1703 if {[incr nheads -1] >= 0} {
1704 set col green
1705 } else {
1706 set col "#ddddff"
1707 }
1708 set xl [expr {$xl - $delta/2}]
1709 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1710 -width 1 -outline black -fill $col -tags tag.$id
1711 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
1712 set rwid [font measure $mainfont $remoteprefix]
1713 set xi [expr {$x + 1}]
1714 set yti [expr {$yt + 1}]
1715 set xri [expr {$x + $rwid}]
1716 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
1717 -width 0 -fill "#ffddaa" -tags tag.$id
1718 }
1719 }
1720 set t [$canv create text $xl $y1 -anchor w -text $tag \
1721 -font $mainfont -tags tag.$id]
1722 if {$ntags >= 0} {
1723 $canv bind $t <1> [list showtag $tag 1]
1724 }
1725 }
1726 return $xt
1727}
1728
1729proc checkcrossings {row endrow} {
1730 global displayorder parentlist rowidlist
1731
1732 for {} {$row < $endrow} {incr row} {
1733 set id [lindex $displayorder $row]
1734 set i [lsearch -exact [lindex $rowidlist $row] $id]
1735 if {$i < 0} continue
1736 set idlist [lindex $rowidlist [expr {$row+1}]]
1737 foreach p [lindex $parentlist $row] {
1738 set j [lsearch -exact $idlist $p]
1739 if {$j > 0} {
1740 if {$j < $i - 1} {
1741 notecrossings $row $p $j $i [expr {$j+1}]
1742 } elseif {$j > $i + 1} {
1743 notecrossings $row $p $i $j [expr {$j-1}]
1744 }
1745 }
1746 }
1747 }
1748}
1749
1750proc notecrossings {row id lo hi corner} {
1751 global rowidlist crossings cornercrossings
1752
1753 for {set i $lo} {[incr i] < $hi} {} {
1754 set p [lindex [lindex $rowidlist $row] $i]
1755 if {$p == {}} continue
1756 if {$i == $corner} {
1757 if {![info exists cornercrossings($id)]
1758 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1759 lappend cornercrossings($id) $p
1760 }
1761 if {![info exists cornercrossings($p)]
1762 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1763 lappend cornercrossings($p) $id
1764 }
1765 } else {
1766 if {![info exists crossings($id)]
1767 || [lsearch -exact $crossings($id) $p] < 0} {
1768 lappend crossings($id) $p
1769 }
1770 if {![info exists crossings($p)]
1771 || [lsearch -exact $crossings($p) $id] < 0} {
1772 lappend crossings($p) $id
1773 }
1774 }
1775 }
1776}
1777
1778proc xcoord {i level ln} {
1779 global canvx0 xspc1 xspc2
1780
1781 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1782 if {$i > 0 && $i == $level} {
1783 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1784 } elseif {$i > $level} {
1785 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1786 }
1787 return $x
1788}
1789
1790proc finishcommits {} {
1791 global commitidx phase
1792 global canv mainfont ctext maincursor textcursor
1793 global findinprogress
1794
1795 if {$commitidx > 0} {
1796 drawrest
1797 } else {
1798 $canv delete all
1799 $canv create text 3 3 -anchor nw -text "No commits selected" \
1800 -font $mainfont -tags textitems
1801 }
1802 if {![info exists findinprogress]} {
1803 . config -cursor $maincursor
1804 settextcursor $textcursor
1805 }
1806 set phase {}
1807}
1808
1809# Don't change the text pane cursor if it is currently the hand cursor,
1810# showing that we are over a sha1 ID link.
1811proc settextcursor {c} {
1812 global ctext curtextcursor
1813
1814 if {[$ctext cget -cursor] == $curtextcursor} {
1815 $ctext config -cursor $c
1816 }
1817 set curtextcursor $c
1818}
1819
1820proc drawrest {} {
1821 global numcommits
1822 global startmsecs
1823 global canvy0 numcommits linespc
1824 global rowlaidout commitidx
1825
1826 set row $rowlaidout
1827 layoutrows $rowlaidout $commitidx 1
1828 layouttail
1829 optimize_rows $row 0 $commitidx
1830 showstuff $commitidx
1831
1832 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1833 #puts "overall $drawmsecs ms for $numcommits commits"
1834}
1835
1836proc findmatches {f} {
1837 global findtype foundstring foundstrlen
1838 if {$findtype == "Regexp"} {
1839 set matches [regexp -indices -all -inline $foundstring $f]
1840 } else {
1841 if {$findtype == "IgnCase"} {
1842 set str [string tolower $f]
1843 } else {
1844 set str $f
1845 }
1846 set matches {}
1847 set i 0
1848 while {[set j [string first $foundstring $str $i]] >= 0} {
1849 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1850 set i [expr {$j + $foundstrlen}]
1851 }
1852 }
1853 return $matches
1854}
1855
1856proc dofind {} {
1857 global findtype findloc findstring markedmatches commitinfo
1858 global numcommits displayorder linehtag linentag linedtag
1859 global mainfont namefont canv canv2 canv3 selectedline
1860 global matchinglines foundstring foundstrlen matchstring
1861 global commitdata
1862
1863 stopfindproc
1864 unmarkmatches
1865 focus .
1866 set matchinglines {}
1867 if {$findloc == "Pickaxe"} {
1868 findpatches
1869 return
1870 }
1871 if {$findtype == "IgnCase"} {
1872 set foundstring [string tolower $findstring]
1873 } else {
1874 set foundstring $findstring
1875 }
1876 set foundstrlen [string length $findstring]
1877 if {$foundstrlen == 0} return
1878 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1879 set matchstring "*$matchstring*"
1880 if {$findloc == "Files"} {
1881 findfiles
1882 return
1883 }
1884 if {![info exists selectedline]} {
1885 set oldsel -1
1886 } else {
1887 set oldsel $selectedline
1888 }
1889 set didsel 0
1890 set fldtypes {Headline Author Date Committer CDate Comment}
1891 set l -1
1892 foreach id $displayorder {
1893 set d $commitdata($id)
1894 incr l
1895 if {$findtype == "Regexp"} {
1896 set doesmatch [regexp $foundstring $d]
1897 } elseif {$findtype == "IgnCase"} {
1898 set doesmatch [string match -nocase $matchstring $d]
1899 } else {
1900 set doesmatch [string match $matchstring $d]
1901 }
1902 if {!$doesmatch} continue
1903 if {![info exists commitinfo($id)]} {
1904 getcommit $id
1905 }
1906 set info $commitinfo($id)
1907 set doesmatch 0
1908 foreach f $info ty $fldtypes {
1909 if {$findloc != "All fields" && $findloc != $ty} {
1910 continue
1911 }
1912 set matches [findmatches $f]
1913 if {$matches == {}} continue
1914 set doesmatch 1
1915 if {$ty == "Headline"} {
1916 drawcmitrow $l
1917 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1918 } elseif {$ty == "Author"} {
1919 drawcmitrow $l
1920 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1921 } elseif {$ty == "Date"} {
1922 drawcmitrow $l
1923 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1924 }
1925 }
1926 if {$doesmatch} {
1927 lappend matchinglines $l
1928 if {!$didsel && $l > $oldsel} {
1929 findselectline $l
1930 set didsel 1
1931 }
1932 }
1933 }
1934 if {$matchinglines == {}} {
1935 bell
1936 } elseif {!$didsel} {
1937 findselectline [lindex $matchinglines 0]
1938 }
1939}
1940
1941proc findselectline {l} {
1942 global findloc commentend ctext
1943 selectline $l 1
1944 if {$findloc == "All fields" || $findloc == "Comments"} {
1945 # highlight the matches in the comments
1946 set f [$ctext get 1.0 $commentend]
1947 set matches [findmatches $f]
1948 foreach match $matches {
1949 set start [lindex $match 0]
1950 set end [expr {[lindex $match 1] + 1}]
1951 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1952 }
1953 }
1954}
1955
1956proc findnext {restart} {
1957 global matchinglines selectedline
1958 if {![info exists matchinglines]} {
1959 if {$restart} {
1960 dofind
1961 }
1962 return
1963 }
1964 if {![info exists selectedline]} return
1965 foreach l $matchinglines {
1966 if {$l > $selectedline} {
1967 findselectline $l
1968 return
1969 }
1970 }
1971 bell
1972}
1973
1974proc findprev {} {
1975 global matchinglines selectedline
1976 if {![info exists matchinglines]} {
1977 dofind
1978 return
1979 }
1980 if {![info exists selectedline]} return
1981 set prev {}
1982 foreach l $matchinglines {
1983 if {$l >= $selectedline} break
1984 set prev $l
1985 }
1986 if {$prev != {}} {
1987 findselectline $prev
1988 } else {
1989 bell
1990 }
1991}
1992
1993proc findlocchange {name ix op} {
1994 global findloc findtype findtypemenu
1995 if {$findloc == "Pickaxe"} {
1996 set findtype Exact
1997 set state disabled
1998 } else {
1999 set state normal
2000 }
2001 $findtypemenu entryconf 1 -state $state
2002 $findtypemenu entryconf 2 -state $state
2003}
2004
2005proc stopfindproc {{done 0}} {
2006 global findprocpid findprocfile findids
2007 global ctext findoldcursor phase maincursor textcursor
2008 global findinprogress
2009
2010 catch {unset findids}
2011 if {[info exists findprocpid]} {
2012 if {!$done} {
2013 catch {exec kill $findprocpid}
2014 }
2015 catch {close $findprocfile}
2016 unset findprocpid
2017 }
2018 if {[info exists findinprogress]} {
2019 unset findinprogress
2020 if {$phase != "incrdraw"} {
2021 . config -cursor $maincursor
2022 settextcursor $textcursor
2023 }
2024 }
2025}
2026
2027proc findpatches {} {
2028 global findstring selectedline numcommits
2029 global findprocpid findprocfile
2030 global finddidsel ctext displayorder findinprogress
2031 global findinsertpos
2032
2033 if {$numcommits == 0} return
2034
2035 # make a list of all the ids to search, starting at the one
2036 # after the selected line (if any)
2037 if {[info exists selectedline]} {
2038 set l $selectedline
2039 } else {
2040 set l -1
2041 }
2042 set inputids {}
2043 for {set i 0} {$i < $numcommits} {incr i} {
2044 if {[incr l] >= $numcommits} {
2045 set l 0
2046 }
2047 append inputids [lindex $displayorder $l] "\n"
2048 }
2049
2050 if {[catch {
2051 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2052 << $inputids] r]
2053 } err]} {
2054 error_popup "Error starting search process: $err"
2055 return
2056 }
2057
2058 set findinsertpos end
2059 set findprocfile $f
2060 set findprocpid [pid $f]
2061 fconfigure $f -blocking 0
2062 fileevent $f readable readfindproc
2063 set finddidsel 0
2064 . config -cursor watch
2065 settextcursor watch
2066 set findinprogress 1
2067}
2068
2069proc readfindproc {} {
2070 global findprocfile finddidsel
2071 global commitrow matchinglines findinsertpos
2072
2073 set n [gets $findprocfile line]
2074 if {$n < 0} {
2075 if {[eof $findprocfile]} {
2076 stopfindproc 1
2077 if {!$finddidsel} {
2078 bell
2079 }
2080 }
2081 return
2082 }
2083 if {![regexp {^[0-9a-f]{40}} $line id]} {
2084 error_popup "Can't parse git-diff-tree output: $line"
2085 stopfindproc
2086 return
2087 }
2088 if {![info exists commitrow($id)]} {
2089 puts stderr "spurious id: $id"
2090 return
2091 }
2092 set l $commitrow($id)
2093 insertmatch $l $id
2094}
2095
2096proc insertmatch {l id} {
2097 global matchinglines findinsertpos finddidsel
2098
2099 if {$findinsertpos == "end"} {
2100 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2101 set matchinglines [linsert $matchinglines 0 $l]
2102 set findinsertpos 1
2103 } else {
2104 lappend matchinglines $l
2105 }
2106 } else {
2107 set matchinglines [linsert $matchinglines $findinsertpos $l]
2108 incr findinsertpos
2109 }
2110 markheadline $l $id
2111 if {!$finddidsel} {
2112 findselectline $l
2113 set finddidsel 1
2114 }
2115}
2116
2117proc findfiles {} {
2118 global selectedline numcommits displayorder ctext
2119 global ffileline finddidsel parentlist
2120 global findinprogress findstartline findinsertpos
2121 global treediffs fdiffid fdiffsneeded fdiffpos
2122 global findmergefiles
2123
2124 if {$numcommits == 0} return
2125
2126 if {[info exists selectedline]} {
2127 set l [expr {$selectedline + 1}]
2128 } else {
2129 set l 0
2130 }
2131 set ffileline $l
2132 set findstartline $l
2133 set diffsneeded {}
2134 set fdiffsneeded {}
2135 while 1 {
2136 set id [lindex $displayorder $l]
2137 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2138 if {![info exists treediffs($id)]} {
2139 append diffsneeded "$id\n"
2140 lappend fdiffsneeded $id
2141 }
2142 }
2143 if {[incr l] >= $numcommits} {
2144 set l 0
2145 }
2146 if {$l == $findstartline} break
2147 }
2148
2149 # start off a git-diff-tree process if needed
2150 if {$diffsneeded ne {}} {
2151 if {[catch {
2152 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2153 } err ]} {
2154 error_popup "Error starting search process: $err"
2155 return
2156 }
2157 catch {unset fdiffid}
2158 set fdiffpos 0
2159 fconfigure $df -blocking 0
2160 fileevent $df readable [list readfilediffs $df]
2161 }
2162
2163 set finddidsel 0
2164 set findinsertpos end
2165 set id [lindex $displayorder $l]
2166 . config -cursor watch
2167 settextcursor watch
2168 set findinprogress 1
2169 findcont
2170 update
2171}
2172
2173proc readfilediffs {df} {
2174 global findid fdiffid fdiffs
2175
2176 set n [gets $df line]
2177 if {$n < 0} {
2178 if {[eof $df]} {
2179 donefilediff
2180 if {[catch {close $df} err]} {
2181 stopfindproc
2182 bell
2183 error_popup "Error in git-diff-tree: $err"
2184 } elseif {[info exists findid]} {
2185 set id $findid
2186 stopfindproc
2187 bell
2188 error_popup "Couldn't find diffs for $id"
2189 }
2190 }
2191 return
2192 }
2193 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2194 # start of a new string of diffs
2195 donefilediff
2196 set fdiffid $id
2197 set fdiffs {}
2198 } elseif {[string match ":*" $line]} {
2199 lappend fdiffs [lindex $line 5]
2200 }
2201}
2202
2203proc donefilediff {} {
2204 global fdiffid fdiffs treediffs findid
2205 global fdiffsneeded fdiffpos
2206
2207 if {[info exists fdiffid]} {
2208 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2209 && $fdiffpos < [llength $fdiffsneeded]} {
2210 # git-diff-tree doesn't output anything for a commit
2211 # which doesn't change anything
2212 set nullid [lindex $fdiffsneeded $fdiffpos]
2213 set treediffs($nullid) {}
2214 if {[info exists findid] && $nullid eq $findid} {
2215 unset findid
2216 findcont
2217 }
2218 incr fdiffpos
2219 }
2220 incr fdiffpos
2221
2222 if {![info exists treediffs($fdiffid)]} {
2223 set treediffs($fdiffid) $fdiffs
2224 }
2225 if {[info exists findid] && $fdiffid eq $findid} {
2226 unset findid
2227 findcont
2228 }
2229 }
2230}
2231
2232proc findcont {} {
2233 global findid treediffs parentlist
2234 global ffileline findstartline finddidsel
2235 global displayorder numcommits matchinglines findinprogress
2236 global findmergefiles
2237
2238 set l $ffileline
2239 while {1} {
2240 set id [lindex $displayorder $l]
2241 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2242 if {![info exists treediffs($id)]} {
2243 set findid $id
2244 set ffileline $l
2245 return
2246 }
2247 set doesmatch 0
2248 foreach f $treediffs($id) {
2249 set x [findmatches $f]
2250 if {$x != {}} {
2251 set doesmatch 1
2252 break
2253 }
2254 }
2255 if {$doesmatch} {
2256 insertmatch $l $id
2257 }
2258 }
2259 if {[incr l] >= $numcommits} {
2260 set l 0
2261 }
2262 if {$l == $findstartline} break
2263 }
2264 stopfindproc
2265 if {!$finddidsel} {
2266 bell
2267 }
2268}
2269
2270# mark a commit as matching by putting a yellow background
2271# behind the headline
2272proc markheadline {l id} {
2273 global canv mainfont linehtag
2274
2275 drawcmitrow $l
2276 set bbox [$canv bbox $linehtag($l)]
2277 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2278 $canv lower $t
2279}
2280
2281# mark the bits of a headline, author or date that match a find string
2282proc markmatches {canv l str tag matches font} {
2283 set bbox [$canv bbox $tag]
2284 set x0 [lindex $bbox 0]
2285 set y0 [lindex $bbox 1]
2286 set y1 [lindex $bbox 3]
2287 foreach match $matches {
2288 set start [lindex $match 0]
2289 set end [lindex $match 1]
2290 if {$start > $end} continue
2291 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2292 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2293 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2294 [expr {$x0+$xlen+2}] $y1 \
2295 -outline {} -tags matches -fill yellow]
2296 $canv lower $t
2297 }
2298}
2299
2300proc unmarkmatches {} {
2301 global matchinglines findids
2302 allcanvs delete matches
2303 catch {unset matchinglines}
2304 catch {unset findids}
2305}
2306
2307proc selcanvline {w x y} {
2308 global canv canvy0 ctext linespc
2309 global rowtextx
2310 set ymax [lindex [$canv cget -scrollregion] 3]
2311 if {$ymax == {}} return
2312 set yfrac [lindex [$canv yview] 0]
2313 set y [expr {$y + $yfrac * $ymax}]
2314 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2315 if {$l < 0} {
2316 set l 0
2317 }
2318 if {$w eq $canv} {
2319 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2320 }
2321 unmarkmatches
2322 selectline $l 1
2323}
2324
2325proc commit_descriptor {p} {
2326 global commitinfo
2327 set l "..."
2328 if {[info exists commitinfo($p)]} {
2329 set l [lindex $commitinfo($p) 0]
2330 }
2331 return "$p ($l)"
2332}
2333
2334# append some text to the ctext widget, and make any SHA1 ID
2335# that we know about be a clickable link.
2336proc appendwithlinks {text} {
2337 global ctext commitrow linknum
2338
2339 set start [$ctext index "end - 1c"]
2340 $ctext insert end $text
2341 $ctext insert end "\n"
2342 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2343 foreach l $links {
2344 set s [lindex $l 0]
2345 set e [lindex $l 1]
2346 set linkid [string range $text $s $e]
2347 if {![info exists commitrow($linkid)]} continue
2348 incr e
2349 $ctext tag add link "$start + $s c" "$start + $e c"
2350 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2351 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2352 incr linknum
2353 }
2354 $ctext tag conf link -foreground blue -underline 1
2355 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2356 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2357}
2358
2359proc viewnextline {dir} {
2360 global canv linespc
2361
2362 $canv delete hover
2363 set ymax [lindex [$canv cget -scrollregion] 3]
2364 set wnow [$canv yview]
2365 set wtop [expr {[lindex $wnow 0] * $ymax}]
2366 set newtop [expr {$wtop + $dir * $linespc}]
2367 if {$newtop < 0} {
2368 set newtop 0
2369 } elseif {$newtop > $ymax} {
2370 set newtop $ymax
2371 }
2372 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2373}
2374
2375proc selectline {l isnew} {
2376 global canv canv2 canv3 ctext commitinfo selectedline
2377 global displayorder linehtag linentag linedtag
2378 global canvy0 linespc parentlist childlist
2379 global cflist currentid sha1entry
2380 global commentend idtags linknum
2381 global mergemax numcommits
2382
2383 $canv delete hover
2384 normalline
2385 if {$l < 0 || $l >= $numcommits} return
2386 set y [expr {$canvy0 + $l * $linespc}]
2387 set ymax [lindex [$canv cget -scrollregion] 3]
2388 set ytop [expr {$y - $linespc - 1}]
2389 set ybot [expr {$y + $linespc + 1}]
2390 set wnow [$canv yview]
2391 set wtop [expr {[lindex $wnow 0] * $ymax}]
2392 set wbot [expr {[lindex $wnow 1] * $ymax}]
2393 set wh [expr {$wbot - $wtop}]
2394 set newtop $wtop
2395 if {$ytop < $wtop} {
2396 if {$ybot < $wtop} {
2397 set newtop [expr {$y - $wh / 2.0}]
2398 } else {
2399 set newtop $ytop
2400 if {$newtop > $wtop - $linespc} {
2401 set newtop [expr {$wtop - $linespc}]
2402 }
2403 }
2404 } elseif {$ybot > $wbot} {
2405 if {$ytop > $wbot} {
2406 set newtop [expr {$y - $wh / 2.0}]
2407 } else {
2408 set newtop [expr {$ybot - $wh}]
2409 if {$newtop < $wtop + $linespc} {
2410 set newtop [expr {$wtop + $linespc}]
2411 }
2412 }
2413 }
2414 if {$newtop != $wtop} {
2415 if {$newtop < 0} {
2416 set newtop 0
2417 }
2418 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2419 drawvisible
2420 }
2421
2422 if {![info exists linehtag($l)]} return
2423 $canv delete secsel
2424 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2425 -tags secsel -fill [$canv cget -selectbackground]]
2426 $canv lower $t
2427 $canv2 delete secsel
2428 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2429 -tags secsel -fill [$canv2 cget -selectbackground]]
2430 $canv2 lower $t
2431 $canv3 delete secsel
2432 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2433 -tags secsel -fill [$canv3 cget -selectbackground]]
2434 $canv3 lower $t
2435
2436 if {$isnew} {
2437 addtohistory [list selectline $l 0]
2438 }
2439
2440 set selectedline $l
2441
2442 set id [lindex $displayorder $l]
2443 set currentid $id
2444 $sha1entry delete 0 end
2445 $sha1entry insert 0 $id
2446 $sha1entry selection from 0
2447 $sha1entry selection to end
2448
2449 $ctext conf -state normal
2450 $ctext delete 0.0 end
2451 set linknum 0
2452 $ctext mark set fmark.0 0.0
2453 $ctext mark gravity fmark.0 left
2454 set info $commitinfo($id)
2455 set date [formatdate [lindex $info 2]]
2456 $ctext insert end "Author: [lindex $info 1] $date\n"
2457 set date [formatdate [lindex $info 4]]
2458 $ctext insert end "Committer: [lindex $info 3] $date\n"
2459 if {[info exists idtags($id)]} {
2460 $ctext insert end "Tags:"
2461 foreach tag $idtags($id) {
2462 $ctext insert end " $tag"
2463 }
2464 $ctext insert end "\n"
2465 }
2466
2467 set comment {}
2468 set olds [lindex $parentlist $l]
2469 if {[llength $olds] > 1} {
2470 set np 0
2471 foreach p $olds {
2472 if {$np >= $mergemax} {
2473 set tag mmax
2474 } else {
2475 set tag m$np
2476 }
2477 $ctext insert end "Parent: " $tag
2478 appendwithlinks [commit_descriptor $p]
2479 incr np
2480 }
2481 } else {
2482 foreach p $olds {
2483 append comment "Parent: [commit_descriptor $p]\n"
2484 }
2485 }
2486
2487 foreach c [lindex $childlist $l] {
2488 append comment "Child: [commit_descriptor $c]\n"
2489 }
2490 append comment "\n"
2491 append comment [lindex $info 5]
2492
2493 # make anything that looks like a SHA1 ID be a clickable link
2494 appendwithlinks $comment
2495
2496 $ctext tag delete Comments
2497 $ctext tag remove found 1.0 end
2498 $ctext conf -state disabled
2499 set commentend [$ctext index "end - 1c"]
2500
2501 $cflist delete 0 end
2502 $cflist insert end "Comments"
2503 if {[llength $olds] <= 1} {
2504 startdiff $id
2505 } else {
2506 mergediff $id $l
2507 }
2508}
2509
2510proc selfirstline {} {
2511 unmarkmatches
2512 selectline 0 1
2513}
2514
2515proc sellastline {} {
2516 global numcommits
2517 unmarkmatches
2518 set l [expr {$numcommits - 1}]
2519 selectline $l 1
2520}
2521
2522proc selnextline {dir} {
2523 global selectedline
2524 if {![info exists selectedline]} return
2525 set l [expr {$selectedline + $dir}]
2526 unmarkmatches
2527 selectline $l 1
2528}
2529
2530proc selnextpage {dir} {
2531 global canv linespc selectedline numcommits
2532
2533 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2534 if {$lpp < 1} {
2535 set lpp 1
2536 }
2537 allcanvs yview scroll [expr {$dir * $lpp}] units
2538 if {![info exists selectedline]} return
2539 set l [expr {$selectedline + $dir * $lpp}]
2540 if {$l < 0} {
2541 set l 0
2542 } elseif {$l >= $numcommits} {
2543 set l [expr $numcommits - 1]
2544 }
2545 unmarkmatches
2546 selectline $l 1
2547}
2548
2549proc unselectline {} {
2550 global selectedline
2551
2552 catch {unset selectedline}
2553 allcanvs delete secsel
2554}
2555
2556proc addtohistory {cmd} {
2557 global history historyindex
2558
2559 if {$historyindex > 0
2560 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2561 return
2562 }
2563
2564 if {$historyindex < [llength $history]} {
2565 set history [lreplace $history $historyindex end $cmd]
2566 } else {
2567 lappend history $cmd
2568 }
2569 incr historyindex
2570 if {$historyindex > 1} {
2571 .ctop.top.bar.leftbut conf -state normal
2572 } else {
2573 .ctop.top.bar.leftbut conf -state disabled
2574 }
2575 .ctop.top.bar.rightbut conf -state disabled
2576}
2577
2578proc goback {} {
2579 global history historyindex
2580
2581 if {$historyindex > 1} {
2582 incr historyindex -1
2583 set cmd [lindex $history [expr {$historyindex - 1}]]
2584 eval $cmd
2585 .ctop.top.bar.rightbut conf -state normal
2586 }
2587 if {$historyindex <= 1} {
2588 .ctop.top.bar.leftbut conf -state disabled
2589 }
2590}
2591
2592proc goforw {} {
2593 global history historyindex
2594
2595 if {$historyindex < [llength $history]} {
2596 set cmd [lindex $history $historyindex]
2597 incr historyindex
2598 eval $cmd
2599 .ctop.top.bar.leftbut conf -state normal
2600 }
2601 if {$historyindex >= [llength $history]} {
2602 .ctop.top.bar.rightbut conf -state disabled
2603 }
2604}
2605
2606proc mergediff {id l} {
2607 global diffmergeid diffopts mdifffd
2608 global difffilestart diffids
2609 global parentlist
2610
2611 set diffmergeid $id
2612 set diffids $id
2613 catch {unset difffilestart}
2614 # this doesn't seem to actually affect anything...
2615 set env(GIT_DIFF_OPTS) $diffopts
2616 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2617 if {[catch {set mdf [open $cmd r]} err]} {
2618 error_popup "Error getting merge diffs: $err"
2619 return
2620 }
2621 fconfigure $mdf -blocking 0
2622 set mdifffd($id) $mdf
2623 set np [llength [lindex $parentlist $l]]
2624 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2625 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2626}
2627
2628proc getmergediffline {mdf id np} {
2629 global diffmergeid ctext cflist nextupdate mergemax
2630 global difffilestart mdifffd
2631
2632 set n [gets $mdf line]
2633 if {$n < 0} {
2634 if {[eof $mdf]} {
2635 close $mdf
2636 }
2637 return
2638 }
2639 if {![info exists diffmergeid] || $id != $diffmergeid
2640 || $mdf != $mdifffd($id)} {
2641 return
2642 }
2643 $ctext conf -state normal
2644 if {[regexp {^diff --cc (.*)} $line match fname]} {
2645 # start of a new file
2646 $ctext insert end "\n"
2647 set here [$ctext index "end - 1c"]
2648 set i [$cflist index end]
2649 $ctext mark set fmark.$i $here
2650 $ctext mark gravity fmark.$i left
2651 set difffilestart([expr {$i-1}]) $here
2652 $cflist insert end $fname
2653 set l [expr {(78 - [string length $fname]) / 2}]
2654 set pad [string range "----------------------------------------" 1 $l]
2655 $ctext insert end "$pad $fname $pad\n" filesep
2656 } elseif {[regexp {^@@} $line]} {
2657 $ctext insert end "$line\n" hunksep
2658 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2659 # do nothing
2660 } else {
2661 # parse the prefix - one ' ', '-' or '+' for each parent
2662 set spaces {}
2663 set minuses {}
2664 set pluses {}
2665 set isbad 0
2666 for {set j 0} {$j < $np} {incr j} {
2667 set c [string range $line $j $j]
2668 if {$c == " "} {
2669 lappend spaces $j
2670 } elseif {$c == "-"} {
2671 lappend minuses $j
2672 } elseif {$c == "+"} {
2673 lappend pluses $j
2674 } else {
2675 set isbad 1
2676 break
2677 }
2678 }
2679 set tags {}
2680 set num {}
2681 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2682 # line doesn't appear in result, parents in $minuses have the line
2683 set num [lindex $minuses 0]
2684 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2685 # line appears in result, parents in $pluses don't have the line
2686 lappend tags mresult
2687 set num [lindex $spaces 0]
2688 }
2689 if {$num ne {}} {
2690 if {$num >= $mergemax} {
2691 set num "max"
2692 }
2693 lappend tags m$num
2694 }
2695 $ctext insert end "$line\n" $tags
2696 }
2697 $ctext conf -state disabled
2698 if {[clock clicks -milliseconds] >= $nextupdate} {
2699 incr nextupdate 100
2700 fileevent $mdf readable {}
2701 update
2702 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2703 }
2704}
2705
2706proc startdiff {ids} {
2707 global treediffs diffids treepending diffmergeid
2708
2709 set diffids $ids
2710 catch {unset diffmergeid}
2711 if {![info exists treediffs($ids)]} {
2712 if {![info exists treepending]} {
2713 gettreediffs $ids
2714 }
2715 } else {
2716 addtocflist $ids
2717 }
2718}
2719
2720proc addtocflist {ids} {
2721 global treediffs cflist
2722 foreach f $treediffs($ids) {
2723 $cflist insert end $f
2724 }
2725 getblobdiffs $ids
2726}
2727
2728proc gettreediffs {ids} {
2729 global treediff treepending
2730 set treepending $ids
2731 set treediff {}
2732 if {[catch \
2733 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2734 ]} return
2735 fconfigure $gdtf -blocking 0
2736 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2737}
2738
2739proc gettreediffline {gdtf ids} {
2740 global treediff treediffs treepending diffids diffmergeid
2741
2742 set n [gets $gdtf line]
2743 if {$n < 0} {
2744 if {![eof $gdtf]} return
2745 close $gdtf
2746 set treediffs($ids) $treediff
2747 unset treepending
2748 if {$ids != $diffids} {
2749 if {![info exists diffmergeid]} {
2750 gettreediffs $diffids
2751 }
2752 } else {
2753 addtocflist $ids
2754 }
2755 return
2756 }
2757 set file [lindex $line 5]
2758 lappend treediff $file
2759}
2760
2761proc getblobdiffs {ids} {
2762 global diffopts blobdifffd diffids env curdifftag curtagstart
2763 global difffilestart nextupdate diffinhdr treediffs
2764
2765 set env(GIT_DIFF_OPTS) $diffopts
2766 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2767 if {[catch {set bdf [open $cmd r]} err]} {
2768 puts "error getting diffs: $err"
2769 return
2770 }
2771 set diffinhdr 0
2772 fconfigure $bdf -blocking 0
2773 set blobdifffd($ids) $bdf
2774 set curdifftag Comments
2775 set curtagstart 0.0
2776 catch {unset difffilestart}
2777 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2778 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2779}
2780
2781proc getblobdiffline {bdf ids} {
2782 global diffids blobdifffd ctext curdifftag curtagstart
2783 global diffnexthead diffnextnote difffilestart
2784 global nextupdate diffinhdr treediffs
2785
2786 set n [gets $bdf line]
2787 if {$n < 0} {
2788 if {[eof $bdf]} {
2789 close $bdf
2790 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2791 $ctext tag add $curdifftag $curtagstart end
2792 }
2793 }
2794 return
2795 }
2796 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2797 return
2798 }
2799 $ctext conf -state normal
2800 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2801 # start of a new file
2802 $ctext insert end "\n"
2803 $ctext tag add $curdifftag $curtagstart end
2804 set curtagstart [$ctext index "end - 1c"]
2805 set header $newname
2806 set here [$ctext index "end - 1c"]
2807 set i [lsearch -exact $treediffs($diffids) $fname]
2808 if {$i >= 0} {
2809 set difffilestart($i) $here
2810 incr i
2811 $ctext mark set fmark.$i $here
2812 $ctext mark gravity fmark.$i left
2813 }
2814 if {$newname != $fname} {
2815 set i [lsearch -exact $treediffs($diffids) $newname]
2816 if {$i >= 0} {
2817 set difffilestart($i) $here
2818 incr i
2819 $ctext mark set fmark.$i $here
2820 $ctext mark gravity fmark.$i left
2821 }
2822 }
2823 set curdifftag "f:$fname"
2824 $ctext tag delete $curdifftag
2825 set l [expr {(78 - [string length $header]) / 2}]
2826 set pad [string range "----------------------------------------" 1 $l]
2827 $ctext insert end "$pad $header $pad\n" filesep
2828 set diffinhdr 1
2829 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2830 # do nothing
2831 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2832 set diffinhdr 0
2833 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2834 $line match f1l f1c f2l f2c rest]} {
2835 $ctext insert end "$line\n" hunksep
2836 set diffinhdr 0
2837 } else {
2838 set x [string range $line 0 0]
2839 if {$x == "-" || $x == "+"} {
2840 set tag [expr {$x == "+"}]
2841 $ctext insert end "$line\n" d$tag
2842 } elseif {$x == " "} {
2843 $ctext insert end "$line\n"
2844 } elseif {$diffinhdr || $x == "\\"} {
2845 # e.g. "\ No newline at end of file"
2846 $ctext insert end "$line\n" filesep
2847 } else {
2848 # Something else we don't recognize
2849 if {$curdifftag != "Comments"} {
2850 $ctext insert end "\n"
2851 $ctext tag add $curdifftag $curtagstart end
2852 set curtagstart [$ctext index "end - 1c"]
2853 set curdifftag Comments
2854 }
2855 $ctext insert end "$line\n" filesep
2856 }
2857 }
2858 $ctext conf -state disabled
2859 if {[clock clicks -milliseconds] >= $nextupdate} {
2860 incr nextupdate 100
2861 fileevent $bdf readable {}
2862 update
2863 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2864 }
2865}
2866
2867proc nextfile {} {
2868 global difffilestart ctext
2869 set here [$ctext index @0,0]
2870 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2871 if {[$ctext compare $difffilestart($i) > $here]} {
2872 if {![info exists pos]
2873 || [$ctext compare $difffilestart($i) < $pos]} {
2874 set pos $difffilestart($i)
2875 }
2876 }
2877 }
2878 if {[info exists pos]} {
2879 $ctext yview $pos
2880 }
2881}
2882
2883proc listboxsel {} {
2884 global ctext cflist currentid
2885 if {![info exists currentid]} return
2886 set sel [lsort [$cflist curselection]]
2887 if {$sel eq {}} return
2888 set first [lindex $sel 0]
2889 catch {$ctext yview fmark.$first}
2890}
2891
2892proc setcoords {} {
2893 global linespc charspc canvx0 canvy0 mainfont
2894 global xspc1 xspc2 lthickness
2895
2896 set linespc [font metrics $mainfont -linespace]
2897 set charspc [font measure $mainfont "m"]
2898 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2899 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2900 set lthickness [expr {int($linespc / 9) + 1}]
2901 set xspc1(0) $linespc
2902 set xspc2 $linespc
2903}
2904
2905proc redisplay {} {
2906 global canv
2907 global selectedline
2908
2909 set ymax [lindex [$canv cget -scrollregion] 3]
2910 if {$ymax eq {} || $ymax == 0} return
2911 set span [$canv yview]
2912 clear_display
2913 setcanvscroll
2914 allcanvs yview moveto [lindex $span 0]
2915 drawvisible
2916 if {[info exists selectedline]} {
2917 selectline $selectedline 0
2918 }
2919}
2920
2921proc incrfont {inc} {
2922 global mainfont namefont textfont ctext canv phase
2923 global stopped entries
2924 unmarkmatches
2925 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2926 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2927 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2928 setcoords
2929 $ctext conf -font $textfont
2930 $ctext tag conf filesep -font [concat $textfont bold]
2931 foreach e $entries {
2932 $e conf -font $mainfont
2933 }
2934 if {$phase == "getcommits"} {
2935 $canv itemconf textitems -font $mainfont
2936 }
2937 redisplay
2938}
2939
2940proc clearsha1 {} {
2941 global sha1entry sha1string
2942 if {[string length $sha1string] == 40} {
2943 $sha1entry delete 0 end
2944 }
2945}
2946
2947proc sha1change {n1 n2 op} {
2948 global sha1string currentid sha1but
2949 if {$sha1string == {}
2950 || ([info exists currentid] && $sha1string == $currentid)} {
2951 set state disabled
2952 } else {
2953 set state normal
2954 }
2955 if {[$sha1but cget -state] == $state} return
2956 if {$state == "normal"} {
2957 $sha1but conf -state normal -relief raised -text "Goto: "
2958 } else {
2959 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2960 }
2961}
2962
2963proc gotocommit {} {
2964 global sha1string currentid commitrow tagids headids
2965 global displayorder numcommits
2966
2967 if {$sha1string == {}
2968 || ([info exists currentid] && $sha1string == $currentid)} return
2969 if {[info exists tagids($sha1string)]} {
2970 set id $tagids($sha1string)
2971 } elseif {[info exists headids($sha1string)]} {
2972 set id $headids($sha1string)
2973 } else {
2974 set id [string tolower $sha1string]
2975 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2976 set matches {}
2977 foreach i $displayorder {
2978 if {[string match $id* $i]} {
2979 lappend matches $i
2980 }
2981 }
2982 if {$matches ne {}} {
2983 if {[llength $matches] > 1} {
2984 error_popup "Short SHA1 id $id is ambiguous"
2985 return
2986 }
2987 set id [lindex $matches 0]
2988 }
2989 }
2990 }
2991 if {[info exists commitrow($id)]} {
2992 selectline $commitrow($id) 1
2993 return
2994 }
2995 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2996 set type "SHA1 id"
2997 } else {
2998 set type "Tag/Head"
2999 }
3000 error_popup "$type $sha1string is not known"
3001}
3002
3003proc lineenter {x y id} {
3004 global hoverx hovery hoverid hovertimer
3005 global commitinfo canv
3006
3007 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3008 set hoverx $x
3009 set hovery $y
3010 set hoverid $id
3011 if {[info exists hovertimer]} {
3012 after cancel $hovertimer
3013 }
3014 set hovertimer [after 500 linehover]
3015 $canv delete hover
3016}
3017
3018proc linemotion {x y id} {
3019 global hoverx hovery hoverid hovertimer
3020
3021 if {[info exists hoverid] && $id == $hoverid} {
3022 set hoverx $x
3023 set hovery $y
3024 if {[info exists hovertimer]} {
3025 after cancel $hovertimer
3026 }
3027 set hovertimer [after 500 linehover]
3028 }
3029}
3030
3031proc lineleave {id} {
3032 global hoverid hovertimer canv
3033
3034 if {[info exists hoverid] && $id == $hoverid} {
3035 $canv delete hover
3036 if {[info exists hovertimer]} {
3037 after cancel $hovertimer
3038 unset hovertimer
3039 }
3040 unset hoverid
3041 }
3042}
3043
3044proc linehover {} {
3045 global hoverx hovery hoverid hovertimer
3046 global canv linespc lthickness
3047 global commitinfo mainfont
3048
3049 set text [lindex $commitinfo($hoverid) 0]
3050 set ymax [lindex [$canv cget -scrollregion] 3]
3051 if {$ymax == {}} return
3052 set yfrac [lindex [$canv yview] 0]
3053 set x [expr {$hoverx + 2 * $linespc}]
3054 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3055 set x0 [expr {$x - 2 * $lthickness}]
3056 set y0 [expr {$y - 2 * $lthickness}]
3057 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3058 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3059 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3060 -fill \#ffff80 -outline black -width 1 -tags hover]
3061 $canv raise $t
3062 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3063 $canv raise $t
3064}
3065
3066proc clickisonarrow {id y} {
3067 global lthickness idrowranges
3068
3069 set thresh [expr {2 * $lthickness + 6}]
3070 set n [expr {[llength $idrowranges($id)] - 1}]
3071 for {set i 1} {$i < $n} {incr i} {
3072 set row [lindex $idrowranges($id) $i]
3073 if {abs([yc $row] - $y) < $thresh} {
3074 return $i
3075 }
3076 }
3077 return {}
3078}
3079
3080proc arrowjump {id n y} {
3081 global idrowranges canv
3082
3083 # 1 <-> 2, 3 <-> 4, etc...
3084 set n [expr {(($n - 1) ^ 1) + 1}]
3085 set row [lindex $idrowranges($id) $n]
3086 set yt [yc $row]
3087 set ymax [lindex [$canv cget -scrollregion] 3]
3088 if {$ymax eq {} || $ymax <= 0} return
3089 set view [$canv yview]
3090 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3091 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3092 if {$yfrac < 0} {
3093 set yfrac 0
3094 }
3095 allcanvs yview moveto $yfrac
3096}
3097
3098proc lineclick {x y id isnew} {
3099 global ctext commitinfo childlist commitrow cflist canv thickerline
3100
3101 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3102 unmarkmatches
3103 unselectline
3104 normalline
3105 $canv delete hover
3106 # draw this line thicker than normal
3107 set thickerline $id
3108 drawlines $id
3109 if {$isnew} {
3110 set ymax [lindex [$canv cget -scrollregion] 3]
3111 if {$ymax eq {}} return
3112 set yfrac [lindex [$canv yview] 0]
3113 set y [expr {$y + $yfrac * $ymax}]
3114 }
3115 set dirn [clickisonarrow $id $y]
3116 if {$dirn ne {}} {
3117 arrowjump $id $dirn $y
3118 return
3119 }
3120
3121 if {$isnew} {
3122 addtohistory [list lineclick $x $y $id 0]
3123 }
3124 # fill the details pane with info about this line
3125 $ctext conf -state normal
3126 $ctext delete 0.0 end
3127 $ctext tag conf link -foreground blue -underline 1
3128 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3129 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3130 $ctext insert end "Parent:\t"
3131 $ctext insert end $id [list link link0]
3132 $ctext tag bind link0 <1> [list selbyid $id]
3133 set info $commitinfo($id)
3134 $ctext insert end "\n\t[lindex $info 0]\n"
3135 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3136 set date [formatdate [lindex $info 2]]
3137 $ctext insert end "\tDate:\t$date\n"
3138 set kids [lindex $childlist $commitrow($id)]
3139 if {$kids ne {}} {
3140 $ctext insert end "\nChildren:"
3141 set i 0
3142 foreach child $kids {
3143 incr i
3144 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3145 set info $commitinfo($child)
3146 $ctext insert end "\n\t"
3147 $ctext insert end $child [list link link$i]
3148 $ctext tag bind link$i <1> [list selbyid $child]
3149 $ctext insert end "\n\t[lindex $info 0]"
3150 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3151 set date [formatdate [lindex $info 2]]
3152 $ctext insert end "\n\tDate:\t$date\n"
3153 }
3154 }
3155 $ctext conf -state disabled
3156
3157 $cflist delete 0 end
3158}
3159
3160proc normalline {} {
3161 global thickerline
3162 if {[info exists thickerline]} {
3163 set id $thickerline
3164 unset thickerline
3165 drawlines $id
3166 }
3167}
3168
3169proc selbyid {id} {
3170 global commitrow
3171 if {[info exists commitrow($id)]} {
3172 selectline $commitrow($id) 1
3173 }
3174}
3175
3176proc mstime {} {
3177 global startmstime
3178 if {![info exists startmstime]} {
3179 set startmstime [clock clicks -milliseconds]
3180 }
3181 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3182}
3183
3184proc rowmenu {x y id} {
3185 global rowctxmenu commitrow selectedline rowmenuid
3186
3187 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3188 set state disabled
3189 } else {
3190 set state normal
3191 }
3192 $rowctxmenu entryconfigure 0 -state $state
3193 $rowctxmenu entryconfigure 1 -state $state
3194 $rowctxmenu entryconfigure 2 -state $state
3195 set rowmenuid $id
3196 tk_popup $rowctxmenu $x $y
3197}
3198
3199proc diffvssel {dirn} {
3200 global rowmenuid selectedline displayorder
3201
3202 if {![info exists selectedline]} return
3203 if {$dirn} {
3204 set oldid [lindex $displayorder $selectedline]
3205 set newid $rowmenuid
3206 } else {
3207 set oldid $rowmenuid
3208 set newid [lindex $displayorder $selectedline]
3209 }
3210 addtohistory [list doseldiff $oldid $newid]
3211 doseldiff $oldid $newid
3212}
3213
3214proc doseldiff {oldid newid} {
3215 global ctext cflist
3216 global commitinfo
3217
3218 $ctext conf -state normal
3219 $ctext delete 0.0 end
3220 $ctext mark set fmark.0 0.0
3221 $ctext mark gravity fmark.0 left
3222 $cflist delete 0 end
3223 $cflist insert end "Top"
3224 $ctext insert end "From "
3225 $ctext tag conf link -foreground blue -underline 1
3226 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3227 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3228 $ctext tag bind link0 <1> [list selbyid $oldid]
3229 $ctext insert end $oldid [list link link0]
3230 $ctext insert end "\n "
3231 $ctext insert end [lindex $commitinfo($oldid) 0]
3232 $ctext insert end "\n\nTo "
3233 $ctext tag bind link1 <1> [list selbyid $newid]
3234 $ctext insert end $newid [list link link1]
3235 $ctext insert end "\n "
3236 $ctext insert end [lindex $commitinfo($newid) 0]
3237 $ctext insert end "\n"
3238 $ctext conf -state disabled
3239 $ctext tag delete Comments
3240 $ctext tag remove found 1.0 end
3241 startdiff [list $oldid $newid]
3242}
3243
3244proc mkpatch {} {
3245 global rowmenuid currentid commitinfo patchtop patchnum
3246
3247 if {![info exists currentid]} return
3248 set oldid $currentid
3249 set oldhead [lindex $commitinfo($oldid) 0]
3250 set newid $rowmenuid
3251 set newhead [lindex $commitinfo($newid) 0]
3252 set top .patch
3253 set patchtop $top
3254 catch {destroy $top}
3255 toplevel $top
3256 label $top.title -text "Generate patch"
3257 grid $top.title - -pady 10
3258 label $top.from -text "From:"
3259 entry $top.fromsha1 -width 40 -relief flat
3260 $top.fromsha1 insert 0 $oldid
3261 $top.fromsha1 conf -state readonly
3262 grid $top.from $top.fromsha1 -sticky w
3263 entry $top.fromhead -width 60 -relief flat
3264 $top.fromhead insert 0 $oldhead
3265 $top.fromhead conf -state readonly
3266 grid x $top.fromhead -sticky w
3267 label $top.to -text "To:"
3268 entry $top.tosha1 -width 40 -relief flat
3269 $top.tosha1 insert 0 $newid
3270 $top.tosha1 conf -state readonly
3271 grid $top.to $top.tosha1 -sticky w
3272 entry $top.tohead -width 60 -relief flat
3273 $top.tohead insert 0 $newhead
3274 $top.tohead conf -state readonly
3275 grid x $top.tohead -sticky w
3276 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3277 grid $top.rev x -pady 10
3278 label $top.flab -text "Output file:"
3279 entry $top.fname -width 60
3280 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3281 incr patchnum
3282 grid $top.flab $top.fname -sticky w
3283 frame $top.buts
3284 button $top.buts.gen -text "Generate" -command mkpatchgo
3285 button $top.buts.can -text "Cancel" -command mkpatchcan
3286 grid $top.buts.gen $top.buts.can
3287 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3288 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3289 grid $top.buts - -pady 10 -sticky ew
3290 focus $top.fname
3291}
3292
3293proc mkpatchrev {} {
3294 global patchtop
3295
3296 set oldid [$patchtop.fromsha1 get]
3297 set oldhead [$patchtop.fromhead get]
3298 set newid [$patchtop.tosha1 get]
3299 set newhead [$patchtop.tohead get]
3300 foreach e [list fromsha1 fromhead tosha1 tohead] \
3301 v [list $newid $newhead $oldid $oldhead] {
3302 $patchtop.$e conf -state normal
3303 $patchtop.$e delete 0 end
3304 $patchtop.$e insert 0 $v
3305 $patchtop.$e conf -state readonly
3306 }
3307}
3308
3309proc mkpatchgo {} {
3310 global patchtop
3311
3312 set oldid [$patchtop.fromsha1 get]
3313 set newid [$patchtop.tosha1 get]
3314 set fname [$patchtop.fname get]
3315 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3316 error_popup "Error creating patch: $err"
3317 }
3318 catch {destroy $patchtop}
3319 unset patchtop
3320}
3321
3322proc mkpatchcan {} {
3323 global patchtop
3324
3325 catch {destroy $patchtop}
3326 unset patchtop
3327}
3328
3329proc mktag {} {
3330 global rowmenuid mktagtop commitinfo
3331
3332 set top .maketag
3333 set mktagtop $top
3334 catch {destroy $top}
3335 toplevel $top
3336 label $top.title -text "Create tag"
3337 grid $top.title - -pady 10
3338 label $top.id -text "ID:"
3339 entry $top.sha1 -width 40 -relief flat
3340 $top.sha1 insert 0 $rowmenuid
3341 $top.sha1 conf -state readonly
3342 grid $top.id $top.sha1 -sticky w
3343 entry $top.head -width 60 -relief flat
3344 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3345 $top.head conf -state readonly
3346 grid x $top.head -sticky w
3347 label $top.tlab -text "Tag name:"
3348 entry $top.tag -width 60
3349 grid $top.tlab $top.tag -sticky w
3350 frame $top.buts
3351 button $top.buts.gen -text "Create" -command mktaggo
3352 button $top.buts.can -text "Cancel" -command mktagcan
3353 grid $top.buts.gen $top.buts.can
3354 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3355 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3356 grid $top.buts - -pady 10 -sticky ew
3357 focus $top.tag
3358}
3359
3360proc domktag {} {
3361 global mktagtop env tagids idtags
3362
3363 set id [$mktagtop.sha1 get]
3364 set tag [$mktagtop.tag get]
3365 if {$tag == {}} {
3366 error_popup "No tag name specified"
3367 return
3368 }
3369 if {[info exists tagids($tag)]} {
3370 error_popup "Tag \"$tag\" already exists"
3371 return
3372 }
3373 if {[catch {
3374 set dir [gitdir]
3375 set fname [file join $dir "refs/tags" $tag]
3376 set f [open $fname w]
3377 puts $f $id
3378 close $f
3379 } err]} {
3380 error_popup "Error creating tag: $err"
3381 return
3382 }
3383
3384 set tagids($tag) $id
3385 lappend idtags($id) $tag
3386 redrawtags $id
3387}
3388
3389proc redrawtags {id} {
3390 global canv linehtag commitrow idpos selectedline
3391
3392 if {![info exists commitrow($id)]} return
3393 drawcmitrow $commitrow($id)
3394 $canv delete tag.$id
3395 set xt [eval drawtags $id $idpos($id)]
3396 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3397 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3398 selectline $selectedline 0
3399 }
3400}
3401
3402proc mktagcan {} {
3403 global mktagtop
3404
3405 catch {destroy $mktagtop}
3406 unset mktagtop
3407}
3408
3409proc mktaggo {} {
3410 domktag
3411 mktagcan
3412}
3413
3414proc writecommit {} {
3415 global rowmenuid wrcomtop commitinfo wrcomcmd
3416
3417 set top .writecommit
3418 set wrcomtop $top
3419 catch {destroy $top}
3420 toplevel $top
3421 label $top.title -text "Write commit to file"
3422 grid $top.title - -pady 10
3423 label $top.id -text "ID:"
3424 entry $top.sha1 -width 40 -relief flat
3425 $top.sha1 insert 0 $rowmenuid
3426 $top.sha1 conf -state readonly
3427 grid $top.id $top.sha1 -sticky w
3428 entry $top.head -width 60 -relief flat
3429 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3430 $top.head conf -state readonly
3431 grid x $top.head -sticky w
3432 label $top.clab -text "Command:"
3433 entry $top.cmd -width 60 -textvariable wrcomcmd
3434 grid $top.clab $top.cmd -sticky w -pady 10
3435 label $top.flab -text "Output file:"
3436 entry $top.fname -width 60
3437 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3438 grid $top.flab $top.fname -sticky w
3439 frame $top.buts
3440 button $top.buts.gen -text "Write" -command wrcomgo
3441 button $top.buts.can -text "Cancel" -command wrcomcan
3442 grid $top.buts.gen $top.buts.can
3443 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3444 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3445 grid $top.buts - -pady 10 -sticky ew
3446 focus $top.fname
3447}
3448
3449proc wrcomgo {} {
3450 global wrcomtop
3451
3452 set id [$wrcomtop.sha1 get]
3453 set cmd "echo $id | [$wrcomtop.cmd get]"
3454 set fname [$wrcomtop.fname get]
3455 if {[catch {exec sh -c $cmd >$fname &} err]} {
3456 error_popup "Error writing commit: $err"
3457 }
3458 catch {destroy $wrcomtop}
3459 unset wrcomtop
3460}
3461
3462proc wrcomcan {} {
3463 global wrcomtop
3464
3465 catch {destroy $wrcomtop}
3466 unset wrcomtop
3467}
3468
3469proc listrefs {id} {
3470 global idtags idheads idotherrefs
3471
3472 set x {}
3473 if {[info exists idtags($id)]} {
3474 set x $idtags($id)
3475 }
3476 set y {}
3477 if {[info exists idheads($id)]} {
3478 set y $idheads($id)
3479 }
3480 set z {}
3481 if {[info exists idotherrefs($id)]} {
3482 set z $idotherrefs($id)
3483 }
3484 return [list $x $y $z]
3485}
3486
3487proc rereadrefs {} {
3488 global idtags idheads idotherrefs
3489
3490 set refids [concat [array names idtags] \
3491 [array names idheads] [array names idotherrefs]]
3492 foreach id $refids {
3493 if {![info exists ref($id)]} {
3494 set ref($id) [listrefs $id]
3495 }
3496 }
3497 readrefs
3498 set refids [lsort -unique [concat $refids [array names idtags] \
3499 [array names idheads] [array names idotherrefs]]]
3500 foreach id $refids {
3501 set v [listrefs $id]
3502 if {![info exists ref($id)] || $ref($id) != $v} {
3503 redrawtags $id
3504 }
3505 }
3506}
3507
3508proc showtag {tag isnew} {
3509 global ctext cflist tagcontents tagids linknum
3510
3511 if {$isnew} {
3512 addtohistory [list showtag $tag 0]
3513 }
3514 $ctext conf -state normal
3515 $ctext delete 0.0 end
3516 set linknum 0
3517 if {[info exists tagcontents($tag)]} {
3518 set text $tagcontents($tag)
3519 } else {
3520 set text "Tag: $tag\nId: $tagids($tag)"
3521 }
3522 appendwithlinks $text
3523 $ctext conf -state disabled
3524 $cflist delete 0 end
3525}
3526
3527proc doquit {} {
3528 global stopped
3529 set stopped 100
3530 destroy .
3531}
3532
3533proc doprefs {} {
3534 global maxwidth maxgraphpct diffopts findmergefiles
3535 global oldprefs prefstop
3536
3537 set top .gitkprefs
3538 set prefstop $top
3539 if {[winfo exists $top]} {
3540 raise $top
3541 return
3542 }
3543 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3544 set oldprefs($v) [set $v]
3545 }
3546 toplevel $top
3547 wm title $top "Gitk preferences"
3548 label $top.ldisp -text "Commit list display options"
3549 grid $top.ldisp - -sticky w -pady 10
3550 label $top.spacer -text " "
3551 label $top.maxwidthl -text "Maximum graph width (lines)" \
3552 -font optionfont
3553 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3554 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3555 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3556 -font optionfont
3557 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3558 grid x $top.maxpctl $top.maxpct -sticky w
3559 checkbutton $top.findm -variable findmergefiles
3560 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3561 -font optionfont
3562 grid $top.findm $top.findml - -sticky w
3563 label $top.ddisp -text "Diff display options"
3564 grid $top.ddisp - -sticky w -pady 10
3565 label $top.diffoptl -text "Options for diff program" \
3566 -font optionfont
3567 entry $top.diffopt -width 20 -textvariable diffopts
3568 grid x $top.diffoptl $top.diffopt -sticky w
3569 frame $top.buts
3570 button $top.buts.ok -text "OK" -command prefsok
3571 button $top.buts.can -text "Cancel" -command prefscan
3572 grid $top.buts.ok $top.buts.can
3573 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3574 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3575 grid $top.buts - - -pady 10 -sticky ew
3576}
3577
3578proc prefscan {} {
3579 global maxwidth maxgraphpct diffopts findmergefiles
3580 global oldprefs prefstop
3581
3582 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3583 set $v $oldprefs($v)
3584 }
3585 catch {destroy $prefstop}
3586 unset prefstop
3587}
3588
3589proc prefsok {} {
3590 global maxwidth maxgraphpct
3591 global oldprefs prefstop
3592
3593 catch {destroy $prefstop}
3594 unset prefstop
3595 if {$maxwidth != $oldprefs(maxwidth)
3596 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3597 redisplay
3598 }
3599}
3600
3601proc formatdate {d} {
3602 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3603}
3604
3605# This list of encoding names and aliases is distilled from
3606# http://www.iana.org/assignments/character-sets.
3607# Not all of them are supported by Tcl.
3608set encoding_aliases {
3609 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3610 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3611 { ISO-10646-UTF-1 csISO10646UTF1 }
3612 { ISO_646.basic:1983 ref csISO646basic1983 }
3613 { INVARIANT csINVARIANT }
3614 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3615 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3616 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3617 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3618 { NATS-DANO iso-ir-9-1 csNATSDANO }
3619 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3620 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3621 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3622 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3623 { ISO-2022-KR csISO2022KR }
3624 { EUC-KR csEUCKR }
3625 { ISO-2022-JP csISO2022JP }
3626 { ISO-2022-JP-2 csISO2022JP2 }
3627 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3628 csISO13JISC6220jp }
3629 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3630 { IT iso-ir-15 ISO646-IT csISO15Italian }
3631 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3632 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3633 { greek7-old iso-ir-18 csISO18Greek7Old }
3634 { latin-greek iso-ir-19 csISO19LatinGreek }
3635 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3636 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3637 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3638 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3639 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3640 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3641 { INIS iso-ir-49 csISO49INIS }
3642 { INIS-8 iso-ir-50 csISO50INIS8 }
3643 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3644 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3645 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3646 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3647 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3648 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3649 csISO60Norwegian1 }
3650 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3651 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3652 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3653 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3654 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3655 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3656 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3657 { greek7 iso-ir-88 csISO88Greek7 }
3658 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3659 { iso-ir-90 csISO90 }
3660 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3661 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3662 csISO92JISC62991984b }
3663 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3664 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3665 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3666 csISO95JIS62291984handadd }
3667 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3668 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3669 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3670 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3671 CP819 csISOLatin1 }
3672 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3673 { T.61-7bit iso-ir-102 csISO102T617bit }
3674 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3675 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3676 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3677 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3678 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3679 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3680 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3681 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3682 arabic csISOLatinArabic }
3683 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3684 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3685 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3686 greek greek8 csISOLatinGreek }
3687 { T.101-G2 iso-ir-128 csISO128T101G2 }
3688 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3689 csISOLatinHebrew }
3690 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3691 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3692 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3693 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3694 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3695 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3696 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3697 csISOLatinCyrillic }
3698 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3699 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3700 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3701 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3702 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3703 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3704 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3705 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3706 { ISO_10367-box iso-ir-155 csISO10367Box }
3707 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3708 { latin-lap lap iso-ir-158 csISO158Lap }
3709 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3710 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3711 { us-dk csUSDK }
3712 { dk-us csDKUS }
3713 { JIS_X0201 X0201 csHalfWidthKatakana }
3714 { KSC5636 ISO646-KR csKSC5636 }
3715 { ISO-10646-UCS-2 csUnicode }
3716 { ISO-10646-UCS-4 csUCS4 }
3717 { DEC-MCS dec csDECMCS }
3718 { hp-roman8 roman8 r8 csHPRoman8 }
3719 { macintosh mac csMacintosh }
3720 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3721 csIBM037 }
3722 { IBM038 EBCDIC-INT cp038 csIBM038 }
3723 { IBM273 CP273 csIBM273 }
3724 { IBM274 EBCDIC-BE CP274 csIBM274 }
3725 { IBM275 EBCDIC-BR cp275 csIBM275 }
3726 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3727 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3728 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3729 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3730 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3731 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3732 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3733 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3734 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3735 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3736 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3737 { IBM437 cp437 437 csPC8CodePage437 }
3738 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3739 { IBM775 cp775 csPC775Baltic }
3740 { IBM850 cp850 850 csPC850Multilingual }
3741 { IBM851 cp851 851 csIBM851 }
3742 { IBM852 cp852 852 csPCp852 }
3743 { IBM855 cp855 855 csIBM855 }
3744 { IBM857 cp857 857 csIBM857 }
3745 { IBM860 cp860 860 csIBM860 }
3746 { IBM861 cp861 861 cp-is csIBM861 }
3747 { IBM862 cp862 862 csPC862LatinHebrew }
3748 { IBM863 cp863 863 csIBM863 }
3749 { IBM864 cp864 csIBM864 }
3750 { IBM865 cp865 865 csIBM865 }
3751 { IBM866 cp866 866 csIBM866 }
3752 { IBM868 CP868 cp-ar csIBM868 }
3753 { IBM869 cp869 869 cp-gr csIBM869 }
3754 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3755 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3756 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3757 { IBM891 cp891 csIBM891 }
3758 { IBM903 cp903 csIBM903 }
3759 { IBM904 cp904 904 csIBBM904 }
3760 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3761 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3762 { IBM1026 CP1026 csIBM1026 }
3763 { EBCDIC-AT-DE csIBMEBCDICATDE }
3764 { EBCDIC-AT-DE-A csEBCDICATDEA }
3765 { EBCDIC-CA-FR csEBCDICCAFR }
3766 { EBCDIC-DK-NO csEBCDICDKNO }
3767 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3768 { EBCDIC-FI-SE csEBCDICFISE }
3769 { EBCDIC-FI-SE-A csEBCDICFISEA }
3770 { EBCDIC-FR csEBCDICFR }
3771 { EBCDIC-IT csEBCDICIT }
3772 { EBCDIC-PT csEBCDICPT }
3773 { EBCDIC-ES csEBCDICES }
3774 { EBCDIC-ES-A csEBCDICESA }
3775 { EBCDIC-ES-S csEBCDICESS }
3776 { EBCDIC-UK csEBCDICUK }
3777 { EBCDIC-US csEBCDICUS }
3778 { UNKNOWN-8BIT csUnknown8BiT }
3779 { MNEMONIC csMnemonic }
3780 { MNEM csMnem }
3781 { VISCII csVISCII }
3782 { VIQR csVIQR }
3783 { KOI8-R csKOI8R }
3784 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3785 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3786 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3787 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3788 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3789 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3790 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3791 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3792 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3793 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3794 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3795 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3796 { IBM1047 IBM-1047 }
3797 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3798 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3799 { UNICODE-1-1 csUnicode11 }
3800 { CESU-8 csCESU-8 }
3801 { BOCU-1 csBOCU-1 }
3802 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3803 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3804 l8 }
3805 { ISO-8859-15 ISO_8859-15 Latin-9 }
3806 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3807 { GBK CP936 MS936 windows-936 }
3808 { JIS_Encoding csJISEncoding }
3809 { Shift_JIS MS_Kanji csShiftJIS }
3810 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3811 EUC-JP }
3812 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3813 { ISO-10646-UCS-Basic csUnicodeASCII }
3814 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3815 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3816 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3817 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3818 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3819 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3820 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3821 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3822 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3823 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3824 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3825 { Ventura-US csVenturaUS }
3826 { Ventura-International csVenturaInternational }
3827 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3828 { PC8-Turkish csPC8Turkish }
3829 { IBM-Symbols csIBMSymbols }
3830 { IBM-Thai csIBMThai }
3831 { HP-Legal csHPLegal }
3832 { HP-Pi-font csHPPiFont }
3833 { HP-Math8 csHPMath8 }
3834 { Adobe-Symbol-Encoding csHPPSMath }
3835 { HP-DeskTop csHPDesktop }
3836 { Ventura-Math csVenturaMath }
3837 { Microsoft-Publishing csMicrosoftPublishing }
3838 { Windows-31J csWindows31J }
3839 { GB2312 csGB2312 }
3840 { Big5 csBig5 }
3841}
3842
3843proc tcl_encoding {enc} {
3844 global encoding_aliases
3845 set names [encoding names]
3846 set lcnames [string tolower $names]
3847 set enc [string tolower $enc]
3848 set i [lsearch -exact $lcnames $enc]
3849 if {$i < 0} {
3850 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3851 if {[regsub {^iso[-_]} $enc iso encx]} {
3852 set i [lsearch -exact $lcnames $encx]
3853 }
3854 }
3855 if {$i < 0} {
3856 foreach l $encoding_aliases {
3857 set ll [string tolower $l]
3858 if {[lsearch -exact $ll $enc] < 0} continue
3859 # look through the aliases for one that tcl knows about
3860 foreach e $ll {
3861 set i [lsearch -exact $lcnames $e]
3862 if {$i < 0} {
3863 if {[regsub {^iso[-_]} $e iso ex]} {
3864 set i [lsearch -exact $lcnames $ex]
3865 }
3866 }
3867 if {$i >= 0} break
3868 }
3869 break
3870 }
3871 }
3872 if {$i >= 0} {
3873 return [lindex $names $i]
3874 }
3875 return {}
3876}
3877
3878# defaults...
3879set datemode 0
3880set diffopts "-U 5 -p"
3881set wrcomcmd "git-diff-tree --stdin -p --pretty"
3882
3883set gitencoding {}
3884catch {
3885 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3886}
3887if {$gitencoding == ""} {
3888 set gitencoding "utf-8"
3889}
3890set tclencoding [tcl_encoding $gitencoding]
3891if {$tclencoding == {}} {
3892 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3893}
3894
3895set mainfont {Helvetica 9}
3896set textfont {Courier 9}
3897set uifont {Helvetica 9 bold}
3898set findmergefiles 0
3899set maxgraphpct 50
3900set maxwidth 16
3901set revlistorder 0
3902set fastdate 0
3903set uparrowlen 7
3904set downarrowlen 7
3905set mingaplen 30
3906
3907set colors {green red blue magenta darkgrey brown orange}
3908
3909catch {source ~/.gitk}
3910
3911set namefont $mainfont
3912
3913font create optionfont -family sans-serif -size -12
3914
3915set revtreeargs {}
3916foreach arg $argv {
3917 switch -regexp -- $arg {
3918 "^$" { }
3919 "^-d" { set datemode 1 }
3920 default {
3921 lappend revtreeargs $arg
3922 }
3923 }
3924}
3925
3926# check that we can find a .git directory somewhere...
3927set gitdir [gitdir]
3928if {![file isdirectory $gitdir]} {
3929 error_popup "Cannot find the git directory \"$gitdir\"."
3930 exit 1
3931}
3932
3933set history {}
3934set historyindex 0
3935
3936set optim_delay 16
3937
3938set stopped 0
3939set stuffsaved 0
3940set patchnum 0
3941setcoords
3942makewindow $revtreeargs
3943readrefs
3944getcommits $revtreeargs