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