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