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