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