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