a70787a879926ca25b9ca0c3b6f54ae962139dab
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
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 linewidth {id} {
1187 global thickerline lthickness
1188
1189 set wid $lthickness
1190 if {[info exists thickerline] && $id eq $thickerline} {
1191 set wid [expr {2 * $lthickness}]
1192 }
1193 return $wid
1194}
1195
1196proc drawlineseg {id i} {
1197 global rowoffsets rowidlist idrowranges
1198 global canv colormap
1199
1200 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1201 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1202 if {$startrow == $row} return
1203 assigncolor $id
1204 set coords {}
1205 set col [lsearch -exact [lindex $rowidlist $row] $id]
1206 if {$col < 0} {
1207 puts "oops: drawline: id $id not on row $row"
1208 return
1209 }
1210 set lasto {}
1211 set ns 0
1212 while {1} {
1213 set o [lindex $rowoffsets $row $col]
1214 if {$o eq {}} break
1215 if {$o ne $lasto} {
1216 # changing direction
1217 set x [xc $row $col]
1218 set y [yc $row]
1219 lappend coords $x $y
1220 set lasto $o
1221 }
1222 incr col $o
1223 incr row -1
1224 }
1225 if {$coords eq {}} return
1226 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1227 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1228 set arrow [lindex {none first last both} $arrow]
1229 set x [xc $row $col]
1230 set y [yc $row]
1231 lappend coords $x $y
1232 set t [$canv create line $coords -width [linewidth $id] \
1233 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1234 $canv lower $t
1235 bindline $t $id
1236}
1237
1238proc drawparentlinks {id row col olds} {
1239 global rowidlist canv colormap
1240
1241 set row2 [expr {$row + 1}]
1242 set x [xc $row $col]
1243 set y [yc $row]
1244 set y2 [yc $row2]
1245 set ids [lindex $rowidlist $row2]
1246 # rmx = right-most X coord used
1247 set rmx 0
1248 foreach p $olds {
1249 set i [lsearch -exact $ids $p]
1250 if {$i < 0} {
1251 puts "oops, parent $p of $id not in list"
1252 continue
1253 }
1254 assigncolor $p
1255 # should handle duplicated parents here...
1256 set coords [list $x $y]
1257 if {$i < $col - 1} {
1258 lappend coords [xc $row [expr {$i + 1}]] $y
1259 } elseif {$i > $col + 1} {
1260 lappend coords [xc $row [expr {$i - 1}]] $y
1261 }
1262 set x2 [xc $row2 $i]
1263 if {$x2 > $rmx} {
1264 set rmx $x2
1265 }
1266 lappend coords $x2 $y2
1267 set t [$canv create line $coords -width [linewidth $p] \
1268 -fill $colormap($p) -tags lines.$p]
1269 $canv lower $t
1270 bindline $t $p
1271 }
1272 return $rmx
1273}
1274
1275proc drawlines {id} {
1276 global colormap canv
1277 global idrowranges idrangedrawn
1278 global children iddrawn commitrow rowidlist
1279
1280 $canv delete lines.$id
1281 set nr [expr {[llength $idrowranges($id)] / 2}]
1282 for {set i 0} {$i < $nr} {incr i} {
1283 if {[info exists idrangedrawn($id,$i)]} {
1284 drawlineseg $id $i
1285 }
1286 }
1287 if {[info exists children($id)]} {
1288 foreach child $children($id) {
1289 if {[info exists iddrawn($child)]} {
1290 set row $commitrow($child)
1291 set col [lsearch -exact [lindex $rowidlist $row] $child]
1292 if {$col >= 0} {
1293 drawparentlinks $child $row $col [list $id]
1294 }
1295 }
1296 }
1297 }
1298}
1299
1300proc drawcmittext {id row col rmx} {
1301 global linespc canv canv2 canv3 canvy0
1302 global commitlisted commitinfo rowidlist
1303 global rowtextx idpos idtags idheads idotherrefs
1304 global linehtag linentag linedtag
1305 global mainfont namefont
1306
1307 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1308 set x [xc $row $col]
1309 set y [yc $row]
1310 set orad [expr {$linespc / 3}]
1311 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1312 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1313 -fill $ofill -outline black -width 1]
1314 $canv raise $t
1315 $canv bind $t <1> {selcanvline {} %x %y}
1316 set xt [xc $row [llength [lindex $rowidlist $row]]]
1317 if {$xt < $rmx} {
1318 set xt $rmx
1319 }
1320 set rowtextx($row) $xt
1321 set idpos($id) [list $x $xt $y]
1322 if {[info exists idtags($id)] || [info exists idheads($id)]
1323 || [info exists idotherrefs($id)]} {
1324 set xt [drawtags $id $x $xt $y]
1325 }
1326 set headline [lindex $commitinfo($id) 0]
1327 set name [lindex $commitinfo($id) 1]
1328 set date [lindex $commitinfo($id) 2]
1329 set date [formatdate $date]
1330 set linehtag($row) [$canv create text $xt $y -anchor w \
1331 -text $headline -font $mainfont ]
1332 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1333 set linentag($row) [$canv2 create text 3 $y -anchor w \
1334 -text $name -font $namefont]
1335 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1336 -text $date -font $mainfont]
1337}
1338
1339proc drawcmitrow {row} {
1340 global displayorder rowidlist
1341 global idrowranges idrangedrawn iddrawn
1342 global commitinfo commitlisted parents numcommits
1343 global commitdata
1344
1345 if {$row >= $numcommits} return
1346 foreach id [lindex $rowidlist $row] {
1347 if {![info exists idrowranges($id)]} continue
1348 set i -1
1349 foreach {s e} $idrowranges($id) {
1350 incr i
1351 if {$row < $s} continue
1352 if {$e eq {}} break
1353 if {$row <= $e} {
1354 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1355 drawlineseg $id $i
1356 set idrangedrawn($id,$i) 1
1357 }
1358 break
1359 }
1360 }
1361 }
1362
1363 set id [lindex $displayorder $row]
1364 if {[info exists iddrawn($id)]} return
1365 set col [lsearch -exact [lindex $rowidlist $row] $id]
1366 if {$col < 0} {
1367 puts "oops, row $row id $id not in list"
1368 return
1369 }
1370 if {![info exists commitinfo($id)]} {
1371 getcommit $id $row
1372 }
1373 assigncolor $id
1374 if {[info exists commitlisted($id)] && [info exists parents($id)]
1375 && $parents($id) ne {}} {
1376 set rmx [drawparentlinks $id $row $col $parents($id)]
1377 } else {
1378 set rmx 0
1379 }
1380 drawcmittext $id $row $col $rmx
1381 set iddrawn($id) 1
1382}
1383
1384proc drawfrac {f0 f1} {
1385 global numcommits canv
1386 global linespc
1387
1388 set ymax [lindex [$canv cget -scrollregion] 3]
1389 if {$ymax eq {} || $ymax == 0} return
1390 set y0 [expr {int($f0 * $ymax)}]
1391 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1392 if {$row < 0} {
1393 set row 0
1394 }
1395 set y1 [expr {int($f1 * $ymax)}]
1396 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1397 if {$endrow >= $numcommits} {
1398 set endrow [expr {$numcommits - 1}]
1399 }
1400 for {} {$row <= $endrow} {incr row} {
1401 drawcmitrow $row
1402 }
1403}
1404
1405proc drawvisible {} {
1406 global canv
1407 eval drawfrac [$canv yview]
1408}
1409
1410proc clear_display {} {
1411 global iddrawn idrangedrawn
1412
1413 allcanvs delete all
1414 catch {unset iddrawn}
1415 catch {unset idrangedrawn}
1416}
1417
1418proc assigncolor {id} {
1419 global colormap colors nextcolor
1420 global parents nparents children nchildren
1421 global cornercrossings crossings
1422
1423 if {[info exists colormap($id)]} return
1424 set ncolors [llength $colors]
1425 if {$nchildren($id) == 1} {
1426 set child [lindex $children($id) 0]
1427 if {[info exists colormap($child)]
1428 && $nparents($child) == 1} {
1429 set colormap($id) $colormap($child)
1430 return
1431 }
1432 }
1433 set badcolors {}
1434 if {[info exists cornercrossings($id)]} {
1435 foreach x $cornercrossings($id) {
1436 if {[info exists colormap($x)]
1437 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1438 lappend badcolors $colormap($x)
1439 }
1440 }
1441 if {[llength $badcolors] >= $ncolors} {
1442 set badcolors {}
1443 }
1444 }
1445 set origbad $badcolors
1446 if {[llength $badcolors] < $ncolors - 1} {
1447 if {[info exists crossings($id)]} {
1448 foreach x $crossings($id) {
1449 if {[info exists colormap($x)]
1450 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1451 lappend badcolors $colormap($x)
1452 }
1453 }
1454 if {[llength $badcolors] >= $ncolors} {
1455 set badcolors $origbad
1456 }
1457 }
1458 set origbad $badcolors
1459 }
1460 if {[llength $badcolors] < $ncolors - 1} {
1461 foreach child $children($id) {
1462 if {[info exists colormap($child)]
1463 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1464 lappend badcolors $colormap($child)
1465 }
1466 if {[info exists parents($child)]} {
1467 foreach p $parents($child) {
1468 if {[info exists colormap($p)]
1469 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1470 lappend badcolors $colormap($p)
1471 }
1472 }
1473 }
1474 }
1475 if {[llength $badcolors] >= $ncolors} {
1476 set badcolors $origbad
1477 }
1478 }
1479 for {set i 0} {$i <= $ncolors} {incr i} {
1480 set c [lindex $colors $nextcolor]
1481 if {[incr nextcolor] >= $ncolors} {
1482 set nextcolor 0
1483 }
1484 if {[lsearch -exact $badcolors $c]} break
1485 }
1486 set colormap($id) $c
1487}
1488
1489proc bindline {t id} {
1490 global canv
1491
1492 $canv bind $t <Enter> "lineenter %x %y $id"
1493 $canv bind $t <Motion> "linemotion %x %y $id"
1494 $canv bind $t <Leave> "lineleave $id"
1495 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1496}
1497
1498proc drawtags {id x xt y1} {
1499 global idtags idheads idotherrefs
1500 global linespc lthickness
1501 global canv mainfont commitrow rowtextx
1502
1503 set marks {}
1504 set ntags 0
1505 set nheads 0
1506 if {[info exists idtags($id)]} {
1507 set marks $idtags($id)
1508 set ntags [llength $marks]
1509 }
1510 if {[info exists idheads($id)]} {
1511 set marks [concat $marks $idheads($id)]
1512 set nheads [llength $idheads($id)]
1513 }
1514 if {[info exists idotherrefs($id)]} {
1515 set marks [concat $marks $idotherrefs($id)]
1516 }
1517 if {$marks eq {}} {
1518 return $xt
1519 }
1520
1521 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1522 set yt [expr {$y1 - 0.5 * $linespc}]
1523 set yb [expr {$yt + $linespc - 1}]
1524 set xvals {}
1525 set wvals {}
1526 foreach tag $marks {
1527 set wid [font measure $mainfont $tag]
1528 lappend xvals $xt
1529 lappend wvals $wid
1530 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1531 }
1532 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1533 -width $lthickness -fill black -tags tag.$id]
1534 $canv lower $t
1535 foreach tag $marks x $xvals wid $wvals {
1536 set xl [expr {$x + $delta}]
1537 set xr [expr {$x + $delta + $wid + $lthickness}]
1538 if {[incr ntags -1] >= 0} {
1539 # draw a tag
1540 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1541 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1542 -width 1 -outline black -fill yellow -tags tag.$id]
1543 $canv bind $t <1> [list showtag $tag 1]
1544 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1545 } else {
1546 # draw a head or other ref
1547 if {[incr nheads -1] >= 0} {
1548 set col green
1549 } else {
1550 set col "#ddddff"
1551 }
1552 set xl [expr {$xl - $delta/2}]
1553 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1554 -width 1 -outline black -fill $col -tags tag.$id
1555 }
1556 set t [$canv create text $xl $y1 -anchor w -text $tag \
1557 -font $mainfont -tags tag.$id]
1558 if {$ntags >= 0} {
1559 $canv bind $t <1> [list showtag $tag 1]
1560 }
1561 }
1562 return $xt
1563}
1564
1565proc checkcrossings {row endrow} {
1566 global displayorder parents rowidlist
1567
1568 for {} {$row < $endrow} {incr row} {
1569 set id [lindex $displayorder $row]
1570 set i [lsearch -exact [lindex $rowidlist $row] $id]
1571 if {$i < 0} continue
1572 set idlist [lindex $rowidlist [expr {$row+1}]]
1573 foreach p $parents($id) {
1574 set j [lsearch -exact $idlist $p]
1575 if {$j > 0} {
1576 if {$j < $i - 1} {
1577 notecrossings $row $p $j $i [expr {$j+1}]
1578 } elseif {$j > $i + 1} {
1579 notecrossings $row $p $i $j [expr {$j-1}]
1580 }
1581 }
1582 }
1583 }
1584}
1585
1586proc notecrossings {row id lo hi corner} {
1587 global rowidlist crossings cornercrossings
1588
1589 for {set i $lo} {[incr i] < $hi} {} {
1590 set p [lindex [lindex $rowidlist $row] $i]
1591 if {$p == {}} continue
1592 if {$i == $corner} {
1593 if {![info exists cornercrossings($id)]
1594 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1595 lappend cornercrossings($id) $p
1596 }
1597 if {![info exists cornercrossings($p)]
1598 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1599 lappend cornercrossings($p) $id
1600 }
1601 } else {
1602 if {![info exists crossings($id)]
1603 || [lsearch -exact $crossings($id) $p] < 0} {
1604 lappend crossings($id) $p
1605 }
1606 if {![info exists crossings($p)]
1607 || [lsearch -exact $crossings($p) $id] < 0} {
1608 lappend crossings($p) $id
1609 }
1610 }
1611 }
1612}
1613
1614proc xcoord {i level ln} {
1615 global canvx0 xspc1 xspc2
1616
1617 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1618 if {$i > 0 && $i == $level} {
1619 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1620 } elseif {$i > $level} {
1621 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1622 }
1623 return $x
1624}
1625
1626proc finishcommits {} {
1627 global commitidx phase
1628 global canv mainfont ctext maincursor textcursor
1629
1630 if {$commitidx > 0} {
1631 drawrest
1632 } else {
1633 $canv delete all
1634 $canv create text 3 3 -anchor nw -text "No commits selected" \
1635 -font $mainfont -tags textitems
1636 }
1637 . config -cursor $maincursor
1638 settextcursor $textcursor
1639 set phase {}
1640}
1641
1642# Don't change the text pane cursor if it is currently the hand cursor,
1643# showing that we are over a sha1 ID link.
1644proc settextcursor {c} {
1645 global ctext curtextcursor
1646
1647 if {[$ctext cget -cursor] == $curtextcursor} {
1648 $ctext config -cursor $c
1649 }
1650 set curtextcursor $c
1651}
1652
1653proc drawrest {} {
1654 global numcommits
1655 global startmsecs
1656 global canvy0 numcommits linespc
1657 global rowlaidout commitidx
1658
1659 set row $rowlaidout
1660 layoutrows $rowlaidout $commitidx 1
1661 layouttail
1662 optimize_rows $row 0 $commitidx
1663 showstuff $commitidx
1664
1665 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1666 #puts "overall $drawmsecs ms for $numcommits commits"
1667}
1668
1669proc findmatches {f} {
1670 global findtype foundstring foundstrlen
1671 if {$findtype == "Regexp"} {
1672 set matches [regexp -indices -all -inline $foundstring $f]
1673 } else {
1674 if {$findtype == "IgnCase"} {
1675 set str [string tolower $f]
1676 } else {
1677 set str $f
1678 }
1679 set matches {}
1680 set i 0
1681 while {[set j [string first $foundstring $str $i]] >= 0} {
1682 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1683 set i [expr {$j + $foundstrlen}]
1684 }
1685 }
1686 return $matches
1687}
1688
1689proc dofind {} {
1690 global findtype findloc findstring markedmatches commitinfo
1691 global numcommits displayorder linehtag linentag linedtag
1692 global mainfont namefont canv canv2 canv3 selectedline
1693 global matchinglines foundstring foundstrlen matchstring
1694 global commitdata
1695
1696 stopfindproc
1697 unmarkmatches
1698 focus .
1699 set matchinglines {}
1700 if {$findloc == "Pickaxe"} {
1701 findpatches
1702 return
1703 }
1704 if {$findtype == "IgnCase"} {
1705 set foundstring [string tolower $findstring]
1706 } else {
1707 set foundstring $findstring
1708 }
1709 set foundstrlen [string length $findstring]
1710 if {$foundstrlen == 0} return
1711 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1712 set matchstring "*$matchstring*"
1713 if {$findloc == "Files"} {
1714 findfiles
1715 return
1716 }
1717 if {![info exists selectedline]} {
1718 set oldsel -1
1719 } else {
1720 set oldsel $selectedline
1721 }
1722 set didsel 0
1723 set fldtypes {Headline Author Date Committer CDate Comment}
1724 set l -1
1725 foreach d $commitdata {
1726 incr l
1727 if {$findtype == "Regexp"} {
1728 set doesmatch [regexp $foundstring $d]
1729 } elseif {$findtype == "IgnCase"} {
1730 set doesmatch [string match -nocase $matchstring $d]
1731 } else {
1732 set doesmatch [string match $matchstring $d]
1733 }
1734 if {!$doesmatch} continue
1735 set id [lindex $displayorder $l]
1736 if {![info exists commitinfo($id)]} {
1737 getcommit $id $l
1738 }
1739 set info $commitinfo($id)
1740 set doesmatch 0
1741 foreach f $info ty $fldtypes {
1742 if {$findloc != "All fields" && $findloc != $ty} {
1743 continue
1744 }
1745 set matches [findmatches $f]
1746 if {$matches == {}} continue
1747 set doesmatch 1
1748 if {$ty == "Headline"} {
1749 drawcmitrow $l
1750 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1751 } elseif {$ty == "Author"} {
1752 drawcmitrow $l
1753 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1754 } elseif {$ty == "Date"} {
1755 drawcmitrow $l
1756 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1757 }
1758 }
1759 if {$doesmatch} {
1760 lappend matchinglines $l
1761 if {!$didsel && $l > $oldsel} {
1762 findselectline $l
1763 set didsel 1
1764 }
1765 }
1766 }
1767 if {$matchinglines == {}} {
1768 bell
1769 } elseif {!$didsel} {
1770 findselectline [lindex $matchinglines 0]
1771 }
1772}
1773
1774proc findselectline {l} {
1775 global findloc commentend ctext
1776 selectline $l 1
1777 if {$findloc == "All fields" || $findloc == "Comments"} {
1778 # highlight the matches in the comments
1779 set f [$ctext get 1.0 $commentend]
1780 set matches [findmatches $f]
1781 foreach match $matches {
1782 set start [lindex $match 0]
1783 set end [expr {[lindex $match 1] + 1}]
1784 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1785 }
1786 }
1787}
1788
1789proc findnext {restart} {
1790 global matchinglines selectedline
1791 if {![info exists matchinglines]} {
1792 if {$restart} {
1793 dofind
1794 }
1795 return
1796 }
1797 if {![info exists selectedline]} return
1798 foreach l $matchinglines {
1799 if {$l > $selectedline} {
1800 findselectline $l
1801 return
1802 }
1803 }
1804 bell
1805}
1806
1807proc findprev {} {
1808 global matchinglines selectedline
1809 if {![info exists matchinglines]} {
1810 dofind
1811 return
1812 }
1813 if {![info exists selectedline]} return
1814 set prev {}
1815 foreach l $matchinglines {
1816 if {$l >= $selectedline} break
1817 set prev $l
1818 }
1819 if {$prev != {}} {
1820 findselectline $prev
1821 } else {
1822 bell
1823 }
1824}
1825
1826proc findlocchange {name ix op} {
1827 global findloc findtype findtypemenu
1828 if {$findloc == "Pickaxe"} {
1829 set findtype Exact
1830 set state disabled
1831 } else {
1832 set state normal
1833 }
1834 $findtypemenu entryconf 1 -state $state
1835 $findtypemenu entryconf 2 -state $state
1836}
1837
1838proc stopfindproc {{done 0}} {
1839 global findprocpid findprocfile findids
1840 global ctext findoldcursor phase maincursor textcursor
1841 global findinprogress
1842
1843 catch {unset findids}
1844 if {[info exists findprocpid]} {
1845 if {!$done} {
1846 catch {exec kill $findprocpid}
1847 }
1848 catch {close $findprocfile}
1849 unset findprocpid
1850 }
1851 if {[info exists findinprogress]} {
1852 unset findinprogress
1853 if {$phase != "incrdraw"} {
1854 . config -cursor $maincursor
1855 settextcursor $textcursor
1856 }
1857 }
1858}
1859
1860proc findpatches {} {
1861 global findstring selectedline numcommits
1862 global findprocpid findprocfile
1863 global finddidsel ctext displayorder findinprogress
1864 global findinsertpos
1865
1866 if {$numcommits == 0} return
1867
1868 # make a list of all the ids to search, starting at the one
1869 # after the selected line (if any)
1870 if {[info exists selectedline]} {
1871 set l $selectedline
1872 } else {
1873 set l -1
1874 }
1875 set inputids {}
1876 for {set i 0} {$i < $numcommits} {incr i} {
1877 if {[incr l] >= $numcommits} {
1878 set l 0
1879 }
1880 append inputids [lindex $displayorder $l] "\n"
1881 }
1882
1883 if {[catch {
1884 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1885 << $inputids] r]
1886 } err]} {
1887 error_popup "Error starting search process: $err"
1888 return
1889 }
1890
1891 set findinsertpos end
1892 set findprocfile $f
1893 set findprocpid [pid $f]
1894 fconfigure $f -blocking 0
1895 fileevent $f readable readfindproc
1896 set finddidsel 0
1897 . config -cursor watch
1898 settextcursor watch
1899 set findinprogress 1
1900}
1901
1902proc readfindproc {} {
1903 global findprocfile finddidsel
1904 global commitrow matchinglines findinsertpos
1905
1906 set n [gets $findprocfile line]
1907 if {$n < 0} {
1908 if {[eof $findprocfile]} {
1909 stopfindproc 1
1910 if {!$finddidsel} {
1911 bell
1912 }
1913 }
1914 return
1915 }
1916 if {![regexp {^[0-9a-f]{40}} $line id]} {
1917 error_popup "Can't parse git-diff-tree output: $line"
1918 stopfindproc
1919 return
1920 }
1921 if {![info exists commitrow($id)]} {
1922 puts stderr "spurious id: $id"
1923 return
1924 }
1925 set l $commitrow($id)
1926 insertmatch $l $id
1927}
1928
1929proc insertmatch {l id} {
1930 global matchinglines findinsertpos finddidsel
1931
1932 if {$findinsertpos == "end"} {
1933 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1934 set matchinglines [linsert $matchinglines 0 $l]
1935 set findinsertpos 1
1936 } else {
1937 lappend matchinglines $l
1938 }
1939 } else {
1940 set matchinglines [linsert $matchinglines $findinsertpos $l]
1941 incr findinsertpos
1942 }
1943 markheadline $l $id
1944 if {!$finddidsel} {
1945 findselectline $l
1946 set finddidsel 1
1947 }
1948}
1949
1950proc findfiles {} {
1951 global selectedline numcommits displayorder ctext
1952 global ffileline finddidsel parents nparents
1953 global findinprogress findstartline findinsertpos
1954 global treediffs fdiffid fdiffsneeded fdiffpos
1955 global findmergefiles
1956
1957 if {$numcommits == 0} return
1958
1959 if {[info exists selectedline]} {
1960 set l [expr {$selectedline + 1}]
1961 } else {
1962 set l 0
1963 }
1964 set ffileline $l
1965 set findstartline $l
1966 set diffsneeded {}
1967 set fdiffsneeded {}
1968 while 1 {
1969 set id [lindex $displayorder $l]
1970 if {$findmergefiles || $nparents($id) == 1} {
1971 if {![info exists treediffs($id)]} {
1972 append diffsneeded "$id\n"
1973 lappend fdiffsneeded $id
1974 }
1975 }
1976 if {[incr l] >= $numcommits} {
1977 set l 0
1978 }
1979 if {$l == $findstartline} break
1980 }
1981
1982 # start off a git-diff-tree process if needed
1983 if {$diffsneeded ne {}} {
1984 if {[catch {
1985 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1986 } err ]} {
1987 error_popup "Error starting search process: $err"
1988 return
1989 }
1990 catch {unset fdiffid}
1991 set fdiffpos 0
1992 fconfigure $df -blocking 0
1993 fileevent $df readable [list readfilediffs $df]
1994 }
1995
1996 set finddidsel 0
1997 set findinsertpos end
1998 set id [lindex $displayorder $l]
1999 . config -cursor watch
2000 settextcursor watch
2001 set findinprogress 1
2002 findcont $id
2003 update
2004}
2005
2006proc readfilediffs {df} {
2007 global findid fdiffid fdiffs
2008
2009 set n [gets $df line]
2010 if {$n < 0} {
2011 if {[eof $df]} {
2012 donefilediff
2013 if {[catch {close $df} err]} {
2014 stopfindproc
2015 bell
2016 error_popup "Error in git-diff-tree: $err"
2017 } elseif {[info exists findid]} {
2018 set id $findid
2019 stopfindproc
2020 bell
2021 error_popup "Couldn't find diffs for $id"
2022 }
2023 }
2024 return
2025 }
2026 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2027 # start of a new string of diffs
2028 donefilediff
2029 set fdiffid $id
2030 set fdiffs {}
2031 } elseif {[string match ":*" $line]} {
2032 lappend fdiffs [lindex $line 5]
2033 }
2034}
2035
2036proc donefilediff {} {
2037 global fdiffid fdiffs treediffs findid
2038 global fdiffsneeded fdiffpos
2039
2040 if {[info exists fdiffid]} {
2041 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2042 && $fdiffpos < [llength $fdiffsneeded]} {
2043 # git-diff-tree doesn't output anything for a commit
2044 # which doesn't change anything
2045 set nullid [lindex $fdiffsneeded $fdiffpos]
2046 set treediffs($nullid) {}
2047 if {[info exists findid] && $nullid eq $findid} {
2048 unset findid
2049 findcont $nullid
2050 }
2051 incr fdiffpos
2052 }
2053 incr fdiffpos
2054
2055 if {![info exists treediffs($fdiffid)]} {
2056 set treediffs($fdiffid) $fdiffs
2057 }
2058 if {[info exists findid] && $fdiffid eq $findid} {
2059 unset findid
2060 findcont $fdiffid
2061 }
2062 }
2063}
2064
2065proc findcont {id} {
2066 global findid treediffs parents nparents
2067 global ffileline findstartline finddidsel
2068 global displayorder numcommits matchinglines findinprogress
2069 global findmergefiles
2070
2071 set l $ffileline
2072 while 1 {
2073 if {$findmergefiles || $nparents($id) == 1} {
2074 if {![info exists treediffs($id)]} {
2075 set findid $id
2076 set ffileline $l
2077 return
2078 }
2079 set doesmatch 0
2080 foreach f $treediffs($id) {
2081 set x [findmatches $f]
2082 if {$x != {}} {
2083 set doesmatch 1
2084 break
2085 }
2086 }
2087 if {$doesmatch} {
2088 insertmatch $l $id
2089 }
2090 }
2091 if {[incr l] >= $numcommits} {
2092 set l 0
2093 }
2094 if {$l == $findstartline} break
2095 set id [lindex $displayorder $l]
2096 }
2097 stopfindproc
2098 if {!$finddidsel} {
2099 bell
2100 }
2101}
2102
2103# mark a commit as matching by putting a yellow background
2104# behind the headline
2105proc markheadline {l id} {
2106 global canv mainfont linehtag
2107
2108 drawcmitrow $l
2109 set bbox [$canv bbox $linehtag($l)]
2110 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2111 $canv lower $t
2112}
2113
2114# mark the bits of a headline, author or date that match a find string
2115proc markmatches {canv l str tag matches font} {
2116 set bbox [$canv bbox $tag]
2117 set x0 [lindex $bbox 0]
2118 set y0 [lindex $bbox 1]
2119 set y1 [lindex $bbox 3]
2120 foreach match $matches {
2121 set start [lindex $match 0]
2122 set end [lindex $match 1]
2123 if {$start > $end} continue
2124 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2125 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2126 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2127 [expr {$x0+$xlen+2}] $y1 \
2128 -outline {} -tags matches -fill yellow]
2129 $canv lower $t
2130 }
2131}
2132
2133proc unmarkmatches {} {
2134 global matchinglines findids
2135 allcanvs delete matches
2136 catch {unset matchinglines}
2137 catch {unset findids}
2138}
2139
2140proc selcanvline {w x y} {
2141 global canv canvy0 ctext linespc
2142 global rowtextx
2143 set ymax [lindex [$canv cget -scrollregion] 3]
2144 if {$ymax == {}} return
2145 set yfrac [lindex [$canv yview] 0]
2146 set y [expr {$y + $yfrac * $ymax}]
2147 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2148 if {$l < 0} {
2149 set l 0
2150 }
2151 if {$w eq $canv} {
2152 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2153 }
2154 unmarkmatches
2155 selectline $l 1
2156}
2157
2158proc commit_descriptor {p} {
2159 global commitinfo
2160 set l "..."
2161 if {[info exists commitinfo($p)]} {
2162 set l [lindex $commitinfo($p) 0]
2163 }
2164 return "$p ($l)"
2165}
2166
2167# append some text to the ctext widget, and make any SHA1 ID
2168# that we know about be a clickable link.
2169proc appendwithlinks {text} {
2170 global ctext commitrow linknum
2171
2172 set start [$ctext index "end - 1c"]
2173 $ctext insert end $text
2174 $ctext insert end "\n"
2175 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2176 foreach l $links {
2177 set s [lindex $l 0]
2178 set e [lindex $l 1]
2179 set linkid [string range $text $s $e]
2180 if {![info exists commitrow($linkid)]} continue
2181 incr e
2182 $ctext tag add link "$start + $s c" "$start + $e c"
2183 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2184 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2185 incr linknum
2186 }
2187 $ctext tag conf link -foreground blue -underline 1
2188 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2189 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2190}
2191
2192proc selectline {l isnew} {
2193 global canv canv2 canv3 ctext commitinfo selectedline
2194 global displayorder linehtag linentag linedtag
2195 global canvy0 linespc parents nparents children
2196 global cflist currentid sha1entry
2197 global commentend idtags linknum
2198 global mergemax numcommits
2199
2200 $canv delete hover
2201 normalline
2202 if {$l < 0 || $l >= $numcommits} return
2203 set y [expr {$canvy0 + $l * $linespc}]
2204 set ymax [lindex [$canv cget -scrollregion] 3]
2205 set ytop [expr {$y - $linespc - 1}]
2206 set ybot [expr {$y + $linespc + 1}]
2207 set wnow [$canv yview]
2208 set wtop [expr {[lindex $wnow 0] * $ymax}]
2209 set wbot [expr {[lindex $wnow 1] * $ymax}]
2210 set wh [expr {$wbot - $wtop}]
2211 set newtop $wtop
2212 if {$ytop < $wtop} {
2213 if {$ybot < $wtop} {
2214 set newtop [expr {$y - $wh / 2.0}]
2215 } else {
2216 set newtop $ytop
2217 if {$newtop > $wtop - $linespc} {
2218 set newtop [expr {$wtop - $linespc}]
2219 }
2220 }
2221 } elseif {$ybot > $wbot} {
2222 if {$ytop > $wbot} {
2223 set newtop [expr {$y - $wh / 2.0}]
2224 } else {
2225 set newtop [expr {$ybot - $wh}]
2226 if {$newtop < $wtop + $linespc} {
2227 set newtop [expr {$wtop + $linespc}]
2228 }
2229 }
2230 }
2231 if {$newtop != $wtop} {
2232 if {$newtop < 0} {
2233 set newtop 0
2234 }
2235 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2236 drawvisible
2237 }
2238
2239 if {![info exists linehtag($l)]} return
2240 $canv delete secsel
2241 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2242 -tags secsel -fill [$canv cget -selectbackground]]
2243 $canv lower $t
2244 $canv2 delete secsel
2245 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2246 -tags secsel -fill [$canv2 cget -selectbackground]]
2247 $canv2 lower $t
2248 $canv3 delete secsel
2249 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2250 -tags secsel -fill [$canv3 cget -selectbackground]]
2251 $canv3 lower $t
2252
2253 if {$isnew} {
2254 addtohistory [list selectline $l 0]
2255 }
2256
2257 set selectedline $l
2258
2259 set id [lindex $displayorder $l]
2260 set currentid $id
2261 $sha1entry delete 0 end
2262 $sha1entry insert 0 $id
2263 $sha1entry selection from 0
2264 $sha1entry selection to end
2265
2266 $ctext conf -state normal
2267 $ctext delete 0.0 end
2268 set linknum 0
2269 $ctext mark set fmark.0 0.0
2270 $ctext mark gravity fmark.0 left
2271 set info $commitinfo($id)
2272 set date [formatdate [lindex $info 2]]
2273 $ctext insert end "Author: [lindex $info 1] $date\n"
2274 set date [formatdate [lindex $info 4]]
2275 $ctext insert end "Committer: [lindex $info 3] $date\n"
2276 if {[info exists idtags($id)]} {
2277 $ctext insert end "Tags:"
2278 foreach tag $idtags($id) {
2279 $ctext insert end " $tag"
2280 }
2281 $ctext insert end "\n"
2282 }
2283
2284 set comment {}
2285 if {$nparents($id) > 1} {
2286 set np 0
2287 foreach p $parents($id) {
2288 if {$np >= $mergemax} {
2289 set tag mmax
2290 } else {
2291 set tag m$np
2292 }
2293 $ctext insert end "Parent: " $tag
2294 appendwithlinks [commit_descriptor $p]
2295 incr np
2296 }
2297 } else {
2298 if {[info exists parents($id)]} {
2299 foreach p $parents($id) {
2300 append comment "Parent: [commit_descriptor $p]\n"
2301 }
2302 }
2303 }
2304
2305 if {[info exists children($id)]} {
2306 foreach c $children($id) {
2307 append comment "Child: [commit_descriptor $c]\n"
2308 }
2309 }
2310 append comment "\n"
2311 append comment [lindex $info 5]
2312
2313 # make anything that looks like a SHA1 ID be a clickable link
2314 appendwithlinks $comment
2315
2316 $ctext tag delete Comments
2317 $ctext tag remove found 1.0 end
2318 $ctext conf -state disabled
2319 set commentend [$ctext index "end - 1c"]
2320
2321 $cflist delete 0 end
2322 $cflist insert end "Comments"
2323 if {$nparents($id) == 1} {
2324 startdiff $id
2325 } elseif {$nparents($id) > 1} {
2326 mergediff $id
2327 }
2328}
2329
2330proc selnextline {dir} {
2331 global selectedline
2332 if {![info exists selectedline]} return
2333 set l [expr {$selectedline + $dir}]
2334 unmarkmatches
2335 selectline $l 1
2336}
2337
2338proc unselectline {} {
2339 global selectedline
2340
2341 catch {unset selectedline}
2342 allcanvs delete secsel
2343}
2344
2345proc addtohistory {cmd} {
2346 global history historyindex
2347
2348 if {$historyindex > 0
2349 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2350 return
2351 }
2352
2353 if {$historyindex < [llength $history]} {
2354 set history [lreplace $history $historyindex end $cmd]
2355 } else {
2356 lappend history $cmd
2357 }
2358 incr historyindex
2359 if {$historyindex > 1} {
2360 .ctop.top.bar.leftbut conf -state normal
2361 } else {
2362 .ctop.top.bar.leftbut conf -state disabled
2363 }
2364 .ctop.top.bar.rightbut conf -state disabled
2365}
2366
2367proc goback {} {
2368 global history historyindex
2369
2370 if {$historyindex > 1} {
2371 incr historyindex -1
2372 set cmd [lindex $history [expr {$historyindex - 1}]]
2373 eval $cmd
2374 .ctop.top.bar.rightbut conf -state normal
2375 }
2376 if {$historyindex <= 1} {
2377 .ctop.top.bar.leftbut conf -state disabled
2378 }
2379}
2380
2381proc goforw {} {
2382 global history historyindex
2383
2384 if {$historyindex < [llength $history]} {
2385 set cmd [lindex $history $historyindex]
2386 incr historyindex
2387 eval $cmd
2388 .ctop.top.bar.leftbut conf -state normal
2389 }
2390 if {$historyindex >= [llength $history]} {
2391 .ctop.top.bar.rightbut conf -state disabled
2392 }
2393}
2394
2395proc mergediff {id} {
2396 global parents diffmergeid diffopts mdifffd
2397 global difffilestart
2398
2399 set diffmergeid $id
2400 catch {unset difffilestart}
2401 # this doesn't seem to actually affect anything...
2402 set env(GIT_DIFF_OPTS) $diffopts
2403 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2404 if {[catch {set mdf [open $cmd r]} err]} {
2405 error_popup "Error getting merge diffs: $err"
2406 return
2407 }
2408 fconfigure $mdf -blocking 0
2409 set mdifffd($id) $mdf
2410 fileevent $mdf readable [list getmergediffline $mdf $id]
2411 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2412}
2413
2414proc getmergediffline {mdf id} {
2415 global diffmergeid ctext cflist nextupdate nparents mergemax
2416 global difffilestart
2417
2418 set n [gets $mdf line]
2419 if {$n < 0} {
2420 if {[eof $mdf]} {
2421 close $mdf
2422 }
2423 return
2424 }
2425 if {![info exists diffmergeid] || $id != $diffmergeid} {
2426 return
2427 }
2428 $ctext conf -state normal
2429 if {[regexp {^diff --cc (.*)} $line match fname]} {
2430 # start of a new file
2431 $ctext insert end "\n"
2432 set here [$ctext index "end - 1c"]
2433 set i [$cflist index end]
2434 $ctext mark set fmark.$i $here
2435 $ctext mark gravity fmark.$i left
2436 set difffilestart([expr {$i-1}]) $here
2437 $cflist insert end $fname
2438 set l [expr {(78 - [string length $fname]) / 2}]
2439 set pad [string range "----------------------------------------" 1 $l]
2440 $ctext insert end "$pad $fname $pad\n" filesep
2441 } elseif {[regexp {^@@} $line]} {
2442 $ctext insert end "$line\n" hunksep
2443 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2444 # do nothing
2445 } else {
2446 # parse the prefix - one ' ', '-' or '+' for each parent
2447 set np $nparents($id)
2448 set spaces {}
2449 set minuses {}
2450 set pluses {}
2451 set isbad 0
2452 for {set j 0} {$j < $np} {incr j} {
2453 set c [string range $line $j $j]
2454 if {$c == " "} {
2455 lappend spaces $j
2456 } elseif {$c == "-"} {
2457 lappend minuses $j
2458 } elseif {$c == "+"} {
2459 lappend pluses $j
2460 } else {
2461 set isbad 1
2462 break
2463 }
2464 }
2465 set tags {}
2466 set num {}
2467 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2468 # line doesn't appear in result, parents in $minuses have the line
2469 set num [lindex $minuses 0]
2470 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2471 # line appears in result, parents in $pluses don't have the line
2472 lappend tags mresult
2473 set num [lindex $spaces 0]
2474 }
2475 if {$num ne {}} {
2476 if {$num >= $mergemax} {
2477 set num "max"
2478 }
2479 lappend tags m$num
2480 }
2481 $ctext insert end "$line\n" $tags
2482 }
2483 $ctext conf -state disabled
2484 if {[clock clicks -milliseconds] >= $nextupdate} {
2485 incr nextupdate 100
2486 fileevent $mdf readable {}
2487 update
2488 fileevent $mdf readable [list getmergediffline $mdf $id]
2489 }
2490}
2491
2492proc startdiff {ids} {
2493 global treediffs diffids treepending diffmergeid
2494
2495 set diffids $ids
2496 catch {unset diffmergeid}
2497 if {![info exists treediffs($ids)]} {
2498 if {![info exists treepending]} {
2499 gettreediffs $ids
2500 }
2501 } else {
2502 addtocflist $ids
2503 }
2504}
2505
2506proc addtocflist {ids} {
2507 global treediffs cflist
2508 foreach f $treediffs($ids) {
2509 $cflist insert end $f
2510 }
2511 getblobdiffs $ids
2512}
2513
2514proc gettreediffs {ids} {
2515 global treediff parents treepending
2516 set treepending $ids
2517 set treediff {}
2518 if {[catch \
2519 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2520 ]} return
2521 fconfigure $gdtf -blocking 0
2522 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2523}
2524
2525proc gettreediffline {gdtf ids} {
2526 global treediff treediffs treepending diffids diffmergeid
2527
2528 set n [gets $gdtf line]
2529 if {$n < 0} {
2530 if {![eof $gdtf]} return
2531 close $gdtf
2532 set treediffs($ids) $treediff
2533 unset treepending
2534 if {$ids != $diffids} {
2535 gettreediffs $diffids
2536 } else {
2537 if {[info exists diffmergeid]} {
2538 contmergediff $ids
2539 } else {
2540 addtocflist $ids
2541 }
2542 }
2543 return
2544 }
2545 set file [lindex $line 5]
2546 lappend treediff $file
2547}
2548
2549proc getblobdiffs {ids} {
2550 global diffopts blobdifffd diffids env curdifftag curtagstart
2551 global difffilestart nextupdate diffinhdr treediffs
2552
2553 set env(GIT_DIFF_OPTS) $diffopts
2554 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2555 if {[catch {set bdf [open $cmd r]} err]} {
2556 puts "error getting diffs: $err"
2557 return
2558 }
2559 set diffinhdr 0
2560 fconfigure $bdf -blocking 0
2561 set blobdifffd($ids) $bdf
2562 set curdifftag Comments
2563 set curtagstart 0.0
2564 catch {unset difffilestart}
2565 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2566 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2567}
2568
2569proc getblobdiffline {bdf ids} {
2570 global diffids blobdifffd ctext curdifftag curtagstart
2571 global diffnexthead diffnextnote difffilestart
2572 global nextupdate diffinhdr treediffs
2573
2574 set n [gets $bdf line]
2575 if {$n < 0} {
2576 if {[eof $bdf]} {
2577 close $bdf
2578 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2579 $ctext tag add $curdifftag $curtagstart end
2580 }
2581 }
2582 return
2583 }
2584 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2585 return
2586 }
2587 $ctext conf -state normal
2588 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2589 # start of a new file
2590 $ctext insert end "\n"
2591 $ctext tag add $curdifftag $curtagstart end
2592 set curtagstart [$ctext index "end - 1c"]
2593 set header $newname
2594 set here [$ctext index "end - 1c"]
2595 set i [lsearch -exact $treediffs($diffids) $fname]
2596 if {$i >= 0} {
2597 set difffilestart($i) $here
2598 incr i
2599 $ctext mark set fmark.$i $here
2600 $ctext mark gravity fmark.$i left
2601 }
2602 if {$newname != $fname} {
2603 set i [lsearch -exact $treediffs($diffids) $newname]
2604 if {$i >= 0} {
2605 set difffilestart($i) $here
2606 incr i
2607 $ctext mark set fmark.$i $here
2608 $ctext mark gravity fmark.$i left
2609 }
2610 }
2611 set curdifftag "f:$fname"
2612 $ctext tag delete $curdifftag
2613 set l [expr {(78 - [string length $header]) / 2}]
2614 set pad [string range "----------------------------------------" 1 $l]
2615 $ctext insert end "$pad $header $pad\n" filesep
2616 set diffinhdr 1
2617 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2618 set diffinhdr 0
2619 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2620 $line match f1l f1c f2l f2c rest]} {
2621 $ctext insert end "$line\n" hunksep
2622 set diffinhdr 0
2623 } else {
2624 set x [string range $line 0 0]
2625 if {$x == "-" || $x == "+"} {
2626 set tag [expr {$x == "+"}]
2627 $ctext insert end "$line\n" d$tag
2628 } elseif {$x == " "} {
2629 $ctext insert end "$line\n"
2630 } elseif {$diffinhdr || $x == "\\"} {
2631 # e.g. "\ No newline at end of file"
2632 $ctext insert end "$line\n" filesep
2633 } else {
2634 # Something else we don't recognize
2635 if {$curdifftag != "Comments"} {
2636 $ctext insert end "\n"
2637 $ctext tag add $curdifftag $curtagstart end
2638 set curtagstart [$ctext index "end - 1c"]
2639 set curdifftag Comments
2640 }
2641 $ctext insert end "$line\n" filesep
2642 }
2643 }
2644 $ctext conf -state disabled
2645 if {[clock clicks -milliseconds] >= $nextupdate} {
2646 incr nextupdate 100
2647 fileevent $bdf readable {}
2648 update
2649 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2650 }
2651}
2652
2653proc nextfile {} {
2654 global difffilestart ctext
2655 set here [$ctext index @0,0]
2656 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2657 if {[$ctext compare $difffilestart($i) > $here]} {
2658 if {![info exists pos]
2659 || [$ctext compare $difffilestart($i) < $pos]} {
2660 set pos $difffilestart($i)
2661 }
2662 }
2663 }
2664 if {[info exists pos]} {
2665 $ctext yview $pos
2666 }
2667}
2668
2669proc listboxsel {} {
2670 global ctext cflist currentid
2671 if {![info exists currentid]} return
2672 set sel [lsort [$cflist curselection]]
2673 if {$sel eq {}} return
2674 set first [lindex $sel 0]
2675 catch {$ctext yview fmark.$first}
2676}
2677
2678proc setcoords {} {
2679 global linespc charspc canvx0 canvy0 mainfont
2680 global xspc1 xspc2 lthickness
2681
2682 set linespc [font metrics $mainfont -linespace]
2683 set charspc [font measure $mainfont "m"]
2684 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2685 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2686 set lthickness [expr {int($linespc / 9) + 1}]
2687 set xspc1(0) $linespc
2688 set xspc2 $linespc
2689}
2690
2691proc redisplay {} {
2692 global canv canvy0 linespc numcommits
2693 global selectedline
2694
2695 set ymax [lindex [$canv cget -scrollregion] 3]
2696 if {$ymax eq {} || $ymax == 0} return
2697 set span [$canv yview]
2698 clear_display
2699 allcanvs conf -scrollregion \
2700 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2701 allcanvs yview moveto [lindex $span 0]
2702 drawvisible
2703 if {[info exists selectedline]} {
2704 selectline $selectedline 0
2705 }
2706}
2707
2708proc incrfont {inc} {
2709 global mainfont namefont textfont ctext canv phase
2710 global stopped entries
2711 unmarkmatches
2712 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2713 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2714 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2715 setcoords
2716 $ctext conf -font $textfont
2717 $ctext tag conf filesep -font [concat $textfont bold]
2718 foreach e $entries {
2719 $e conf -font $mainfont
2720 }
2721 if {$phase == "getcommits"} {
2722 $canv itemconf textitems -font $mainfont
2723 }
2724 redisplay
2725}
2726
2727proc clearsha1 {} {
2728 global sha1entry sha1string
2729 if {[string length $sha1string] == 40} {
2730 $sha1entry delete 0 end
2731 }
2732}
2733
2734proc sha1change {n1 n2 op} {
2735 global sha1string currentid sha1but
2736 if {$sha1string == {}
2737 || ([info exists currentid] && $sha1string == $currentid)} {
2738 set state disabled
2739 } else {
2740 set state normal
2741 }
2742 if {[$sha1but cget -state] == $state} return
2743 if {$state == "normal"} {
2744 $sha1but conf -state normal -relief raised -text "Goto: "
2745 } else {
2746 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2747 }
2748}
2749
2750proc gotocommit {} {
2751 global sha1string currentid commitrow tagids
2752 global displayorder numcommits
2753
2754 if {$sha1string == {}
2755 || ([info exists currentid] && $sha1string == $currentid)} return
2756 if {[info exists tagids($sha1string)]} {
2757 set id $tagids($sha1string)
2758 } else {
2759 set id [string tolower $sha1string]
2760 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2761 set matches {}
2762 foreach i $displayorder {
2763 if {[string match $id* $i]} {
2764 lappend matches $i
2765 }
2766 }
2767 if {$matches ne {}} {
2768 if {[llength $matches] > 1} {
2769 error_popup "Short SHA1 id $id is ambiguous"
2770 return
2771 }
2772 set id [lindex $matches 0]
2773 }
2774 }
2775 }
2776 if {[info exists commitrow($id)]} {
2777 selectline $commitrow($id) 1
2778 return
2779 }
2780 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2781 set type "SHA1 id"
2782 } else {
2783 set type "Tag"
2784 }
2785 error_popup "$type $sha1string is not known"
2786}
2787
2788proc lineenter {x y id} {
2789 global hoverx hovery hoverid hovertimer
2790 global commitinfo canv
2791
2792 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2793 set hoverx $x
2794 set hovery $y
2795 set hoverid $id
2796 if {[info exists hovertimer]} {
2797 after cancel $hovertimer
2798 }
2799 set hovertimer [after 500 linehover]
2800 $canv delete hover
2801}
2802
2803proc linemotion {x y id} {
2804 global hoverx hovery hoverid hovertimer
2805
2806 if {[info exists hoverid] && $id == $hoverid} {
2807 set hoverx $x
2808 set hovery $y
2809 if {[info exists hovertimer]} {
2810 after cancel $hovertimer
2811 }
2812 set hovertimer [after 500 linehover]
2813 }
2814}
2815
2816proc lineleave {id} {
2817 global hoverid hovertimer canv
2818
2819 if {[info exists hoverid] && $id == $hoverid} {
2820 $canv delete hover
2821 if {[info exists hovertimer]} {
2822 after cancel $hovertimer
2823 unset hovertimer
2824 }
2825 unset hoverid
2826 }
2827}
2828
2829proc linehover {} {
2830 global hoverx hovery hoverid hovertimer
2831 global canv linespc lthickness
2832 global commitinfo mainfont
2833
2834 set text [lindex $commitinfo($hoverid) 0]
2835 set ymax [lindex [$canv cget -scrollregion] 3]
2836 if {$ymax == {}} return
2837 set yfrac [lindex [$canv yview] 0]
2838 set x [expr {$hoverx + 2 * $linespc}]
2839 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2840 set x0 [expr {$x - 2 * $lthickness}]
2841 set y0 [expr {$y - 2 * $lthickness}]
2842 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2843 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2844 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2845 -fill \#ffff80 -outline black -width 1 -tags hover]
2846 $canv raise $t
2847 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2848 $canv raise $t
2849}
2850
2851proc clickisonarrow {id y} {
2852 global lthickness idrowranges
2853
2854 set thresh [expr {2 * $lthickness + 6}]
2855 set n [expr {[llength $idrowranges($id)] - 1}]
2856 for {set i 1} {$i < $n} {incr i} {
2857 set row [lindex $idrowranges($id) $i]
2858 if {abs([yc $row] - $y) < $thresh} {
2859 return $i
2860 }
2861 }
2862 return {}
2863}
2864
2865proc arrowjump {id n y} {
2866 global idrowranges canv
2867
2868 # 1 <-> 2, 3 <-> 4, etc...
2869 set n [expr {(($n - 1) ^ 1) + 1}]
2870 set row [lindex $idrowranges($id) $n]
2871 set yt [yc $row]
2872 set ymax [lindex [$canv cget -scrollregion] 3]
2873 if {$ymax eq {} || $ymax <= 0} return
2874 set view [$canv yview]
2875 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2876 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2877 if {$yfrac < 0} {
2878 set yfrac 0
2879 }
2880 allcanvs yview moveto $yfrac
2881}
2882
2883proc lineclick {x y id isnew} {
2884 global ctext commitinfo children cflist canv thickerline
2885
2886 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2887 unmarkmatches
2888 unselectline
2889 normalline
2890 $canv delete hover
2891 # draw this line thicker than normal
2892 set thickerline $id
2893 drawlines $id
2894 if {$isnew} {
2895 set ymax [lindex [$canv cget -scrollregion] 3]
2896 if {$ymax eq {}} return
2897 set yfrac [lindex [$canv yview] 0]
2898 set y [expr {$y + $yfrac * $ymax}]
2899 }
2900 set dirn [clickisonarrow $id $y]
2901 if {$dirn ne {}} {
2902 arrowjump $id $dirn $y
2903 return
2904 }
2905
2906 if {$isnew} {
2907 addtohistory [list lineclick $x $y $id 0]
2908 }
2909 # fill the details pane with info about this line
2910 $ctext conf -state normal
2911 $ctext delete 0.0 end
2912 $ctext tag conf link -foreground blue -underline 1
2913 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2914 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2915 $ctext insert end "Parent:\t"
2916 $ctext insert end $id [list link link0]
2917 $ctext tag bind link0 <1> [list selbyid $id]
2918 set info $commitinfo($id)
2919 $ctext insert end "\n\t[lindex $info 0]\n"
2920 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2921 set date [formatdate [lindex $info 2]]
2922 $ctext insert end "\tDate:\t$date\n"
2923 if {[info exists children($id)]} {
2924 $ctext insert end "\nChildren:"
2925 set i 0
2926 foreach child $children($id) {
2927 incr i
2928 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2929 set info $commitinfo($child)
2930 $ctext insert end "\n\t"
2931 $ctext insert end $child [list link link$i]
2932 $ctext tag bind link$i <1> [list selbyid $child]
2933 $ctext insert end "\n\t[lindex $info 0]"
2934 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2935 set date [formatdate [lindex $info 2]]
2936 $ctext insert end "\n\tDate:\t$date\n"
2937 }
2938 }
2939 $ctext conf -state disabled
2940
2941 $cflist delete 0 end
2942}
2943
2944proc normalline {} {
2945 global thickerline
2946 if {[info exists thickerline]} {
2947 set id $thickerline
2948 unset thickerline
2949 drawlines $id
2950 }
2951}
2952
2953proc selbyid {id} {
2954 global commitrow
2955 if {[info exists commitrow($id)]} {
2956 selectline $commitrow($id) 1
2957 }
2958}
2959
2960proc mstime {} {
2961 global startmstime
2962 if {![info exists startmstime]} {
2963 set startmstime [clock clicks -milliseconds]
2964 }
2965 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2966}
2967
2968proc rowmenu {x y id} {
2969 global rowctxmenu commitrow selectedline rowmenuid
2970
2971 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2972 set state disabled
2973 } else {
2974 set state normal
2975 }
2976 $rowctxmenu entryconfigure 0 -state $state
2977 $rowctxmenu entryconfigure 1 -state $state
2978 $rowctxmenu entryconfigure 2 -state $state
2979 set rowmenuid $id
2980 tk_popup $rowctxmenu $x $y
2981}
2982
2983proc diffvssel {dirn} {
2984 global rowmenuid selectedline displayorder
2985
2986 if {![info exists selectedline]} return
2987 if {$dirn} {
2988 set oldid [lindex $displayorder $selectedline]
2989 set newid $rowmenuid
2990 } else {
2991 set oldid $rowmenuid
2992 set newid [lindex $displayorder $selectedline]
2993 }
2994 addtohistory [list doseldiff $oldid $newid]
2995 doseldiff $oldid $newid
2996}
2997
2998proc doseldiff {oldid newid} {
2999 global ctext cflist
3000 global commitinfo
3001
3002 $ctext conf -state normal
3003 $ctext delete 0.0 end
3004 $ctext mark set fmark.0 0.0
3005 $ctext mark gravity fmark.0 left
3006 $cflist delete 0 end
3007 $cflist insert end "Top"
3008 $ctext insert end "From "
3009 $ctext tag conf link -foreground blue -underline 1
3010 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3011 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3012 $ctext tag bind link0 <1> [list selbyid $oldid]
3013 $ctext insert end $oldid [list link link0]
3014 $ctext insert end "\n "
3015 $ctext insert end [lindex $commitinfo($oldid) 0]
3016 $ctext insert end "\n\nTo "
3017 $ctext tag bind link1 <1> [list selbyid $newid]
3018 $ctext insert end $newid [list link link1]
3019 $ctext insert end "\n "
3020 $ctext insert end [lindex $commitinfo($newid) 0]
3021 $ctext insert end "\n"
3022 $ctext conf -state disabled
3023 $ctext tag delete Comments
3024 $ctext tag remove found 1.0 end
3025 startdiff [list $oldid $newid]
3026}
3027
3028proc mkpatch {} {
3029 global rowmenuid currentid commitinfo patchtop patchnum
3030
3031 if {![info exists currentid]} return
3032 set oldid $currentid
3033 set oldhead [lindex $commitinfo($oldid) 0]
3034 set newid $rowmenuid
3035 set newhead [lindex $commitinfo($newid) 0]
3036 set top .patch
3037 set patchtop $top
3038 catch {destroy $top}
3039 toplevel $top
3040 label $top.title -text "Generate patch"
3041 grid $top.title - -pady 10
3042 label $top.from -text "From:"
3043 entry $top.fromsha1 -width 40 -relief flat
3044 $top.fromsha1 insert 0 $oldid
3045 $top.fromsha1 conf -state readonly
3046 grid $top.from $top.fromsha1 -sticky w
3047 entry $top.fromhead -width 60 -relief flat
3048 $top.fromhead insert 0 $oldhead
3049 $top.fromhead conf -state readonly
3050 grid x $top.fromhead -sticky w
3051 label $top.to -text "To:"
3052 entry $top.tosha1 -width 40 -relief flat
3053 $top.tosha1 insert 0 $newid
3054 $top.tosha1 conf -state readonly
3055 grid $top.to $top.tosha1 -sticky w
3056 entry $top.tohead -width 60 -relief flat
3057 $top.tohead insert 0 $newhead
3058 $top.tohead conf -state readonly
3059 grid x $top.tohead -sticky w
3060 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3061 grid $top.rev x -pady 10
3062 label $top.flab -text "Output file:"
3063 entry $top.fname -width 60
3064 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3065 incr patchnum
3066 grid $top.flab $top.fname -sticky w
3067 frame $top.buts
3068 button $top.buts.gen -text "Generate" -command mkpatchgo
3069 button $top.buts.can -text "Cancel" -command mkpatchcan
3070 grid $top.buts.gen $top.buts.can
3071 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3072 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3073 grid $top.buts - -pady 10 -sticky ew
3074 focus $top.fname
3075}
3076
3077proc mkpatchrev {} {
3078 global patchtop
3079
3080 set oldid [$patchtop.fromsha1 get]
3081 set oldhead [$patchtop.fromhead get]
3082 set newid [$patchtop.tosha1 get]
3083 set newhead [$patchtop.tohead get]
3084 foreach e [list fromsha1 fromhead tosha1 tohead] \
3085 v [list $newid $newhead $oldid $oldhead] {
3086 $patchtop.$e conf -state normal
3087 $patchtop.$e delete 0 end
3088 $patchtop.$e insert 0 $v
3089 $patchtop.$e conf -state readonly
3090 }
3091}
3092
3093proc mkpatchgo {} {
3094 global patchtop
3095
3096 set oldid [$patchtop.fromsha1 get]
3097 set newid [$patchtop.tosha1 get]
3098 set fname [$patchtop.fname get]
3099 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3100 error_popup "Error creating patch: $err"
3101 }
3102 catch {destroy $patchtop}
3103 unset patchtop
3104}
3105
3106proc mkpatchcan {} {
3107 global patchtop
3108
3109 catch {destroy $patchtop}
3110 unset patchtop
3111}
3112
3113proc mktag {} {
3114 global rowmenuid mktagtop commitinfo
3115
3116 set top .maketag
3117 set mktagtop $top
3118 catch {destroy $top}
3119 toplevel $top
3120 label $top.title -text "Create tag"
3121 grid $top.title - -pady 10
3122 label $top.id -text "ID:"
3123 entry $top.sha1 -width 40 -relief flat
3124 $top.sha1 insert 0 $rowmenuid
3125 $top.sha1 conf -state readonly
3126 grid $top.id $top.sha1 -sticky w
3127 entry $top.head -width 60 -relief flat
3128 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3129 $top.head conf -state readonly
3130 grid x $top.head -sticky w
3131 label $top.tlab -text "Tag name:"
3132 entry $top.tag -width 60
3133 grid $top.tlab $top.tag -sticky w
3134 frame $top.buts
3135 button $top.buts.gen -text "Create" -command mktaggo
3136 button $top.buts.can -text "Cancel" -command mktagcan
3137 grid $top.buts.gen $top.buts.can
3138 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3139 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3140 grid $top.buts - -pady 10 -sticky ew
3141 focus $top.tag
3142}
3143
3144proc domktag {} {
3145 global mktagtop env tagids idtags
3146
3147 set id [$mktagtop.sha1 get]
3148 set tag [$mktagtop.tag get]
3149 if {$tag == {}} {
3150 error_popup "No tag name specified"
3151 return
3152 }
3153 if {[info exists tagids($tag)]} {
3154 error_popup "Tag \"$tag\" already exists"
3155 return
3156 }
3157 if {[catch {
3158 set dir [gitdir]
3159 set fname [file join $dir "refs/tags" $tag]
3160 set f [open $fname w]
3161 puts $f $id
3162 close $f
3163 } err]} {
3164 error_popup "Error creating tag: $err"
3165 return
3166 }
3167
3168 set tagids($tag) $id
3169 lappend idtags($id) $tag
3170 redrawtags $id
3171}
3172
3173proc redrawtags {id} {
3174 global canv linehtag commitrow idpos selectedline
3175
3176 if {![info exists commitrow($id)]} return
3177 drawcmitrow $commitrow($id)
3178 $canv delete tag.$id
3179 set xt [eval drawtags $id $idpos($id)]
3180 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3181 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3182 selectline $selectedline 0
3183 }
3184}
3185
3186proc mktagcan {} {
3187 global mktagtop
3188
3189 catch {destroy $mktagtop}
3190 unset mktagtop
3191}
3192
3193proc mktaggo {} {
3194 domktag
3195 mktagcan
3196}
3197
3198proc writecommit {} {
3199 global rowmenuid wrcomtop commitinfo wrcomcmd
3200
3201 set top .writecommit
3202 set wrcomtop $top
3203 catch {destroy $top}
3204 toplevel $top
3205 label $top.title -text "Write commit to file"
3206 grid $top.title - -pady 10
3207 label $top.id -text "ID:"
3208 entry $top.sha1 -width 40 -relief flat
3209 $top.sha1 insert 0 $rowmenuid
3210 $top.sha1 conf -state readonly
3211 grid $top.id $top.sha1 -sticky w
3212 entry $top.head -width 60 -relief flat
3213 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3214 $top.head conf -state readonly
3215 grid x $top.head -sticky w
3216 label $top.clab -text "Command:"
3217 entry $top.cmd -width 60 -textvariable wrcomcmd
3218 grid $top.clab $top.cmd -sticky w -pady 10
3219 label $top.flab -text "Output file:"
3220 entry $top.fname -width 60
3221 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3222 grid $top.flab $top.fname -sticky w
3223 frame $top.buts
3224 button $top.buts.gen -text "Write" -command wrcomgo
3225 button $top.buts.can -text "Cancel" -command wrcomcan
3226 grid $top.buts.gen $top.buts.can
3227 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3228 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3229 grid $top.buts - -pady 10 -sticky ew
3230 focus $top.fname
3231}
3232
3233proc wrcomgo {} {
3234 global wrcomtop
3235
3236 set id [$wrcomtop.sha1 get]
3237 set cmd "echo $id | [$wrcomtop.cmd get]"
3238 set fname [$wrcomtop.fname get]
3239 if {[catch {exec sh -c $cmd >$fname &} err]} {
3240 error_popup "Error writing commit: $err"
3241 }
3242 catch {destroy $wrcomtop}
3243 unset wrcomtop
3244}
3245
3246proc wrcomcan {} {
3247 global wrcomtop
3248
3249 catch {destroy $wrcomtop}
3250 unset wrcomtop
3251}
3252
3253proc listrefs {id} {
3254 global idtags idheads idotherrefs
3255
3256 set x {}
3257 if {[info exists idtags($id)]} {
3258 set x $idtags($id)
3259 }
3260 set y {}
3261 if {[info exists idheads($id)]} {
3262 set y $idheads($id)
3263 }
3264 set z {}
3265 if {[info exists idotherrefs($id)]} {
3266 set z $idotherrefs($id)
3267 }
3268 return [list $x $y $z]
3269}
3270
3271proc rereadrefs {} {
3272 global idtags idheads idotherrefs
3273 global tagids headids otherrefids
3274
3275 set refids [concat [array names idtags] \
3276 [array names idheads] [array names idotherrefs]]
3277 foreach id $refids {
3278 if {![info exists ref($id)]} {
3279 set ref($id) [listrefs $id]
3280 }
3281 }
3282 readrefs
3283 set refids [lsort -unique [concat $refids [array names idtags] \
3284 [array names idheads] [array names idotherrefs]]]
3285 foreach id $refids {
3286 set v [listrefs $id]
3287 if {![info exists ref($id)] || $ref($id) != $v} {
3288 redrawtags $id
3289 }
3290 }
3291}
3292
3293proc showtag {tag isnew} {
3294 global ctext cflist tagcontents tagids linknum
3295
3296 if {$isnew} {
3297 addtohistory [list showtag $tag 0]
3298 }
3299 $ctext conf -state normal
3300 $ctext delete 0.0 end
3301 set linknum 0
3302 if {[info exists tagcontents($tag)]} {
3303 set text $tagcontents($tag)
3304 } else {
3305 set text "Tag: $tag\nId: $tagids($tag)"
3306 }
3307 appendwithlinks $text
3308 $ctext conf -state disabled
3309 $cflist delete 0 end
3310}
3311
3312proc doquit {} {
3313 global stopped
3314 set stopped 100
3315 destroy .
3316}
3317
3318proc doprefs {} {
3319 global maxwidth maxgraphpct diffopts findmergefiles
3320 global oldprefs prefstop
3321
3322 set top .gitkprefs
3323 set prefstop $top
3324 if {[winfo exists $top]} {
3325 raise $top
3326 return
3327 }
3328 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3329 set oldprefs($v) [set $v]
3330 }
3331 toplevel $top
3332 wm title $top "Gitk preferences"
3333 label $top.ldisp -text "Commit list display options"
3334 grid $top.ldisp - -sticky w -pady 10
3335 label $top.spacer -text " "
3336 label $top.maxwidthl -text "Maximum graph width (lines)" \
3337 -font optionfont
3338 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3339 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3340 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3341 -font optionfont
3342 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3343 grid x $top.maxpctl $top.maxpct -sticky w
3344 checkbutton $top.findm -variable findmergefiles
3345 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3346 -font optionfont
3347 grid $top.findm $top.findml - -sticky w
3348 label $top.ddisp -text "Diff display options"
3349 grid $top.ddisp - -sticky w -pady 10
3350 label $top.diffoptl -text "Options for diff program" \
3351 -font optionfont
3352 entry $top.diffopt -width 20 -textvariable diffopts
3353 grid x $top.diffoptl $top.diffopt -sticky w
3354 frame $top.buts
3355 button $top.buts.ok -text "OK" -command prefsok
3356 button $top.buts.can -text "Cancel" -command prefscan
3357 grid $top.buts.ok $top.buts.can
3358 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3359 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3360 grid $top.buts - - -pady 10 -sticky ew
3361}
3362
3363proc prefscan {} {
3364 global maxwidth maxgraphpct diffopts findmergefiles
3365 global oldprefs prefstop
3366
3367 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3368 set $v $oldprefs($v)
3369 }
3370 catch {destroy $prefstop}
3371 unset prefstop
3372}
3373
3374proc prefsok {} {
3375 global maxwidth maxgraphpct
3376 global oldprefs prefstop
3377
3378 catch {destroy $prefstop}
3379 unset prefstop
3380 if {$maxwidth != $oldprefs(maxwidth)
3381 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3382 redisplay
3383 }
3384}
3385
3386proc formatdate {d} {
3387 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3388}
3389
3390# This list of encoding names and aliases is distilled from
3391# http://www.iana.org/assignments/character-sets.
3392# Not all of them are supported by Tcl.
3393set encoding_aliases {
3394 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3395 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3396 { ISO-10646-UTF-1 csISO10646UTF1 }
3397 { ISO_646.basic:1983 ref csISO646basic1983 }
3398 { INVARIANT csINVARIANT }
3399 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3400 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3401 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3402 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3403 { NATS-DANO iso-ir-9-1 csNATSDANO }
3404 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3405 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3406 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3407 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3408 { ISO-2022-KR csISO2022KR }
3409 { EUC-KR csEUCKR }
3410 { ISO-2022-JP csISO2022JP }
3411 { ISO-2022-JP-2 csISO2022JP2 }
3412 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3413 csISO13JISC6220jp }
3414 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3415 { IT iso-ir-15 ISO646-IT csISO15Italian }
3416 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3417 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3418 { greek7-old iso-ir-18 csISO18Greek7Old }
3419 { latin-greek iso-ir-19 csISO19LatinGreek }
3420 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3421 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3422 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3423 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3424 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3425 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3426 { INIS iso-ir-49 csISO49INIS }
3427 { INIS-8 iso-ir-50 csISO50INIS8 }
3428 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3429 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3430 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3431 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3432 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3433 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3434 csISO60Norwegian1 }
3435 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3436 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3437 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3438 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3439 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3440 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3441 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3442 { greek7 iso-ir-88 csISO88Greek7 }
3443 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3444 { iso-ir-90 csISO90 }
3445 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3446 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3447 csISO92JISC62991984b }
3448 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3449 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3450 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3451 csISO95JIS62291984handadd }
3452 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3453 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3454 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3455 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3456 CP819 csISOLatin1 }
3457 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3458 { T.61-7bit iso-ir-102 csISO102T617bit }
3459 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3460 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3461 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3462 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3463 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3464 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3465 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3466 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3467 arabic csISOLatinArabic }
3468 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3469 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3470 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3471 greek greek8 csISOLatinGreek }
3472 { T.101-G2 iso-ir-128 csISO128T101G2 }
3473 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3474 csISOLatinHebrew }
3475 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3476 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3477 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3478 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3479 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3480 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3481 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3482 csISOLatinCyrillic }
3483 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3484 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3485 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3486 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3487 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3488 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3489 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3490 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3491 { ISO_10367-box iso-ir-155 csISO10367Box }
3492 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3493 { latin-lap lap iso-ir-158 csISO158Lap }
3494 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3495 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3496 { us-dk csUSDK }
3497 { dk-us csDKUS }
3498 { JIS_X0201 X0201 csHalfWidthKatakana }
3499 { KSC5636 ISO646-KR csKSC5636 }
3500 { ISO-10646-UCS-2 csUnicode }
3501 { ISO-10646-UCS-4 csUCS4 }
3502 { DEC-MCS dec csDECMCS }
3503 { hp-roman8 roman8 r8 csHPRoman8 }
3504 { macintosh mac csMacintosh }
3505 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3506 csIBM037 }
3507 { IBM038 EBCDIC-INT cp038 csIBM038 }
3508 { IBM273 CP273 csIBM273 }
3509 { IBM274 EBCDIC-BE CP274 csIBM274 }
3510 { IBM275 EBCDIC-BR cp275 csIBM275 }
3511 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3512 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3513 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3514 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3515 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3516 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3517 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3518 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3519 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3520 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3521 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3522 { IBM437 cp437 437 csPC8CodePage437 }
3523 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3524 { IBM775 cp775 csPC775Baltic }
3525 { IBM850 cp850 850 csPC850Multilingual }
3526 { IBM851 cp851 851 csIBM851 }
3527 { IBM852 cp852 852 csPCp852 }
3528 { IBM855 cp855 855 csIBM855 }
3529 { IBM857 cp857 857 csIBM857 }
3530 { IBM860 cp860 860 csIBM860 }
3531 { IBM861 cp861 861 cp-is csIBM861 }
3532 { IBM862 cp862 862 csPC862LatinHebrew }
3533 { IBM863 cp863 863 csIBM863 }
3534 { IBM864 cp864 csIBM864 }
3535 { IBM865 cp865 865 csIBM865 }
3536 { IBM866 cp866 866 csIBM866 }
3537 { IBM868 CP868 cp-ar csIBM868 }
3538 { IBM869 cp869 869 cp-gr csIBM869 }
3539 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3540 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3541 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3542 { IBM891 cp891 csIBM891 }
3543 { IBM903 cp903 csIBM903 }
3544 { IBM904 cp904 904 csIBBM904 }
3545 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3546 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3547 { IBM1026 CP1026 csIBM1026 }
3548 { EBCDIC-AT-DE csIBMEBCDICATDE }
3549 { EBCDIC-AT-DE-A csEBCDICATDEA }
3550 { EBCDIC-CA-FR csEBCDICCAFR }
3551 { EBCDIC-DK-NO csEBCDICDKNO }
3552 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3553 { EBCDIC-FI-SE csEBCDICFISE }
3554 { EBCDIC-FI-SE-A csEBCDICFISEA }
3555 { EBCDIC-FR csEBCDICFR }
3556 { EBCDIC-IT csEBCDICIT }
3557 { EBCDIC-PT csEBCDICPT }
3558 { EBCDIC-ES csEBCDICES }
3559 { EBCDIC-ES-A csEBCDICESA }
3560 { EBCDIC-ES-S csEBCDICESS }
3561 { EBCDIC-UK csEBCDICUK }
3562 { EBCDIC-US csEBCDICUS }
3563 { UNKNOWN-8BIT csUnknown8BiT }
3564 { MNEMONIC csMnemonic }
3565 { MNEM csMnem }
3566 { VISCII csVISCII }
3567 { VIQR csVIQR }
3568 { KOI8-R csKOI8R }
3569 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3570 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3571 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3572 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3573 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3574 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3575 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3576 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3577 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3578 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3579 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3580 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3581 { IBM1047 IBM-1047 }
3582 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3583 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3584 { UNICODE-1-1 csUnicode11 }
3585 { CESU-8 csCESU-8 }
3586 { BOCU-1 csBOCU-1 }
3587 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3588 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3589 l8 }
3590 { ISO-8859-15 ISO_8859-15 Latin-9 }
3591 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3592 { GBK CP936 MS936 windows-936 }
3593 { JIS_Encoding csJISEncoding }
3594 { Shift_JIS MS_Kanji csShiftJIS }
3595 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3596 EUC-JP }
3597 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3598 { ISO-10646-UCS-Basic csUnicodeASCII }
3599 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3600 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3601 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3602 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3603 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3604 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3605 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3606 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3607 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3608 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3609 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3610 { Ventura-US csVenturaUS }
3611 { Ventura-International csVenturaInternational }
3612 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3613 { PC8-Turkish csPC8Turkish }
3614 { IBM-Symbols csIBMSymbols }
3615 { IBM-Thai csIBMThai }
3616 { HP-Legal csHPLegal }
3617 { HP-Pi-font csHPPiFont }
3618 { HP-Math8 csHPMath8 }
3619 { Adobe-Symbol-Encoding csHPPSMath }
3620 { HP-DeskTop csHPDesktop }
3621 { Ventura-Math csVenturaMath }
3622 { Microsoft-Publishing csMicrosoftPublishing }
3623 { Windows-31J csWindows31J }
3624 { GB2312 csGB2312 }
3625 { Big5 csBig5 }
3626}
3627
3628proc tcl_encoding {enc} {
3629 global encoding_aliases
3630 set names [encoding names]
3631 set lcnames [string tolower $names]
3632 set enc [string tolower $enc]
3633 set i [lsearch -exact $lcnames $enc]
3634 if {$i < 0} {
3635 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3636 if {[regsub {^iso[-_]} $enc iso encx]} {
3637 set i [lsearch -exact $lcnames $encx]
3638 }
3639 }
3640 if {$i < 0} {
3641 foreach l $encoding_aliases {
3642 set ll [string tolower $l]
3643 if {[lsearch -exact $ll $enc] < 0} continue
3644 # look through the aliases for one that tcl knows about
3645 foreach e $ll {
3646 set i [lsearch -exact $lcnames $e]
3647 if {$i < 0} {
3648 if {[regsub {^iso[-_]} $e iso ex]} {
3649 set i [lsearch -exact $lcnames $ex]
3650 }
3651 }
3652 if {$i >= 0} break
3653 }
3654 break
3655 }
3656 }
3657 if {$i >= 0} {
3658 return [lindex $names $i]
3659 }
3660 return {}
3661}
3662
3663# defaults...
3664set datemode 0
3665set diffopts "-U 5 -p"
3666set wrcomcmd "git-diff-tree --stdin -p --pretty"
3667
3668set gitencoding {}
3669catch {
3670 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3671}
3672if {$gitencoding == ""} {
3673 set gitencoding "utf-8"
3674}
3675set tclencoding [tcl_encoding $gitencoding]
3676if {$tclencoding == {}} {
3677 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3678}
3679
3680set mainfont {Helvetica 9}
3681set textfont {Courier 9}
3682set findmergefiles 0
3683set maxgraphpct 50
3684set maxwidth 16
3685set revlistorder 0
3686set fastdate 0
3687set uparrowlen 7
3688set downarrowlen 7
3689set mingaplen 30
3690
3691set colors {green red blue magenta darkgrey brown orange}
3692
3693catch {source ~/.gitk}
3694
3695set namefont $mainfont
3696
3697font create optionfont -family sans-serif -size -12
3698
3699set revtreeargs {}
3700foreach arg $argv {
3701 switch -regexp -- $arg {
3702 "^$" { }
3703 "^-d" { set datemode 1 }
3704 default {
3705 lappend revtreeargs $arg
3706 }
3707 }
3708}
3709
3710# check that we can find a .git directory somewhere...
3711set gitdir [gitdir]
3712if {![file isdirectory $gitdir]} {
3713 error_popup "Cannot find the git directory \"$gitdir\"."
3714 exit 1
3715}
3716
3717set history {}
3718set historyindex 0
3719
3720set optim_delay 16
3721
3722set stopped 0
3723set stuffsaved 0
3724set patchnum 0
3725setcoords
3726makewindow $revtreeargs
3727readrefs
3728getcommits $revtreeargs