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