Merge branch 'new'
[git/mingw/4msysgit.git] / gitk
blob7c25d2ef9702b696fdec62b07943a868260dc4ea
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"
19 proc start_rev_list {} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global revtreeargs curview viewfiles
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
26 set ncmupdate 1
27 initlayout
28 set args $revtreeargs
29 if {$viewfiles($curview) ne {}} {
30 set args [concat $args "--" $viewfiles($curview)]
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
36 if {[catch {
37 set commfd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git-rev-list: $err"
41 exit 1
43 set leftover {}
44 fconfigure $commfd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $commfd -encoding $tclencoding
48 fileevent $commfd readable [list getcommitlines $commfd]
49 . config -cursor watch
50 settextcursor watch
53 proc stop_rev_list {} {
54 global commfd
56 if {![info exists commfd]} return
57 catch {
58 set pid [pid $commfd]
59 exec kill $pid
61 catch {close $commfd}
62 unset commfd
65 proc getcommits {} {
66 global phase canv mainfont
68 set phase getcommits
69 start_rev_list
70 $canv delete all
71 $canv create text 3 3 -anchor nw -text "Reading commits..." \
72 -font $mainfont -tags textitems
75 proc getcommitlines {commfd} {
76 global commitlisted nextupdate
77 global leftover
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children
81 set stuff [read $commfd]
82 if {$stuff == {}} {
83 if {![eof $commfd]} return
84 # set it blocking so we wait for the process to terminate
85 fconfigure $commfd -blocking 1
86 if {![catch {close $commfd} err]} {
87 after idle finishcommits
88 return
90 if {[string range $err 0 4] == "usage"} {
91 set err \
92 "Gitk: error reading commits: bad arguments to git-rev-list.\
93 (Note: arguments to gitk are passed to git-rev-list\
94 to allow selection of commits to be displayed.)"
95 } else {
96 set err "Error reading commits: $err"
98 error_popup $err
99 exit 1
101 set start 0
102 set gotsome 0
103 while 1 {
104 set i [string first "\0" $stuff $start]
105 if {$i < 0} {
106 append leftover [string range $stuff $start end]
107 break
109 if {$start == 0} {
110 set cmit $leftover
111 append cmit [string range $stuff 0 [expr {$i - 1}]]
112 set leftover {}
113 } else {
114 set cmit [string range $stuff $start [expr {$i - 1}]]
116 set start [expr {$i + 1}]
117 set j [string first "\n" $cmit]
118 set ok 0
119 set listed 1
120 if {$j >= 0} {
121 set ids [string range $cmit 0 [expr {$j - 1}]]
122 if {[string range $ids 0 0] == "-"} {
123 set listed 0
124 set ids [string range $ids 1 end]
126 set ok 1
127 foreach id $ids {
128 if {[string length $id] != 40} {
129 set ok 0
130 break
134 if {!$ok} {
135 set shortcmit $cmit
136 if {[string length $shortcmit] > 80} {
137 set shortcmit "[string range $shortcmit 0 80]..."
139 error_popup "Can't parse git-rev-list output: {$shortcmit}"
140 exit 1
142 set id [lindex $ids 0]
143 if {$listed} {
144 set olds [lrange $ids 1 end]
145 set i 0
146 foreach p $olds {
147 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
148 lappend children($p) $id
150 incr i
152 } else {
153 set olds {}
155 lappend parentlist $olds
156 if {[info exists children($id)]} {
157 lappend childlist $children($id)
158 unset children($id)
159 } else {
160 lappend childlist {}
162 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
163 set commitrow($id) $commitidx
164 incr commitidx
165 lappend displayorder $id
166 lappend commitlisted $listed
167 set gotsome 1
169 if {$gotsome} {
170 layoutmore
172 if {[clock clicks -milliseconds] >= $nextupdate} {
173 doupdate 1
177 proc doupdate {reading} {
178 global commfd nextupdate numcommits ncmupdate
180 if {$reading} {
181 fileevent $commfd readable {}
183 update
184 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
185 if {$numcommits < 100} {
186 set ncmupdate [expr {$numcommits + 1}]
187 } elseif {$numcommits < 10000} {
188 set ncmupdate [expr {$numcommits + 10}]
189 } else {
190 set ncmupdate [expr {$numcommits + 100}]
192 if {$reading} {
193 fileevent $commfd readable [list getcommitlines $commfd]
197 proc readcommit {id} {
198 if {[catch {set contents [exec git-cat-file commit $id]}]} return
199 parsecommit $id $contents 0
202 proc updatecommits {} {
203 global viewdata curview revtreeargs phase
205 if {$phase ne {}} {
206 stop_rev_list
207 set phase {}
209 set n $curview
210 set curview -1
211 catch {unset viewdata($n)}
212 readrefs
213 showview $n
216 proc parsecommit {id contents listed} {
217 global commitinfo cdate
219 set inhdr 1
220 set comment {}
221 set headline {}
222 set auname {}
223 set audate {}
224 set comname {}
225 set comdate {}
226 set hdrend [string first "\n\n" $contents]
227 if {$hdrend < 0} {
228 # should never happen...
229 set hdrend [string length $contents]
231 set header [string range $contents 0 [expr {$hdrend - 1}]]
232 set comment [string range $contents [expr {$hdrend + 2}] end]
233 foreach line [split $header "\n"] {
234 set tag [lindex $line 0]
235 if {$tag == "author"} {
236 set audate [lindex $line end-1]
237 set auname [lrange $line 1 end-2]
238 } elseif {$tag == "committer"} {
239 set comdate [lindex $line end-1]
240 set comname [lrange $line 1 end-2]
243 set headline {}
244 # take the first line of the comment as the headline
245 set i [string first "\n" $comment]
246 if {$i >= 0} {
247 set headline [string trim [string range $comment 0 $i]]
248 } else {
249 set headline $comment
251 if {!$listed} {
252 # git-rev-list indents the comment by 4 spaces;
253 # if we got this via git-cat-file, add the indentation
254 set newcomment {}
255 foreach line [split $comment "\n"] {
256 append newcomment " "
257 append newcomment $line
258 append newcomment "\n"
260 set comment $newcomment
262 if {$comdate != {}} {
263 set cdate($id) $comdate
265 set commitinfo($id) [list $headline $auname $audate \
266 $comname $comdate $comment]
269 proc getcommit {id} {
270 global commitdata commitinfo
272 if {[info exists commitdata($id)]} {
273 parsecommit $id $commitdata($id) 1
274 } else {
275 readcommit $id
276 if {![info exists commitinfo($id)]} {
277 set commitinfo($id) {"No commit information available"}
280 return 1
283 proc readrefs {} {
284 global tagids idtags headids idheads tagcontents
285 global otherrefids idotherrefs
287 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
288 catch {unset $v}
290 set refd [open [list | git ls-remote [gitdir]] r]
291 while {0 <= [set n [gets $refd line]]} {
292 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
293 match id path]} {
294 continue
296 if {[regexp {^remotes/.*/HEAD$} $path match]} {
297 continue
299 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
300 set type others
301 set name $path
303 if {[regexp {^remotes/} $path match]} {
304 set type heads
306 if {$type == "tags"} {
307 set tagids($name) $id
308 lappend idtags($id) $name
309 set obj {}
310 set type {}
311 set tag {}
312 catch {
313 set commit [exec git-rev-parse "$id^0"]
314 if {"$commit" != "$id"} {
315 set tagids($name) $commit
316 lappend idtags($commit) $name
319 catch {
320 set tagcontents($name) [exec git-cat-file tag "$id"]
322 } elseif { $type == "heads" } {
323 set headids($name) $id
324 lappend idheads($id) $name
325 } else {
326 set otherrefids($name) $id
327 lappend idotherrefs($id) $name
330 close $refd
333 proc error_popup msg {
334 set w .error
335 toplevel $w
336 wm transient $w .
337 message $w.m -text $msg -justify center -aspect 400
338 pack $w.m -side top -fill x -padx 20 -pady 20
339 button $w.ok -text OK -command "destroy $w"
340 pack $w.ok -side bottom -fill x
341 bind $w <Visibility> "grab $w; focus $w"
342 bind $w <Key-Return> "destroy $w"
343 tkwait window $w
346 proc makewindow {} {
347 global canv canv2 canv3 linespc charspc ctext cflist
348 global textfont mainfont uifont
349 global findtype findtypemenu findloc findstring fstring geometry
350 global entries sha1entry sha1string sha1but
351 global maincursor textcursor curtextcursor
352 global rowctxmenu mergemax
354 menu .bar
355 .bar add cascade -label "File" -menu .bar.file
356 .bar configure -font $uifont
357 menu .bar.file
358 .bar.file add command -label "Update" -command updatecommits
359 .bar.file add command -label "Reread references" -command rereadrefs
360 .bar.file add command -label "Quit" -command doquit
361 .bar.file configure -font $uifont
362 menu .bar.edit
363 .bar add cascade -label "Edit" -menu .bar.edit
364 .bar.edit add command -label "Preferences" -command doprefs
365 .bar.edit configure -font $uifont
366 menu .bar.view -font $uifont
367 .bar add cascade -label "View" -menu .bar.view
368 .bar.view add command -label "New view..." -command newview
369 .bar.view add command -label "Edit view..." -command editview
370 .bar.view add command -label "Delete view" -command delview -state disabled
371 .bar.view add separator
372 .bar.view add radiobutton -label "All files" -command {showview 0} \
373 -variable selectedview -value 0
374 menu .bar.help
375 .bar add cascade -label "Help" -menu .bar.help
376 .bar.help add command -label "About gitk" -command about
377 .bar.help add command -label "Key bindings" -command keys
378 .bar.help configure -font $uifont
379 . configure -menu .bar
381 if {![info exists geometry(canv1)]} {
382 set geometry(canv1) [expr {45 * $charspc}]
383 set geometry(canv2) [expr {30 * $charspc}]
384 set geometry(canv3) [expr {15 * $charspc}]
385 set geometry(canvh) [expr {25 * $linespc + 4}]
386 set geometry(ctextw) 80
387 set geometry(ctexth) 30
388 set geometry(cflistw) 30
390 panedwindow .ctop -orient vertical
391 if {[info exists geometry(width)]} {
392 .ctop conf -width $geometry(width) -height $geometry(height)
393 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
394 set geometry(ctexth) [expr {($texth - 8) /
395 [font metrics $textfont -linespace]}]
397 frame .ctop.top
398 frame .ctop.top.bar
399 pack .ctop.top.bar -side bottom -fill x
400 set cscroll .ctop.top.csb
401 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
402 pack $cscroll -side right -fill y
403 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
404 pack .ctop.top.clist -side top -fill both -expand 1
405 .ctop add .ctop.top
406 set canv .ctop.top.clist.canv
407 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
408 -bg white -bd 0 \
409 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
410 .ctop.top.clist add $canv
411 set canv2 .ctop.top.clist.canv2
412 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
413 -bg white -bd 0 -yscrollincr $linespc
414 .ctop.top.clist add $canv2
415 set canv3 .ctop.top.clist.canv3
416 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
417 -bg white -bd 0 -yscrollincr $linespc
418 .ctop.top.clist add $canv3
419 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
421 set sha1entry .ctop.top.bar.sha1
422 set entries $sha1entry
423 set sha1but .ctop.top.bar.sha1label
424 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
425 -command gotocommit -width 8 -font $uifont
426 $sha1but conf -disabledforeground [$sha1but cget -foreground]
427 pack .ctop.top.bar.sha1label -side left
428 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
429 trace add variable sha1string write sha1change
430 pack $sha1entry -side left -pady 2
432 image create bitmap bm-left -data {
433 #define left_width 16
434 #define left_height 16
435 static unsigned char left_bits[] = {
436 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
437 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
438 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
440 image create bitmap bm-right -data {
441 #define right_width 16
442 #define right_height 16
443 static unsigned char right_bits[] = {
444 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
445 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
446 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
448 button .ctop.top.bar.leftbut -image bm-left -command goback \
449 -state disabled -width 26
450 pack .ctop.top.bar.leftbut -side left -fill y
451 button .ctop.top.bar.rightbut -image bm-right -command goforw \
452 -state disabled -width 26
453 pack .ctop.top.bar.rightbut -side left -fill y
455 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
456 pack .ctop.top.bar.findbut -side left
457 set findstring {}
458 set fstring .ctop.top.bar.findstring
459 lappend entries $fstring
460 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
461 pack $fstring -side left -expand 1 -fill x
462 set findtype Exact
463 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
464 findtype Exact IgnCase Regexp]
465 .ctop.top.bar.findtype configure -font $uifont
466 .ctop.top.bar.findtype.menu configure -font $uifont
467 set findloc "All fields"
468 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
469 Comments Author Committer Files Pickaxe
470 .ctop.top.bar.findloc configure -font $uifont
471 .ctop.top.bar.findloc.menu configure -font $uifont
473 pack .ctop.top.bar.findloc -side right
474 pack .ctop.top.bar.findtype -side right
475 # for making sure type==Exact whenever loc==Pickaxe
476 trace add variable findloc write findlocchange
478 panedwindow .ctop.cdet -orient horizontal
479 .ctop add .ctop.cdet
480 frame .ctop.cdet.left
481 set ctext .ctop.cdet.left.ctext
482 text $ctext -bg white -state disabled -font $textfont \
483 -width $geometry(ctextw) -height $geometry(ctexth) \
484 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
485 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
486 pack .ctop.cdet.left.sb -side right -fill y
487 pack $ctext -side left -fill both -expand 1
488 .ctop.cdet add .ctop.cdet.left
490 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
491 $ctext tag conf hunksep -fore blue
492 $ctext tag conf d0 -fore red
493 $ctext tag conf d1 -fore "#00a000"
494 $ctext tag conf m0 -fore red
495 $ctext tag conf m1 -fore blue
496 $ctext tag conf m2 -fore green
497 $ctext tag conf m3 -fore purple
498 $ctext tag conf m4 -fore brown
499 $ctext tag conf m5 -fore "#009090"
500 $ctext tag conf m6 -fore magenta
501 $ctext tag conf m7 -fore "#808000"
502 $ctext tag conf m8 -fore "#009000"
503 $ctext tag conf m9 -fore "#ff0080"
504 $ctext tag conf m10 -fore cyan
505 $ctext tag conf m11 -fore "#b07070"
506 $ctext tag conf m12 -fore "#70b0f0"
507 $ctext tag conf m13 -fore "#70f0b0"
508 $ctext tag conf m14 -fore "#f0b070"
509 $ctext tag conf m15 -fore "#ff70b0"
510 $ctext tag conf mmax -fore darkgrey
511 set mergemax 16
512 $ctext tag conf mresult -font [concat $textfont bold]
513 $ctext tag conf msep -font [concat $textfont bold]
514 $ctext tag conf found -back yellow
516 frame .ctop.cdet.right
517 set cflist .ctop.cdet.right.cfiles
518 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
519 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
520 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
521 pack .ctop.cdet.right.sb -side right -fill y
522 pack $cflist -side left -fill both -expand 1
523 .ctop.cdet add .ctop.cdet.right
524 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
526 pack .ctop -side top -fill both -expand 1
528 bindall <1> {selcanvline %W %x %y}
529 #bindall <B1-Motion> {selcanvline %W %x %y}
530 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
531 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
532 bindall <2> "canvscan mark %W %x %y"
533 bindall <B2-Motion> "canvscan dragto %W %x %y"
534 bindkey <Home> selfirstline
535 bindkey <End> sellastline
536 bind . <Key-Up> "selnextline -1"
537 bind . <Key-Down> "selnextline 1"
538 bindkey <Key-Right> "goforw"
539 bindkey <Key-Left> "goback"
540 bind . <Key-Prior> "selnextpage -1"
541 bind . <Key-Next> "selnextpage 1"
542 bind . <Control-Home> "allcanvs yview moveto 0.0"
543 bind . <Control-End> "allcanvs yview moveto 1.0"
544 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
545 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
546 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
547 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
548 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
549 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
550 bindkey <Key-space> "$ctext yview scroll 1 pages"
551 bindkey p "selnextline -1"
552 bindkey n "selnextline 1"
553 bindkey z "goback"
554 bindkey x "goforw"
555 bindkey i "selnextline -1"
556 bindkey k "selnextline 1"
557 bindkey j "goback"
558 bindkey l "goforw"
559 bindkey b "$ctext yview scroll -1 pages"
560 bindkey d "$ctext yview scroll 18 units"
561 bindkey u "$ctext yview scroll -18 units"
562 bindkey / {findnext 1}
563 bindkey <Key-Return> {findnext 0}
564 bindkey ? findprev
565 bindkey f nextfile
566 bind . <Control-q> doquit
567 bind . <Control-f> dofind
568 bind . <Control-g> {findnext 0}
569 bind . <Control-r> findprev
570 bind . <Control-equal> {incrfont 1}
571 bind . <Control-KP_Add> {incrfont 1}
572 bind . <Control-minus> {incrfont -1}
573 bind . <Control-KP_Subtract> {incrfont -1}
574 bind $cflist <<ListboxSelect>> listboxsel
575 bind . <Destroy> {savestuff %W}
576 bind . <Button-1> "click %W"
577 bind $fstring <Key-Return> dofind
578 bind $sha1entry <Key-Return> gotocommit
579 bind $sha1entry <<PasteSelection>> clearsha1
581 set maincursor [. cget -cursor]
582 set textcursor [$ctext cget -cursor]
583 set curtextcursor $textcursor
585 set rowctxmenu .rowctxmenu
586 menu $rowctxmenu -tearoff 0
587 $rowctxmenu add command -label "Diff this -> selected" \
588 -command {diffvssel 0}
589 $rowctxmenu add command -label "Diff selected -> this" \
590 -command {diffvssel 1}
591 $rowctxmenu add command -label "Make patch" -command mkpatch
592 $rowctxmenu add command -label "Create tag" -command mktag
593 $rowctxmenu add command -label "Write commit to file" -command writecommit
596 # mouse-2 makes all windows scan vertically, but only the one
597 # the cursor is in scans horizontally
598 proc canvscan {op w x y} {
599 global canv canv2 canv3
600 foreach c [list $canv $canv2 $canv3] {
601 if {$c == $w} {
602 $c scan $op $x $y
603 } else {
604 $c scan $op 0 $y
609 proc scrollcanv {cscroll f0 f1} {
610 $cscroll set $f0 $f1
611 drawfrac $f0 $f1
614 # when we make a key binding for the toplevel, make sure
615 # it doesn't get triggered when that key is pressed in the
616 # find string entry widget.
617 proc bindkey {ev script} {
618 global entries
619 bind . $ev $script
620 set escript [bind Entry $ev]
621 if {$escript == {}} {
622 set escript [bind Entry <Key>]
624 foreach e $entries {
625 bind $e $ev "$escript; break"
629 # set the focus back to the toplevel for any click outside
630 # the entry widgets
631 proc click {w} {
632 global entries
633 foreach e $entries {
634 if {$w == $e} return
636 focus .
639 proc savestuff {w} {
640 global canv canv2 canv3 ctext cflist mainfont textfont uifont
641 global stuffsaved findmergefiles maxgraphpct
642 global maxwidth
643 global viewname viewfiles viewperm nextviewnum
645 if {$stuffsaved} return
646 if {![winfo viewable .]} return
647 catch {
648 set f [open "~/.gitk-new" w]
649 puts $f [list set mainfont $mainfont]
650 puts $f [list set textfont $textfont]
651 puts $f [list set uifont $uifont]
652 puts $f [list set findmergefiles $findmergefiles]
653 puts $f [list set maxgraphpct $maxgraphpct]
654 puts $f [list set maxwidth $maxwidth]
655 puts $f "set geometry(width) [winfo width .ctop]"
656 puts $f "set geometry(height) [winfo height .ctop]"
657 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
658 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
659 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
660 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
661 set wid [expr {([winfo width $ctext] - 8) \
662 / [font measure $textfont "0"]}]
663 puts $f "set geometry(ctextw) $wid"
664 set wid [expr {([winfo width $cflist] - 11) \
665 / [font measure [$cflist cget -font] "0"]}]
666 puts $f "set geometry(cflistw) $wid"
667 puts -nonewline $f "set permviews {"
668 for {set v 0} {$v < $nextviewnum} {incr v} {
669 if {$viewperm($v)} {
670 puts $f "{[list $viewname($v) $viewfiles($v)]}"
673 puts $f "}"
674 close $f
675 file rename -force "~/.gitk-new" "~/.gitk"
677 set stuffsaved 1
680 proc resizeclistpanes {win w} {
681 global oldwidth
682 if {[info exists oldwidth($win)]} {
683 set s0 [$win sash coord 0]
684 set s1 [$win sash coord 1]
685 if {$w < 60} {
686 set sash0 [expr {int($w/2 - 2)}]
687 set sash1 [expr {int($w*5/6 - 2)}]
688 } else {
689 set factor [expr {1.0 * $w / $oldwidth($win)}]
690 set sash0 [expr {int($factor * [lindex $s0 0])}]
691 set sash1 [expr {int($factor * [lindex $s1 0])}]
692 if {$sash0 < 30} {
693 set sash0 30
695 if {$sash1 < $sash0 + 20} {
696 set sash1 [expr {$sash0 + 20}]
698 if {$sash1 > $w - 10} {
699 set sash1 [expr {$w - 10}]
700 if {$sash0 > $sash1 - 20} {
701 set sash0 [expr {$sash1 - 20}]
705 $win sash place 0 $sash0 [lindex $s0 1]
706 $win sash place 1 $sash1 [lindex $s1 1]
708 set oldwidth($win) $w
711 proc resizecdetpanes {win w} {
712 global oldwidth
713 if {[info exists oldwidth($win)]} {
714 set s0 [$win sash coord 0]
715 if {$w < 60} {
716 set sash0 [expr {int($w*3/4 - 2)}]
717 } else {
718 set factor [expr {1.0 * $w / $oldwidth($win)}]
719 set sash0 [expr {int($factor * [lindex $s0 0])}]
720 if {$sash0 < 45} {
721 set sash0 45
723 if {$sash0 > $w - 15} {
724 set sash0 [expr {$w - 15}]
727 $win sash place 0 $sash0 [lindex $s0 1]
729 set oldwidth($win) $w
732 proc allcanvs args {
733 global canv canv2 canv3
734 eval $canv $args
735 eval $canv2 $args
736 eval $canv3 $args
739 proc bindall {event action} {
740 global canv canv2 canv3
741 bind $canv $event $action
742 bind $canv2 $event $action
743 bind $canv3 $event $action
746 proc about {} {
747 set w .about
748 if {[winfo exists $w]} {
749 raise $w
750 return
752 toplevel $w
753 wm title $w "About gitk"
754 message $w.m -text {
755 Gitk - a commit viewer for git
757 Copyright © 2005-2006 Paul Mackerras
759 Use and redistribute under the terms of the GNU General Public License} \
760 -justify center -aspect 400
761 pack $w.m -side top -fill x -padx 20 -pady 20
762 button $w.ok -text Close -command "destroy $w"
763 pack $w.ok -side bottom
766 proc keys {} {
767 set w .keys
768 if {[winfo exists $w]} {
769 raise $w
770 return
772 toplevel $w
773 wm title $w "Gitk key bindings"
774 message $w.m -text {
775 Gitk key bindings:
777 <Ctrl-Q> Quit
778 <Home> Move to first commit
779 <End> Move to last commit
780 <Up>, p, i Move up one commit
781 <Down>, n, k Move down one commit
782 <Left>, z, j Go back in history list
783 <Right>, x, l Go forward in history list
784 <PageUp> Move up one page in commit list
785 <PageDown> Move down one page in commit list
786 <Ctrl-Home> Scroll to top of commit list
787 <Ctrl-End> Scroll to bottom of commit list
788 <Ctrl-Up> Scroll commit list up one line
789 <Ctrl-Down> Scroll commit list down one line
790 <Ctrl-PageUp> Scroll commit list up one page
791 <Ctrl-PageDown> Scroll commit list down one page
792 <Delete>, b Scroll diff view up one page
793 <Backspace> Scroll diff view up one page
794 <Space> Scroll diff view down one page
795 u Scroll diff view up 18 lines
796 d Scroll diff view down 18 lines
797 <Ctrl-F> Find
798 <Ctrl-G> Move to next find hit
799 <Ctrl-R> Move to previous find hit
800 <Return> Move to next find hit
801 / Move to next find hit, or redo find
802 ? Move to previous find hit
803 f Scroll diff view to next file
804 <Ctrl-KP+> Increase font size
805 <Ctrl-plus> Increase font size
806 <Ctrl-KP-> Decrease font size
807 <Ctrl-minus> Decrease font size
809 -justify left -bg white -border 2 -relief sunken
810 pack $w.m -side top -fill both
811 button $w.ok -text Close -command "destroy $w"
812 pack $w.ok -side bottom
815 proc newview {} {
816 global nextviewnum newviewname newviewperm uifont
818 set top .gitkview
819 if {[winfo exists $top]} {
820 raise $top
821 return
823 set newviewname($nextviewnum) "View $nextviewnum"
824 set newviewperm($nextviewnum) 0
825 vieweditor $top $nextviewnum "Gitk view definition"
828 proc editview {} {
829 global curview
830 global viewname viewperm newviewname newviewperm
832 set top .gitkvedit-$curview
833 if {[winfo exists $top]} {
834 raise $top
835 return
837 set newviewname($curview) $viewname($curview)
838 set newviewperm($curview) $viewperm($curview)
839 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
842 proc vieweditor {top n title} {
843 global newviewname newviewperm viewfiles
844 global uifont
846 toplevel $top
847 wm title $top $title
848 label $top.nl -text "Name" -font $uifont
849 entry $top.name -width 20 -textvariable newviewname($n)
850 grid $top.nl $top.name -sticky w -pady 5
851 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
852 grid $top.perm - -pady 5 -sticky w
853 message $top.l -aspect 500 -font $uifont \
854 -text "Enter files and directories to include, one per line:"
855 grid $top.l - -sticky w
856 text $top.t -width 40 -height 10 -background white
857 if {[info exists viewfiles($n)]} {
858 foreach f $viewfiles($n) {
859 $top.t insert end $f
860 $top.t insert end "\n"
862 $top.t delete {end - 1c} end
863 $top.t mark set insert 0.0
865 grid $top.t - -sticky w -padx 5
866 frame $top.buts
867 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
868 button $top.buts.can -text "Cancel" -command [list destroy $top]
869 grid $top.buts.ok $top.buts.can
870 grid columnconfigure $top.buts 0 -weight 1 -uniform a
871 grid columnconfigure $top.buts 1 -weight 1 -uniform a
872 grid $top.buts - -pady 10 -sticky ew
873 focus $top.t
876 proc viewmenuitem {n} {
877 set nmenu [.bar.view index end]
878 set targetcmd [list showview $n]
879 for {set i 6} {$i <= $nmenu} {incr i} {
880 if {[.bar.view entrycget $i -command] eq $targetcmd} {
881 return $i
884 return {}
887 proc newviewok {top n} {
888 global nextviewnum newviewperm newviewname
889 global viewname viewfiles viewperm selectedview curview
891 set files {}
892 foreach f [split [$top.t get 0.0 end] "\n"] {
893 set ft [string trim $f]
894 if {$ft ne {}} {
895 lappend files $ft
898 if {![info exists viewfiles($n)]} {
899 # creating a new view
900 incr nextviewnum
901 set viewname($n) $newviewname($n)
902 set viewperm($n) $newviewperm($n)
903 set viewfiles($n) $files
904 .bar.view add radiobutton -label $viewname($n) \
905 -command [list showview $n] -variable selectedview -value $n
906 after idle showview $n
907 } else {
908 # editing an existing view
909 set viewperm($n) $newviewperm($n)
910 if {$newviewname($n) ne $viewname($n)} {
911 set viewname($n) $newviewname($n)
912 set i [viewmenuitem $n]
913 if {$i ne {}} {
914 .bar.view entryconf $i -label $viewname($n)
917 if {$files ne $viewfiles($n)} {
918 set viewfiles($n) $files
919 if {$curview == $n} {
920 after idle updatecommits
924 catch {destroy $top}
927 proc delview {} {
928 global curview viewdata viewperm
930 if {$curview == 0} return
931 set i [viewmenuitem $curview]
932 if {$i ne {}} {
933 .bar.view delete $i
935 set viewdata($curview) {}
936 set viewperm($curview) 0
937 showview 0
940 proc flatten {var} {
941 global $var
943 set ret {}
944 foreach i [array names $var] {
945 lappend ret $i [set $var\($i\)]
947 return $ret
950 proc unflatten {var l} {
951 global $var
953 catch {unset $var}
954 foreach {i v} $l {
955 set $var\($i\) $v
959 proc showview {n} {
960 global curview viewdata viewfiles
961 global displayorder parentlist childlist rowidlist rowoffsets
962 global colormap rowtextx commitrow
963 global numcommits rowrangelist commitlisted idrowranges
964 global selectedline currentid canv canvy0
965 global matchinglines treediffs
966 global pending_select phase
967 global commitidx rowlaidout rowoptim linesegends leftover
968 global commfd nextupdate
969 global selectedview
971 if {$n == $curview} return
972 set selid {}
973 if {[info exists selectedline]} {
974 set selid $currentid
975 set y [yc $selectedline]
976 set ymax [lindex [$canv cget -scrollregion] 3]
977 set span [$canv yview]
978 set ytop [expr {[lindex $span 0] * $ymax}]
979 set ybot [expr {[lindex $span 1] * $ymax}]
980 if {$ytop < $y && $y < $ybot} {
981 set yscreen [expr {$y - $ytop}]
982 } else {
983 set yscreen [expr {($ybot - $ytop) / 2}]
986 unselectline
987 normalline
988 stopfindproc
989 if {$curview >= 0} {
990 if {$phase ne {}} {
991 set viewdata($curview) \
992 [list $phase $displayorder $parentlist $childlist $rowidlist \
993 $rowoffsets $rowrangelist $commitlisted \
994 [flatten children] [flatten idrowranges] \
995 [flatten idinlist] \
996 $commitidx $rowlaidout $rowoptim $numcommits \
997 $linesegends $leftover $commfd]
998 fileevent $commfd readable {}
999 } elseif {![info exists viewdata($curview)]
1000 || [lindex $viewdata($curview) 0] ne {}} {
1001 set viewdata($curview) \
1002 [list {} $displayorder $parentlist $childlist $rowidlist \
1003 $rowoffsets $rowrangelist $commitlisted]
1006 catch {unset matchinglines}
1007 catch {unset treediffs}
1008 clear_display
1010 set curview $n
1011 set selectedview $n
1012 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1013 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1015 if {![info exists viewdata($n)]} {
1016 set pending_select $selid
1017 getcommits
1018 return
1021 set v $viewdata($n)
1022 set phase [lindex $v 0]
1023 set displayorder [lindex $v 1]
1024 set parentlist [lindex $v 2]
1025 set childlist [lindex $v 3]
1026 set rowidlist [lindex $v 4]
1027 set rowoffsets [lindex $v 5]
1028 set rowrangelist [lindex $v 6]
1029 set commitlisted [lindex $v 7]
1030 if {$phase eq {}} {
1031 set numcommits [llength $displayorder]
1032 catch {unset idrowranges}
1033 catch {unset children}
1034 } else {
1035 unflatten children [lindex $v 8]
1036 unflatten idrowranges [lindex $v 9]
1037 unflatten idinlist [lindex $v 10]
1038 set commitidx [lindex $v 11]
1039 set rowlaidout [lindex $v 12]
1040 set rowoptim [lindex $v 13]
1041 set numcommits [lindex $v 14]
1042 set linesegends [lindex $v 15]
1043 set leftover [lindex $v 16]
1044 set commfd [lindex $v 17]
1045 fileevent $commfd readable [list getcommitlines $commfd]
1046 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1049 catch {unset colormap}
1050 catch {unset rowtextx}
1051 catch {unset commitrow}
1052 set curview $n
1053 set row 0
1054 foreach id $displayorder {
1055 set commitrow($id) $row
1056 incr row
1058 setcanvscroll
1059 set yf 0
1060 set row 0
1061 if {$selid ne {} && [info exists commitrow($selid)]} {
1062 set row $commitrow($selid)
1063 # try to get the selected row in the same position on the screen
1064 set ymax [lindex [$canv cget -scrollregion] 3]
1065 set ytop [expr {[yc $row] - $yscreen}]
1066 if {$ytop < 0} {
1067 set ytop 0
1069 set yf [expr {$ytop * 1.0 / $ymax}]
1071 allcanvs yview moveto $yf
1072 drawvisible
1073 selectline $row 0
1074 if {$phase eq {}} {
1075 global maincursor textcursor
1076 . config -cursor $maincursor
1077 settextcursor $textcursor
1078 } else {
1079 . config -cursor watch
1080 settextcursor watch
1081 if {$phase eq "getcommits"} {
1082 global mainfont
1083 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1084 -font $mainfont -tags textitems
1089 proc shortids {ids} {
1090 set res {}
1091 foreach id $ids {
1092 if {[llength $id] > 1} {
1093 lappend res [shortids $id]
1094 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1095 lappend res [string range $id 0 7]
1096 } else {
1097 lappend res $id
1100 return $res
1103 proc incrange {l x o} {
1104 set n [llength $l]
1105 while {$x < $n} {
1106 set e [lindex $l $x]
1107 if {$e ne {}} {
1108 lset l $x [expr {$e + $o}]
1110 incr x
1112 return $l
1115 proc ntimes {n o} {
1116 set ret {}
1117 for {} {$n > 0} {incr n -1} {
1118 lappend ret $o
1120 return $ret
1123 proc usedinrange {id l1 l2} {
1124 global children commitrow childlist
1126 if {[info exists commitrow($id)]} {
1127 set r $commitrow($id)
1128 if {$l1 <= $r && $r <= $l2} {
1129 return [expr {$r - $l1 + 1}]
1131 set kids [lindex $childlist $r]
1132 } else {
1133 set kids $children($id)
1135 foreach c $kids {
1136 set r $commitrow($c)
1137 if {$l1 <= $r && $r <= $l2} {
1138 return [expr {$r - $l1 + 1}]
1141 return 0
1144 proc sanity {row {full 0}} {
1145 global rowidlist rowoffsets
1147 set col -1
1148 set ids [lindex $rowidlist $row]
1149 foreach id $ids {
1150 incr col
1151 if {$id eq {}} continue
1152 if {$col < [llength $ids] - 1 &&
1153 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1154 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1156 set o [lindex $rowoffsets $row $col]
1157 set y $row
1158 set x $col
1159 while {$o ne {}} {
1160 incr y -1
1161 incr x $o
1162 if {[lindex $rowidlist $y $x] != $id} {
1163 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1164 puts " id=[shortids $id] check started at row $row"
1165 for {set i $row} {$i >= $y} {incr i -1} {
1166 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1168 break
1170 if {!$full} break
1171 set o [lindex $rowoffsets $y $x]
1176 proc makeuparrow {oid x y z} {
1177 global rowidlist rowoffsets uparrowlen idrowranges
1179 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1180 incr y -1
1181 incr x $z
1182 set off0 [lindex $rowoffsets $y]
1183 for {set x0 $x} {1} {incr x0} {
1184 if {$x0 >= [llength $off0]} {
1185 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1186 break
1188 set z [lindex $off0 $x0]
1189 if {$z ne {}} {
1190 incr x0 $z
1191 break
1194 set z [expr {$x0 - $x}]
1195 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1196 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1198 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1199 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1200 lappend idrowranges($oid) $y
1203 proc initlayout {} {
1204 global rowidlist rowoffsets displayorder commitlisted
1205 global rowlaidout rowoptim
1206 global idinlist rowchk rowrangelist idrowranges
1207 global commitidx numcommits canvxmax canv
1208 global nextcolor
1209 global parentlist childlist children
1210 global colormap rowtextx commitrow
1211 global linesegends
1213 set commitidx 0
1214 set numcommits 0
1215 set displayorder {}
1216 set commitlisted {}
1217 set parentlist {}
1218 set childlist {}
1219 set rowrangelist {}
1220 catch {unset children}
1221 set nextcolor 0
1222 set rowidlist {{}}
1223 set rowoffsets {{}}
1224 catch {unset idinlist}
1225 catch {unset rowchk}
1226 set rowlaidout 0
1227 set rowoptim 0
1228 set canvxmax [$canv cget -width]
1229 catch {unset colormap}
1230 catch {unset rowtextx}
1231 catch {unset commitrow}
1232 catch {unset idrowranges}
1233 set linesegends {}
1236 proc setcanvscroll {} {
1237 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1239 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1240 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1241 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1242 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1245 proc visiblerows {} {
1246 global canv numcommits linespc
1248 set ymax [lindex [$canv cget -scrollregion] 3]
1249 if {$ymax eq {} || $ymax == 0} return
1250 set f [$canv yview]
1251 set y0 [expr {int([lindex $f 0] * $ymax)}]
1252 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1253 if {$r0 < 0} {
1254 set r0 0
1256 set y1 [expr {int([lindex $f 1] * $ymax)}]
1257 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1258 if {$r1 >= $numcommits} {
1259 set r1 [expr {$numcommits - 1}]
1261 return [list $r0 $r1]
1264 proc layoutmore {} {
1265 global rowlaidout rowoptim commitidx numcommits optim_delay
1266 global uparrowlen
1268 set row $rowlaidout
1269 set rowlaidout [layoutrows $row $commitidx 0]
1270 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1271 if {$orow > $rowoptim} {
1272 optimize_rows $rowoptim 0 $orow
1273 set rowoptim $orow
1275 set canshow [expr {$rowoptim - $optim_delay}]
1276 if {$canshow > $numcommits} {
1277 showstuff $canshow
1281 proc showstuff {canshow} {
1282 global numcommits commitrow pending_select selectedline
1283 global linesegends idrowranges idrangedrawn
1285 if {$numcommits == 0} {
1286 global phase
1287 set phase "incrdraw"
1288 allcanvs delete all
1290 set row $numcommits
1291 set numcommits $canshow
1292 setcanvscroll
1293 set rows [visiblerows]
1294 set r0 [lindex $rows 0]
1295 set r1 [lindex $rows 1]
1296 set selrow -1
1297 for {set r $row} {$r < $canshow} {incr r} {
1298 foreach id [lindex $linesegends [expr {$r+1}]] {
1299 set i -1
1300 foreach {s e} [rowranges $id] {
1301 incr i
1302 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1303 && ![info exists idrangedrawn($id,$i)]} {
1304 drawlineseg $id $i
1305 set idrangedrawn($id,$i) 1
1310 if {$canshow > $r1} {
1311 set canshow $r1
1313 while {$row < $canshow} {
1314 drawcmitrow $row
1315 incr row
1317 if {[info exists pending_select] &&
1318 [info exists commitrow($pending_select)] &&
1319 $commitrow($pending_select) < $numcommits} {
1320 selectline $commitrow($pending_select) 1
1322 if {![info exists selectedline] && ![info exists pending_select]} {
1323 selectline 0 1
1327 proc layoutrows {row endrow last} {
1328 global rowidlist rowoffsets displayorder
1329 global uparrowlen downarrowlen maxwidth mingaplen
1330 global childlist parentlist
1331 global idrowranges linesegends
1332 global commitidx
1333 global idinlist rowchk rowrangelist
1335 set idlist [lindex $rowidlist $row]
1336 set offs [lindex $rowoffsets $row]
1337 while {$row < $endrow} {
1338 set id [lindex $displayorder $row]
1339 set oldolds {}
1340 set newolds {}
1341 foreach p [lindex $parentlist $row] {
1342 if {![info exists idinlist($p)]} {
1343 lappend newolds $p
1344 } elseif {!$idinlist($p)} {
1345 lappend oldolds $p
1348 set lse {}
1349 set nev [expr {[llength $idlist] + [llength $newolds]
1350 + [llength $oldolds] - $maxwidth + 1}]
1351 if {$nev > 0} {
1352 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1353 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1354 set i [lindex $idlist $x]
1355 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1356 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1357 [expr {$row + $uparrowlen + $mingaplen}]]
1358 if {$r == 0} {
1359 set idlist [lreplace $idlist $x $x]
1360 set offs [lreplace $offs $x $x]
1361 set offs [incrange $offs $x 1]
1362 set idinlist($i) 0
1363 set rm1 [expr {$row - 1}]
1364 lappend lse $i
1365 lappend idrowranges($i) $rm1
1366 if {[incr nev -1] <= 0} break
1367 continue
1369 set rowchk($id) [expr {$row + $r}]
1372 lset rowidlist $row $idlist
1373 lset rowoffsets $row $offs
1375 lappend linesegends $lse
1376 set col [lsearch -exact $idlist $id]
1377 if {$col < 0} {
1378 set col [llength $idlist]
1379 lappend idlist $id
1380 lset rowidlist $row $idlist
1381 set z {}
1382 if {[lindex $childlist $row] ne {}} {
1383 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1384 unset idinlist($id)
1386 lappend offs $z
1387 lset rowoffsets $row $offs
1388 if {$z ne {}} {
1389 makeuparrow $id $col $row $z
1391 } else {
1392 unset idinlist($id)
1394 set ranges {}
1395 if {[info exists idrowranges($id)]} {
1396 set ranges $idrowranges($id)
1397 lappend ranges $row
1398 unset idrowranges($id)
1400 lappend rowrangelist $ranges
1401 incr row
1402 set offs [ntimes [llength $idlist] 0]
1403 set l [llength $newolds]
1404 set idlist [eval lreplace \$idlist $col $col $newolds]
1405 set o 0
1406 if {$l != 1} {
1407 set offs [lrange $offs 0 [expr {$col - 1}]]
1408 foreach x $newolds {
1409 lappend offs {}
1410 incr o -1
1412 incr o
1413 set tmp [expr {[llength $idlist] - [llength $offs]}]
1414 if {$tmp > 0} {
1415 set offs [concat $offs [ntimes $tmp $o]]
1417 } else {
1418 lset offs $col {}
1420 foreach i $newolds {
1421 set idinlist($i) 1
1422 set idrowranges($i) $row
1424 incr col $l
1425 foreach oid $oldolds {
1426 set idinlist($oid) 1
1427 set idlist [linsert $idlist $col $oid]
1428 set offs [linsert $offs $col $o]
1429 makeuparrow $oid $col $row $o
1430 incr col
1432 lappend rowidlist $idlist
1433 lappend rowoffsets $offs
1435 return $row
1438 proc addextraid {id row} {
1439 global displayorder commitrow commitinfo
1440 global commitidx commitlisted
1441 global parentlist childlist children
1443 incr commitidx
1444 lappend displayorder $id
1445 lappend commitlisted 0
1446 lappend parentlist {}
1447 set commitrow($id) $row
1448 readcommit $id
1449 if {![info exists commitinfo($id)]} {
1450 set commitinfo($id) {"No commit information available"}
1452 if {[info exists children($id)]} {
1453 lappend childlist $children($id)
1454 unset children($id)
1455 } else {
1456 lappend childlist {}
1460 proc layouttail {} {
1461 global rowidlist rowoffsets idinlist commitidx
1462 global idrowranges rowrangelist
1464 set row $commitidx
1465 set idlist [lindex $rowidlist $row]
1466 while {$idlist ne {}} {
1467 set col [expr {[llength $idlist] - 1}]
1468 set id [lindex $idlist $col]
1469 addextraid $id $row
1470 unset idinlist($id)
1471 lappend idrowranges($id) $row
1472 lappend rowrangelist $idrowranges($id)
1473 unset idrowranges($id)
1474 incr row
1475 set offs [ntimes $col 0]
1476 set idlist [lreplace $idlist $col $col]
1477 lappend rowidlist $idlist
1478 lappend rowoffsets $offs
1481 foreach id [array names idinlist] {
1482 addextraid $id $row
1483 lset rowidlist $row [list $id]
1484 lset rowoffsets $row 0
1485 makeuparrow $id 0 $row 0
1486 lappend idrowranges($id) $row
1487 lappend rowrangelist $idrowranges($id)
1488 unset idrowranges($id)
1489 incr row
1490 lappend rowidlist {}
1491 lappend rowoffsets {}
1495 proc insert_pad {row col npad} {
1496 global rowidlist rowoffsets
1498 set pad [ntimes $npad {}]
1499 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1500 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1501 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1504 proc optimize_rows {row col endrow} {
1505 global rowidlist rowoffsets idrowranges displayorder
1507 for {} {$row < $endrow} {incr row} {
1508 set idlist [lindex $rowidlist $row]
1509 set offs [lindex $rowoffsets $row]
1510 set haspad 0
1511 for {} {$col < [llength $offs]} {incr col} {
1512 if {[lindex $idlist $col] eq {}} {
1513 set haspad 1
1514 continue
1516 set z [lindex $offs $col]
1517 if {$z eq {}} continue
1518 set isarrow 0
1519 set x0 [expr {$col + $z}]
1520 set y0 [expr {$row - 1}]
1521 set z0 [lindex $rowoffsets $y0 $x0]
1522 if {$z0 eq {}} {
1523 set id [lindex $idlist $col]
1524 set ranges [rowranges $id]
1525 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1526 set isarrow 1
1529 if {$z < -1 || ($z < 0 && $isarrow)} {
1530 set npad [expr {-1 - $z + $isarrow}]
1531 set offs [incrange $offs $col $npad]
1532 insert_pad $y0 $x0 $npad
1533 if {$y0 > 0} {
1534 optimize_rows $y0 $x0 $row
1536 set z [lindex $offs $col]
1537 set x0 [expr {$col + $z}]
1538 set z0 [lindex $rowoffsets $y0 $x0]
1539 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1540 set npad [expr {$z - 1 + $isarrow}]
1541 set y1 [expr {$row + 1}]
1542 set offs2 [lindex $rowoffsets $y1]
1543 set x1 -1
1544 foreach z $offs2 {
1545 incr x1
1546 if {$z eq {} || $x1 + $z < $col} continue
1547 if {$x1 + $z > $col} {
1548 incr npad
1550 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1551 break
1553 set pad [ntimes $npad {}]
1554 set idlist [eval linsert \$idlist $col $pad]
1555 set tmp [eval linsert \$offs $col $pad]
1556 incr col $npad
1557 set offs [incrange $tmp $col [expr {-$npad}]]
1558 set z [lindex $offs $col]
1559 set haspad 1
1561 if {$z0 eq {} && !$isarrow} {
1562 # this line links to its first child on row $row-2
1563 set rm2 [expr {$row - 2}]
1564 set id [lindex $displayorder $rm2]
1565 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1566 if {$xc >= 0} {
1567 set z0 [expr {$xc - $x0}]
1570 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1571 insert_pad $y0 $x0 1
1572 set offs [incrange $offs $col 1]
1573 optimize_rows $y0 [expr {$x0 + 1}] $row
1576 if {!$haspad} {
1577 set o {}
1578 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1579 set o [lindex $offs $col]
1580 if {$o eq {}} {
1581 # check if this is the link to the first child
1582 set id [lindex $idlist $col]
1583 set ranges [rowranges $id]
1584 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1585 # it is, work out offset to child
1586 set y0 [expr {$row - 1}]
1587 set id [lindex $displayorder $y0]
1588 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1589 if {$x0 >= 0} {
1590 set o [expr {$x0 - $col}]
1594 if {$o eq {} || $o <= 0} break
1596 if {$o ne {} && [incr col] < [llength $idlist]} {
1597 set y1 [expr {$row + 1}]
1598 set offs2 [lindex $rowoffsets $y1]
1599 set x1 -1
1600 foreach z $offs2 {
1601 incr x1
1602 if {$z eq {} || $x1 + $z < $col} continue
1603 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1604 break
1606 set idlist [linsert $idlist $col {}]
1607 set tmp [linsert $offs $col {}]
1608 incr col
1609 set offs [incrange $tmp $col -1]
1612 lset rowidlist $row $idlist
1613 lset rowoffsets $row $offs
1614 set col 0
1618 proc xc {row col} {
1619 global canvx0 linespc
1620 return [expr {$canvx0 + $col * $linespc}]
1623 proc yc {row} {
1624 global canvy0 linespc
1625 return [expr {$canvy0 + $row * $linespc}]
1628 proc linewidth {id} {
1629 global thickerline lthickness
1631 set wid $lthickness
1632 if {[info exists thickerline] && $id eq $thickerline} {
1633 set wid [expr {2 * $lthickness}]
1635 return $wid
1638 proc rowranges {id} {
1639 global phase idrowranges commitrow rowlaidout rowrangelist
1641 set ranges {}
1642 if {$phase eq {} ||
1643 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1644 set ranges [lindex $rowrangelist $commitrow($id)]
1645 } elseif {[info exists idrowranges($id)]} {
1646 set ranges $idrowranges($id)
1648 return $ranges
1651 proc drawlineseg {id i} {
1652 global rowoffsets rowidlist
1653 global displayorder
1654 global canv colormap linespc
1655 global numcommits commitrow
1657 set ranges [rowranges $id]
1658 set downarrow 1
1659 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1660 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1661 } else {
1662 set downarrow 1
1664 set startrow [lindex $ranges [expr {2 * $i}]]
1665 set row [lindex $ranges [expr {2 * $i + 1}]]
1666 if {$startrow == $row} return
1667 assigncolor $id
1668 set coords {}
1669 set col [lsearch -exact [lindex $rowidlist $row] $id]
1670 if {$col < 0} {
1671 puts "oops: drawline: id $id not on row $row"
1672 return
1674 set lasto {}
1675 set ns 0
1676 while {1} {
1677 set o [lindex $rowoffsets $row $col]
1678 if {$o eq {}} break
1679 if {$o ne $lasto} {
1680 # changing direction
1681 set x [xc $row $col]
1682 set y [yc $row]
1683 lappend coords $x $y
1684 set lasto $o
1686 incr col $o
1687 incr row -1
1689 set x [xc $row $col]
1690 set y [yc $row]
1691 lappend coords $x $y
1692 if {$i == 0} {
1693 # draw the link to the first child as part of this line
1694 incr row -1
1695 set child [lindex $displayorder $row]
1696 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1697 if {$ccol >= 0} {
1698 set x [xc $row $ccol]
1699 set y [yc $row]
1700 if {$ccol < $col - 1} {
1701 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1702 } elseif {$ccol > $col + 1} {
1703 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1705 lappend coords $x $y
1708 if {[llength $coords] < 4} return
1709 if {$downarrow} {
1710 # This line has an arrow at the lower end: check if the arrow is
1711 # on a diagonal segment, and if so, work around the Tk 8.4
1712 # refusal to draw arrows on diagonal lines.
1713 set x0 [lindex $coords 0]
1714 set x1 [lindex $coords 2]
1715 if {$x0 != $x1} {
1716 set y0 [lindex $coords 1]
1717 set y1 [lindex $coords 3]
1718 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1719 # we have a nearby vertical segment, just trim off the diag bit
1720 set coords [lrange $coords 2 end]
1721 } else {
1722 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1723 set xi [expr {$x0 - $slope * $linespc / 2}]
1724 set yi [expr {$y0 - $linespc / 2}]
1725 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1729 set arrow [expr {2 * ($i > 0) + $downarrow}]
1730 set arrow [lindex {none first last both} $arrow]
1731 set t [$canv create line $coords -width [linewidth $id] \
1732 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1733 $canv lower $t
1734 bindline $t $id
1737 proc drawparentlinks {id row col olds} {
1738 global rowidlist canv colormap
1740 set row2 [expr {$row + 1}]
1741 set x [xc $row $col]
1742 set y [yc $row]
1743 set y2 [yc $row2]
1744 set ids [lindex $rowidlist $row2]
1745 # rmx = right-most X coord used
1746 set rmx 0
1747 foreach p $olds {
1748 set i [lsearch -exact $ids $p]
1749 if {$i < 0} {
1750 puts "oops, parent $p of $id not in list"
1751 continue
1753 set x2 [xc $row2 $i]
1754 if {$x2 > $rmx} {
1755 set rmx $x2
1757 set ranges [rowranges $p]
1758 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1759 && $row2 < [lindex $ranges 1]} {
1760 # drawlineseg will do this one for us
1761 continue
1763 assigncolor $p
1764 # should handle duplicated parents here...
1765 set coords [list $x $y]
1766 if {$i < $col - 1} {
1767 lappend coords [xc $row [expr {$i + 1}]] $y
1768 } elseif {$i > $col + 1} {
1769 lappend coords [xc $row [expr {$i - 1}]] $y
1771 lappend coords $x2 $y2
1772 set t [$canv create line $coords -width [linewidth $p] \
1773 -fill $colormap($p) -tags lines.$p]
1774 $canv lower $t
1775 bindline $t $p
1777 return $rmx
1780 proc drawlines {id} {
1781 global colormap canv
1782 global idrangedrawn
1783 global childlist iddrawn commitrow rowidlist
1785 $canv delete lines.$id
1786 set nr [expr {[llength [rowranges $id]] / 2}]
1787 for {set i 0} {$i < $nr} {incr i} {
1788 if {[info exists idrangedrawn($id,$i)]} {
1789 drawlineseg $id $i
1792 foreach child [lindex $childlist $commitrow($id)] {
1793 if {[info exists iddrawn($child)]} {
1794 set row $commitrow($child)
1795 set col [lsearch -exact [lindex $rowidlist $row] $child]
1796 if {$col >= 0} {
1797 drawparentlinks $child $row $col [list $id]
1803 proc drawcmittext {id row col rmx} {
1804 global linespc canv canv2 canv3 canvy0
1805 global commitlisted commitinfo rowidlist
1806 global rowtextx idpos idtags idheads idotherrefs
1807 global linehtag linentag linedtag
1808 global mainfont namefont canvxmax
1810 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1811 set x [xc $row $col]
1812 set y [yc $row]
1813 set orad [expr {$linespc / 3}]
1814 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1815 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1816 -fill $ofill -outline black -width 1]
1817 $canv raise $t
1818 $canv bind $t <1> {selcanvline {} %x %y}
1819 set xt [xc $row [llength [lindex $rowidlist $row]]]
1820 if {$xt < $rmx} {
1821 set xt $rmx
1823 set rowtextx($row) $xt
1824 set idpos($id) [list $x $xt $y]
1825 if {[info exists idtags($id)] || [info exists idheads($id)]
1826 || [info exists idotherrefs($id)]} {
1827 set xt [drawtags $id $x $xt $y]
1829 set headline [lindex $commitinfo($id) 0]
1830 set name [lindex $commitinfo($id) 1]
1831 set date [lindex $commitinfo($id) 2]
1832 set date [formatdate $date]
1833 set linehtag($row) [$canv create text $xt $y -anchor w \
1834 -text $headline -font $mainfont ]
1835 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1836 set linentag($row) [$canv2 create text 3 $y -anchor w \
1837 -text $name -font $namefont]
1838 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1839 -text $date -font $mainfont]
1840 set xr [expr {$xt + [font measure $mainfont $headline]}]
1841 if {$xr > $canvxmax} {
1842 set canvxmax $xr
1843 setcanvscroll
1847 proc drawcmitrow {row} {
1848 global displayorder rowidlist
1849 global idrangedrawn iddrawn
1850 global commitinfo parentlist numcommits
1852 if {$row >= $numcommits} return
1853 foreach id [lindex $rowidlist $row] {
1854 if {$id eq {}} continue
1855 set i -1
1856 foreach {s e} [rowranges $id] {
1857 incr i
1858 if {$row < $s} continue
1859 if {$e eq {}} break
1860 if {$row <= $e} {
1861 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1862 drawlineseg $id $i
1863 set idrangedrawn($id,$i) 1
1865 break
1870 set id [lindex $displayorder $row]
1871 if {[info exists iddrawn($id)]} return
1872 set col [lsearch -exact [lindex $rowidlist $row] $id]
1873 if {$col < 0} {
1874 puts "oops, row $row id $id not in list"
1875 return
1877 if {![info exists commitinfo($id)]} {
1878 getcommit $id
1880 assigncolor $id
1881 set olds [lindex $parentlist $row]
1882 if {$olds ne {}} {
1883 set rmx [drawparentlinks $id $row $col $olds]
1884 } else {
1885 set rmx 0
1887 drawcmittext $id $row $col $rmx
1888 set iddrawn($id) 1
1891 proc drawfrac {f0 f1} {
1892 global numcommits canv
1893 global linespc
1895 set ymax [lindex [$canv cget -scrollregion] 3]
1896 if {$ymax eq {} || $ymax == 0} return
1897 set y0 [expr {int($f0 * $ymax)}]
1898 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1899 if {$row < 0} {
1900 set row 0
1902 set y1 [expr {int($f1 * $ymax)}]
1903 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1904 if {$endrow >= $numcommits} {
1905 set endrow [expr {$numcommits - 1}]
1907 for {} {$row <= $endrow} {incr row} {
1908 drawcmitrow $row
1912 proc drawvisible {} {
1913 global canv
1914 eval drawfrac [$canv yview]
1917 proc clear_display {} {
1918 global iddrawn idrangedrawn
1920 allcanvs delete all
1921 catch {unset iddrawn}
1922 catch {unset idrangedrawn}
1925 proc findcrossings {id} {
1926 global rowidlist parentlist numcommits rowoffsets displayorder
1928 set cross {}
1929 set ccross {}
1930 foreach {s e} [rowranges $id] {
1931 if {$e >= $numcommits} {
1932 set e [expr {$numcommits - 1}]
1934 if {$e <= $s} continue
1935 set x [lsearch -exact [lindex $rowidlist $e] $id]
1936 if {$x < 0} {
1937 puts "findcrossings: oops, no [shortids $id] in row $e"
1938 continue
1940 for {set row $e} {[incr row -1] >= $s} {} {
1941 set olds [lindex $parentlist $row]
1942 set kid [lindex $displayorder $row]
1943 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1944 if {$kidx < 0} continue
1945 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1946 foreach p $olds {
1947 set px [lsearch -exact $nextrow $p]
1948 if {$px < 0} continue
1949 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1950 if {[lsearch -exact $ccross $p] >= 0} continue
1951 if {$x == $px + ($kidx < $px? -1: 1)} {
1952 lappend ccross $p
1953 } elseif {[lsearch -exact $cross $p] < 0} {
1954 lappend cross $p
1958 set inc [lindex $rowoffsets $row $x]
1959 if {$inc eq {}} break
1960 incr x $inc
1963 return [concat $ccross {{}} $cross]
1966 proc assigncolor {id} {
1967 global colormap colors nextcolor
1968 global commitrow parentlist children childlist
1970 if {[info exists colormap($id)]} return
1971 set ncolors [llength $colors]
1972 if {[info exists commitrow($id)]} {
1973 set kids [lindex $childlist $commitrow($id)]
1974 } elseif {[info exists children($id)]} {
1975 set kids $children($id)
1976 } else {
1977 set kids {}
1979 if {[llength $kids] == 1} {
1980 set child [lindex $kids 0]
1981 if {[info exists colormap($child)]
1982 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1983 set colormap($id) $colormap($child)
1984 return
1987 set badcolors {}
1988 set origbad {}
1989 foreach x [findcrossings $id] {
1990 if {$x eq {}} {
1991 # delimiter between corner crossings and other crossings
1992 if {[llength $badcolors] >= $ncolors - 1} break
1993 set origbad $badcolors
1995 if {[info exists colormap($x)]
1996 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1997 lappend badcolors $colormap($x)
2000 if {[llength $badcolors] >= $ncolors} {
2001 set badcolors $origbad
2003 set origbad $badcolors
2004 if {[llength $badcolors] < $ncolors - 1} {
2005 foreach child $kids {
2006 if {[info exists colormap($child)]
2007 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2008 lappend badcolors $colormap($child)
2010 foreach p [lindex $parentlist $commitrow($child)] {
2011 if {[info exists colormap($p)]
2012 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2013 lappend badcolors $colormap($p)
2017 if {[llength $badcolors] >= $ncolors} {
2018 set badcolors $origbad
2021 for {set i 0} {$i <= $ncolors} {incr i} {
2022 set c [lindex $colors $nextcolor]
2023 if {[incr nextcolor] >= $ncolors} {
2024 set nextcolor 0
2026 if {[lsearch -exact $badcolors $c]} break
2028 set colormap($id) $c
2031 proc bindline {t id} {
2032 global canv
2034 $canv bind $t <Enter> "lineenter %x %y $id"
2035 $canv bind $t <Motion> "linemotion %x %y $id"
2036 $canv bind $t <Leave> "lineleave $id"
2037 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2040 proc drawtags {id x xt y1} {
2041 global idtags idheads idotherrefs
2042 global linespc lthickness
2043 global canv mainfont commitrow rowtextx
2045 set marks {}
2046 set ntags 0
2047 set nheads 0
2048 if {[info exists idtags($id)]} {
2049 set marks $idtags($id)
2050 set ntags [llength $marks]
2052 if {[info exists idheads($id)]} {
2053 set marks [concat $marks $idheads($id)]
2054 set nheads [llength $idheads($id)]
2056 if {[info exists idotherrefs($id)]} {
2057 set marks [concat $marks $idotherrefs($id)]
2059 if {$marks eq {}} {
2060 return $xt
2063 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2064 set yt [expr {$y1 - 0.5 * $linespc}]
2065 set yb [expr {$yt + $linespc - 1}]
2066 set xvals {}
2067 set wvals {}
2068 foreach tag $marks {
2069 set wid [font measure $mainfont $tag]
2070 lappend xvals $xt
2071 lappend wvals $wid
2072 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2074 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2075 -width $lthickness -fill black -tags tag.$id]
2076 $canv lower $t
2077 foreach tag $marks x $xvals wid $wvals {
2078 set xl [expr {$x + $delta}]
2079 set xr [expr {$x + $delta + $wid + $lthickness}]
2080 if {[incr ntags -1] >= 0} {
2081 # draw a tag
2082 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2083 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2084 -width 1 -outline black -fill yellow -tags tag.$id]
2085 $canv bind $t <1> [list showtag $tag 1]
2086 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2087 } else {
2088 # draw a head or other ref
2089 if {[incr nheads -1] >= 0} {
2090 set col green
2091 } else {
2092 set col "#ddddff"
2094 set xl [expr {$xl - $delta/2}]
2095 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2096 -width 1 -outline black -fill $col -tags tag.$id
2097 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2098 set rwid [font measure $mainfont $remoteprefix]
2099 set xi [expr {$x + 1}]
2100 set yti [expr {$yt + 1}]
2101 set xri [expr {$x + $rwid}]
2102 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2103 -width 0 -fill "#ffddaa" -tags tag.$id
2106 set t [$canv create text $xl $y1 -anchor w -text $tag \
2107 -font $mainfont -tags tag.$id]
2108 if {$ntags >= 0} {
2109 $canv bind $t <1> [list showtag $tag 1]
2112 return $xt
2115 proc xcoord {i level ln} {
2116 global canvx0 xspc1 xspc2
2118 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2119 if {$i > 0 && $i == $level} {
2120 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2121 } elseif {$i > $level} {
2122 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2124 return $x
2127 proc finishcommits {} {
2128 global commitidx phase
2129 global canv mainfont ctext maincursor textcursor
2130 global findinprogress pending_select
2132 if {$commitidx > 0} {
2133 drawrest
2134 } else {
2135 $canv delete all
2136 $canv create text 3 3 -anchor nw -text "No commits selected" \
2137 -font $mainfont -tags textitems
2139 if {![info exists findinprogress]} {
2140 . config -cursor $maincursor
2141 settextcursor $textcursor
2143 set phase {}
2144 catch {unset pending_select}
2147 # Don't change the text pane cursor if it is currently the hand cursor,
2148 # showing that we are over a sha1 ID link.
2149 proc settextcursor {c} {
2150 global ctext curtextcursor
2152 if {[$ctext cget -cursor] == $curtextcursor} {
2153 $ctext config -cursor $c
2155 set curtextcursor $c
2158 proc drawrest {} {
2159 global numcommits
2160 global startmsecs
2161 global canvy0 numcommits linespc
2162 global rowlaidout commitidx
2163 global pending_select
2165 set row $rowlaidout
2166 layoutrows $rowlaidout $commitidx 1
2167 layouttail
2168 optimize_rows $row 0 $commitidx
2169 showstuff $commitidx
2170 if {[info exists pending_select]} {
2171 selectline 0 1
2174 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2175 #puts "overall $drawmsecs ms for $numcommits commits"
2178 proc findmatches {f} {
2179 global findtype foundstring foundstrlen
2180 if {$findtype == "Regexp"} {
2181 set matches [regexp -indices -all -inline $foundstring $f]
2182 } else {
2183 if {$findtype == "IgnCase"} {
2184 set str [string tolower $f]
2185 } else {
2186 set str $f
2188 set matches {}
2189 set i 0
2190 while {[set j [string first $foundstring $str $i]] >= 0} {
2191 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2192 set i [expr {$j + $foundstrlen}]
2195 return $matches
2198 proc dofind {} {
2199 global findtype findloc findstring markedmatches commitinfo
2200 global numcommits displayorder linehtag linentag linedtag
2201 global mainfont namefont canv canv2 canv3 selectedline
2202 global matchinglines foundstring foundstrlen matchstring
2203 global commitdata
2205 stopfindproc
2206 unmarkmatches
2207 focus .
2208 set matchinglines {}
2209 if {$findloc == "Pickaxe"} {
2210 findpatches
2211 return
2213 if {$findtype == "IgnCase"} {
2214 set foundstring [string tolower $findstring]
2215 } else {
2216 set foundstring $findstring
2218 set foundstrlen [string length $findstring]
2219 if {$foundstrlen == 0} return
2220 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2221 set matchstring "*$matchstring*"
2222 if {$findloc == "Files"} {
2223 findfiles
2224 return
2226 if {![info exists selectedline]} {
2227 set oldsel -1
2228 } else {
2229 set oldsel $selectedline
2231 set didsel 0
2232 set fldtypes {Headline Author Date Committer CDate Comment}
2233 set l -1
2234 foreach id $displayorder {
2235 set d $commitdata($id)
2236 incr l
2237 if {$findtype == "Regexp"} {
2238 set doesmatch [regexp $foundstring $d]
2239 } elseif {$findtype == "IgnCase"} {
2240 set doesmatch [string match -nocase $matchstring $d]
2241 } else {
2242 set doesmatch [string match $matchstring $d]
2244 if {!$doesmatch} continue
2245 if {![info exists commitinfo($id)]} {
2246 getcommit $id
2248 set info $commitinfo($id)
2249 set doesmatch 0
2250 foreach f $info ty $fldtypes {
2251 if {$findloc != "All fields" && $findloc != $ty} {
2252 continue
2254 set matches [findmatches $f]
2255 if {$matches == {}} continue
2256 set doesmatch 1
2257 if {$ty == "Headline"} {
2258 drawcmitrow $l
2259 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2260 } elseif {$ty == "Author"} {
2261 drawcmitrow $l
2262 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2263 } elseif {$ty == "Date"} {
2264 drawcmitrow $l
2265 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2268 if {$doesmatch} {
2269 lappend matchinglines $l
2270 if {!$didsel && $l > $oldsel} {
2271 findselectline $l
2272 set didsel 1
2276 if {$matchinglines == {}} {
2277 bell
2278 } elseif {!$didsel} {
2279 findselectline [lindex $matchinglines 0]
2283 proc findselectline {l} {
2284 global findloc commentend ctext
2285 selectline $l 1
2286 if {$findloc == "All fields" || $findloc == "Comments"} {
2287 # highlight the matches in the comments
2288 set f [$ctext get 1.0 $commentend]
2289 set matches [findmatches $f]
2290 foreach match $matches {
2291 set start [lindex $match 0]
2292 set end [expr {[lindex $match 1] + 1}]
2293 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2298 proc findnext {restart} {
2299 global matchinglines selectedline
2300 if {![info exists matchinglines]} {
2301 if {$restart} {
2302 dofind
2304 return
2306 if {![info exists selectedline]} return
2307 foreach l $matchinglines {
2308 if {$l > $selectedline} {
2309 findselectline $l
2310 return
2313 bell
2316 proc findprev {} {
2317 global matchinglines selectedline
2318 if {![info exists matchinglines]} {
2319 dofind
2320 return
2322 if {![info exists selectedline]} return
2323 set prev {}
2324 foreach l $matchinglines {
2325 if {$l >= $selectedline} break
2326 set prev $l
2328 if {$prev != {}} {
2329 findselectline $prev
2330 } else {
2331 bell
2335 proc findlocchange {name ix op} {
2336 global findloc findtype findtypemenu
2337 if {$findloc == "Pickaxe"} {
2338 set findtype Exact
2339 set state disabled
2340 } else {
2341 set state normal
2343 $findtypemenu entryconf 1 -state $state
2344 $findtypemenu entryconf 2 -state $state
2347 proc stopfindproc {{done 0}} {
2348 global findprocpid findprocfile findids
2349 global ctext findoldcursor phase maincursor textcursor
2350 global findinprogress
2352 catch {unset findids}
2353 if {[info exists findprocpid]} {
2354 if {!$done} {
2355 catch {exec kill $findprocpid}
2357 catch {close $findprocfile}
2358 unset findprocpid
2360 if {[info exists findinprogress]} {
2361 unset findinprogress
2362 if {$phase eq {}} {
2363 . config -cursor $maincursor
2364 settextcursor $textcursor
2369 proc findpatches {} {
2370 global findstring selectedline numcommits
2371 global findprocpid findprocfile
2372 global finddidsel ctext displayorder findinprogress
2373 global findinsertpos
2375 if {$numcommits == 0} return
2377 # make a list of all the ids to search, starting at the one
2378 # after the selected line (if any)
2379 if {[info exists selectedline]} {
2380 set l $selectedline
2381 } else {
2382 set l -1
2384 set inputids {}
2385 for {set i 0} {$i < $numcommits} {incr i} {
2386 if {[incr l] >= $numcommits} {
2387 set l 0
2389 append inputids [lindex $displayorder $l] "\n"
2392 if {[catch {
2393 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2394 << $inputids] r]
2395 } err]} {
2396 error_popup "Error starting search process: $err"
2397 return
2400 set findinsertpos end
2401 set findprocfile $f
2402 set findprocpid [pid $f]
2403 fconfigure $f -blocking 0
2404 fileevent $f readable readfindproc
2405 set finddidsel 0
2406 . config -cursor watch
2407 settextcursor watch
2408 set findinprogress 1
2411 proc readfindproc {} {
2412 global findprocfile finddidsel
2413 global commitrow matchinglines findinsertpos
2415 set n [gets $findprocfile line]
2416 if {$n < 0} {
2417 if {[eof $findprocfile]} {
2418 stopfindproc 1
2419 if {!$finddidsel} {
2420 bell
2423 return
2425 if {![regexp {^[0-9a-f]{40}} $line id]} {
2426 error_popup "Can't parse git-diff-tree output: $line"
2427 stopfindproc
2428 return
2430 if {![info exists commitrow($id)]} {
2431 puts stderr "spurious id: $id"
2432 return
2434 set l $commitrow($id)
2435 insertmatch $l $id
2438 proc insertmatch {l id} {
2439 global matchinglines findinsertpos finddidsel
2441 if {$findinsertpos == "end"} {
2442 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2443 set matchinglines [linsert $matchinglines 0 $l]
2444 set findinsertpos 1
2445 } else {
2446 lappend matchinglines $l
2448 } else {
2449 set matchinglines [linsert $matchinglines $findinsertpos $l]
2450 incr findinsertpos
2452 markheadline $l $id
2453 if {!$finddidsel} {
2454 findselectline $l
2455 set finddidsel 1
2459 proc findfiles {} {
2460 global selectedline numcommits displayorder ctext
2461 global ffileline finddidsel parentlist
2462 global findinprogress findstartline findinsertpos
2463 global treediffs fdiffid fdiffsneeded fdiffpos
2464 global findmergefiles
2466 if {$numcommits == 0} return
2468 if {[info exists selectedline]} {
2469 set l [expr {$selectedline + 1}]
2470 } else {
2471 set l 0
2473 set ffileline $l
2474 set findstartline $l
2475 set diffsneeded {}
2476 set fdiffsneeded {}
2477 while 1 {
2478 set id [lindex $displayorder $l]
2479 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2480 if {![info exists treediffs($id)]} {
2481 append diffsneeded "$id\n"
2482 lappend fdiffsneeded $id
2485 if {[incr l] >= $numcommits} {
2486 set l 0
2488 if {$l == $findstartline} break
2491 # start off a git-diff-tree process if needed
2492 if {$diffsneeded ne {}} {
2493 if {[catch {
2494 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2495 } err ]} {
2496 error_popup "Error starting search process: $err"
2497 return
2499 catch {unset fdiffid}
2500 set fdiffpos 0
2501 fconfigure $df -blocking 0
2502 fileevent $df readable [list readfilediffs $df]
2505 set finddidsel 0
2506 set findinsertpos end
2507 set id [lindex $displayorder $l]
2508 . config -cursor watch
2509 settextcursor watch
2510 set findinprogress 1
2511 findcont
2512 update
2515 proc readfilediffs {df} {
2516 global findid fdiffid fdiffs
2518 set n [gets $df line]
2519 if {$n < 0} {
2520 if {[eof $df]} {
2521 donefilediff
2522 if {[catch {close $df} err]} {
2523 stopfindproc
2524 bell
2525 error_popup "Error in git-diff-tree: $err"
2526 } elseif {[info exists findid]} {
2527 set id $findid
2528 stopfindproc
2529 bell
2530 error_popup "Couldn't find diffs for $id"
2533 return
2535 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2536 # start of a new string of diffs
2537 donefilediff
2538 set fdiffid $id
2539 set fdiffs {}
2540 } elseif {[string match ":*" $line]} {
2541 lappend fdiffs [lindex $line 5]
2545 proc donefilediff {} {
2546 global fdiffid fdiffs treediffs findid
2547 global fdiffsneeded fdiffpos
2549 if {[info exists fdiffid]} {
2550 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2551 && $fdiffpos < [llength $fdiffsneeded]} {
2552 # git-diff-tree doesn't output anything for a commit
2553 # which doesn't change anything
2554 set nullid [lindex $fdiffsneeded $fdiffpos]
2555 set treediffs($nullid) {}
2556 if {[info exists findid] && $nullid eq $findid} {
2557 unset findid
2558 findcont
2560 incr fdiffpos
2562 incr fdiffpos
2564 if {![info exists treediffs($fdiffid)]} {
2565 set treediffs($fdiffid) $fdiffs
2567 if {[info exists findid] && $fdiffid eq $findid} {
2568 unset findid
2569 findcont
2574 proc findcont {} {
2575 global findid treediffs parentlist
2576 global ffileline findstartline finddidsel
2577 global displayorder numcommits matchinglines findinprogress
2578 global findmergefiles
2580 set l $ffileline
2581 while {1} {
2582 set id [lindex $displayorder $l]
2583 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2584 if {![info exists treediffs($id)]} {
2585 set findid $id
2586 set ffileline $l
2587 return
2589 set doesmatch 0
2590 foreach f $treediffs($id) {
2591 set x [findmatches $f]
2592 if {$x != {}} {
2593 set doesmatch 1
2594 break
2597 if {$doesmatch} {
2598 insertmatch $l $id
2601 if {[incr l] >= $numcommits} {
2602 set l 0
2604 if {$l == $findstartline} break
2606 stopfindproc
2607 if {!$finddidsel} {
2608 bell
2612 # mark a commit as matching by putting a yellow background
2613 # behind the headline
2614 proc markheadline {l id} {
2615 global canv mainfont linehtag
2617 drawcmitrow $l
2618 set bbox [$canv bbox $linehtag($l)]
2619 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2620 $canv lower $t
2623 # mark the bits of a headline, author or date that match a find string
2624 proc markmatches {canv l str tag matches font} {
2625 set bbox [$canv bbox $tag]
2626 set x0 [lindex $bbox 0]
2627 set y0 [lindex $bbox 1]
2628 set y1 [lindex $bbox 3]
2629 foreach match $matches {
2630 set start [lindex $match 0]
2631 set end [lindex $match 1]
2632 if {$start > $end} continue
2633 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2634 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2635 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2636 [expr {$x0+$xlen+2}] $y1 \
2637 -outline {} -tags matches -fill yellow]
2638 $canv lower $t
2642 proc unmarkmatches {} {
2643 global matchinglines findids
2644 allcanvs delete matches
2645 catch {unset matchinglines}
2646 catch {unset findids}
2649 proc selcanvline {w x y} {
2650 global canv canvy0 ctext linespc
2651 global rowtextx
2652 set ymax [lindex [$canv cget -scrollregion] 3]
2653 if {$ymax == {}} return
2654 set yfrac [lindex [$canv yview] 0]
2655 set y [expr {$y + $yfrac * $ymax}]
2656 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2657 if {$l < 0} {
2658 set l 0
2660 if {$w eq $canv} {
2661 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2663 unmarkmatches
2664 selectline $l 1
2667 proc commit_descriptor {p} {
2668 global commitinfo
2669 set l "..."
2670 if {[info exists commitinfo($p)]} {
2671 set l [lindex $commitinfo($p) 0]
2673 return "$p ($l)"
2676 # append some text to the ctext widget, and make any SHA1 ID
2677 # that we know about be a clickable link.
2678 proc appendwithlinks {text} {
2679 global ctext commitrow linknum
2681 set start [$ctext index "end - 1c"]
2682 $ctext insert end $text
2683 $ctext insert end "\n"
2684 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2685 foreach l $links {
2686 set s [lindex $l 0]
2687 set e [lindex $l 1]
2688 set linkid [string range $text $s $e]
2689 if {![info exists commitrow($linkid)]} continue
2690 incr e
2691 $ctext tag add link "$start + $s c" "$start + $e c"
2692 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2693 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2694 incr linknum
2696 $ctext tag conf link -foreground blue -underline 1
2697 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2698 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2701 proc viewnextline {dir} {
2702 global canv linespc
2704 $canv delete hover
2705 set ymax [lindex [$canv cget -scrollregion] 3]
2706 set wnow [$canv yview]
2707 set wtop [expr {[lindex $wnow 0] * $ymax}]
2708 set newtop [expr {$wtop + $dir * $linespc}]
2709 if {$newtop < 0} {
2710 set newtop 0
2711 } elseif {$newtop > $ymax} {
2712 set newtop $ymax
2714 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2717 proc selectline {l isnew} {
2718 global canv canv2 canv3 ctext commitinfo selectedline
2719 global displayorder linehtag linentag linedtag
2720 global canvy0 linespc parentlist childlist
2721 global cflist currentid sha1entry
2722 global commentend idtags linknum
2723 global mergemax numcommits pending_select
2725 catch {unset pending_select}
2726 $canv delete hover
2727 normalline
2728 if {$l < 0 || $l >= $numcommits} return
2729 set y [expr {$canvy0 + $l * $linespc}]
2730 set ymax [lindex [$canv cget -scrollregion] 3]
2731 set ytop [expr {$y - $linespc - 1}]
2732 set ybot [expr {$y + $linespc + 1}]
2733 set wnow [$canv yview]
2734 set wtop [expr {[lindex $wnow 0] * $ymax}]
2735 set wbot [expr {[lindex $wnow 1] * $ymax}]
2736 set wh [expr {$wbot - $wtop}]
2737 set newtop $wtop
2738 if {$ytop < $wtop} {
2739 if {$ybot < $wtop} {
2740 set newtop [expr {$y - $wh / 2.0}]
2741 } else {
2742 set newtop $ytop
2743 if {$newtop > $wtop - $linespc} {
2744 set newtop [expr {$wtop - $linespc}]
2747 } elseif {$ybot > $wbot} {
2748 if {$ytop > $wbot} {
2749 set newtop [expr {$y - $wh / 2.0}]
2750 } else {
2751 set newtop [expr {$ybot - $wh}]
2752 if {$newtop < $wtop + $linespc} {
2753 set newtop [expr {$wtop + $linespc}]
2757 if {$newtop != $wtop} {
2758 if {$newtop < 0} {
2759 set newtop 0
2761 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2762 drawvisible
2765 if {![info exists linehtag($l)]} return
2766 $canv delete secsel
2767 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2768 -tags secsel -fill [$canv cget -selectbackground]]
2769 $canv lower $t
2770 $canv2 delete secsel
2771 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2772 -tags secsel -fill [$canv2 cget -selectbackground]]
2773 $canv2 lower $t
2774 $canv3 delete secsel
2775 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2776 -tags secsel -fill [$canv3 cget -selectbackground]]
2777 $canv3 lower $t
2779 if {$isnew} {
2780 addtohistory [list selectline $l 0]
2783 set selectedline $l
2785 set id [lindex $displayorder $l]
2786 set currentid $id
2787 $sha1entry delete 0 end
2788 $sha1entry insert 0 $id
2789 $sha1entry selection from 0
2790 $sha1entry selection to end
2792 $ctext conf -state normal
2793 $ctext delete 0.0 end
2794 set linknum 0
2795 $ctext mark set fmark.0 0.0
2796 $ctext mark gravity fmark.0 left
2797 set info $commitinfo($id)
2798 set date [formatdate [lindex $info 2]]
2799 $ctext insert end "Author: [lindex $info 1] $date\n"
2800 set date [formatdate [lindex $info 4]]
2801 $ctext insert end "Committer: [lindex $info 3] $date\n"
2802 if {[info exists idtags($id)]} {
2803 $ctext insert end "Tags:"
2804 foreach tag $idtags($id) {
2805 $ctext insert end " $tag"
2807 $ctext insert end "\n"
2810 set comment {}
2811 set olds [lindex $parentlist $l]
2812 if {[llength $olds] > 1} {
2813 set np 0
2814 foreach p $olds {
2815 if {$np >= $mergemax} {
2816 set tag mmax
2817 } else {
2818 set tag m$np
2820 $ctext insert end "Parent: " $tag
2821 appendwithlinks [commit_descriptor $p]
2822 incr np
2824 } else {
2825 foreach p $olds {
2826 append comment "Parent: [commit_descriptor $p]\n"
2830 foreach c [lindex $childlist $l] {
2831 append comment "Child: [commit_descriptor $c]\n"
2833 append comment "\n"
2834 append comment [lindex $info 5]
2836 # make anything that looks like a SHA1 ID be a clickable link
2837 appendwithlinks $comment
2839 $ctext tag delete Comments
2840 $ctext tag remove found 1.0 end
2841 $ctext conf -state disabled
2842 set commentend [$ctext index "end - 1c"]
2844 $cflist delete 0 end
2845 $cflist insert end "Comments"
2846 if {[llength $olds] <= 1} {
2847 startdiff $id
2848 } else {
2849 mergediff $id $l
2853 proc selfirstline {} {
2854 unmarkmatches
2855 selectline 0 1
2858 proc sellastline {} {
2859 global numcommits
2860 unmarkmatches
2861 set l [expr {$numcommits - 1}]
2862 selectline $l 1
2865 proc selnextline {dir} {
2866 global selectedline
2867 if {![info exists selectedline]} return
2868 set l [expr {$selectedline + $dir}]
2869 unmarkmatches
2870 selectline $l 1
2873 proc selnextpage {dir} {
2874 global canv linespc selectedline numcommits
2876 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2877 if {$lpp < 1} {
2878 set lpp 1
2880 allcanvs yview scroll [expr {$dir * $lpp}] units
2881 if {![info exists selectedline]} return
2882 set l [expr {$selectedline + $dir * $lpp}]
2883 if {$l < 0} {
2884 set l 0
2885 } elseif {$l >= $numcommits} {
2886 set l [expr $numcommits - 1]
2888 unmarkmatches
2889 selectline $l 1
2892 proc unselectline {} {
2893 global selectedline currentid
2895 catch {unset selectedline}
2896 catch {unset currentid}
2897 allcanvs delete secsel
2900 proc addtohistory {cmd} {
2901 global history historyindex curview
2903 set elt [list $curview $cmd]
2904 if {$historyindex > 0
2905 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2906 return
2909 if {$historyindex < [llength $history]} {
2910 set history [lreplace $history $historyindex end $elt]
2911 } else {
2912 lappend history $elt
2914 incr historyindex
2915 if {$historyindex > 1} {
2916 .ctop.top.bar.leftbut conf -state normal
2917 } else {
2918 .ctop.top.bar.leftbut conf -state disabled
2920 .ctop.top.bar.rightbut conf -state disabled
2923 proc godo {elt} {
2924 global curview
2926 set view [lindex $elt 0]
2927 set cmd [lindex $elt 1]
2928 if {$curview != $view} {
2929 showview $view
2931 eval $cmd
2934 proc goback {} {
2935 global history historyindex
2937 if {$historyindex > 1} {
2938 incr historyindex -1
2939 godo [lindex $history [expr {$historyindex - 1}]]
2940 .ctop.top.bar.rightbut conf -state normal
2942 if {$historyindex <= 1} {
2943 .ctop.top.bar.leftbut conf -state disabled
2947 proc goforw {} {
2948 global history historyindex
2950 if {$historyindex < [llength $history]} {
2951 set cmd [lindex $history $historyindex]
2952 incr historyindex
2953 godo $cmd
2954 .ctop.top.bar.leftbut conf -state normal
2956 if {$historyindex >= [llength $history]} {
2957 .ctop.top.bar.rightbut conf -state disabled
2961 proc mergediff {id l} {
2962 global diffmergeid diffopts mdifffd
2963 global difffilestart diffids
2964 global parentlist
2966 set diffmergeid $id
2967 set diffids $id
2968 catch {unset difffilestart}
2969 # this doesn't seem to actually affect anything...
2970 set env(GIT_DIFF_OPTS) $diffopts
2971 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2972 if {[catch {set mdf [open $cmd r]} err]} {
2973 error_popup "Error getting merge diffs: $err"
2974 return
2976 fconfigure $mdf -blocking 0
2977 set mdifffd($id) $mdf
2978 set np [llength [lindex $parentlist $l]]
2979 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2980 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2983 proc getmergediffline {mdf id np} {
2984 global diffmergeid ctext cflist nextupdate mergemax
2985 global difffilestart mdifffd
2987 set n [gets $mdf line]
2988 if {$n < 0} {
2989 if {[eof $mdf]} {
2990 close $mdf
2992 return
2994 if {![info exists diffmergeid] || $id != $diffmergeid
2995 || $mdf != $mdifffd($id)} {
2996 return
2998 $ctext conf -state normal
2999 if {[regexp {^diff --cc (.*)} $line match fname]} {
3000 # start of a new file
3001 $ctext insert end "\n"
3002 set here [$ctext index "end - 1c"]
3003 set i [$cflist index end]
3004 $ctext mark set fmark.$i $here
3005 $ctext mark gravity fmark.$i left
3006 set difffilestart([expr {$i-1}]) $here
3007 $cflist insert end $fname
3008 set l [expr {(78 - [string length $fname]) / 2}]
3009 set pad [string range "----------------------------------------" 1 $l]
3010 $ctext insert end "$pad $fname $pad\n" filesep
3011 } elseif {[regexp {^@@} $line]} {
3012 $ctext insert end "$line\n" hunksep
3013 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3014 # do nothing
3015 } else {
3016 # parse the prefix - one ' ', '-' or '+' for each parent
3017 set spaces {}
3018 set minuses {}
3019 set pluses {}
3020 set isbad 0
3021 for {set j 0} {$j < $np} {incr j} {
3022 set c [string range $line $j $j]
3023 if {$c == " "} {
3024 lappend spaces $j
3025 } elseif {$c == "-"} {
3026 lappend minuses $j
3027 } elseif {$c == "+"} {
3028 lappend pluses $j
3029 } else {
3030 set isbad 1
3031 break
3034 set tags {}
3035 set num {}
3036 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3037 # line doesn't appear in result, parents in $minuses have the line
3038 set num [lindex $minuses 0]
3039 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3040 # line appears in result, parents in $pluses don't have the line
3041 lappend tags mresult
3042 set num [lindex $spaces 0]
3044 if {$num ne {}} {
3045 if {$num >= $mergemax} {
3046 set num "max"
3048 lappend tags m$num
3050 $ctext insert end "$line\n" $tags
3052 $ctext conf -state disabled
3053 if {[clock clicks -milliseconds] >= $nextupdate} {
3054 incr nextupdate 100
3055 fileevent $mdf readable {}
3056 update
3057 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3061 proc startdiff {ids} {
3062 global treediffs diffids treepending diffmergeid
3064 set diffids $ids
3065 catch {unset diffmergeid}
3066 if {![info exists treediffs($ids)]} {
3067 if {![info exists treepending]} {
3068 gettreediffs $ids
3070 } else {
3071 addtocflist $ids
3075 proc addtocflist {ids} {
3076 global treediffs cflist
3077 foreach f $treediffs($ids) {
3078 $cflist insert end $f
3080 getblobdiffs $ids
3083 proc gettreediffs {ids} {
3084 global treediff treepending
3085 set treepending $ids
3086 set treediff {}
3087 if {[catch \
3088 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3089 ]} return
3090 fconfigure $gdtf -blocking 0
3091 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3094 proc gettreediffline {gdtf ids} {
3095 global treediff treediffs treepending diffids diffmergeid
3097 set n [gets $gdtf line]
3098 if {$n < 0} {
3099 if {![eof $gdtf]} return
3100 close $gdtf
3101 set treediffs($ids) $treediff
3102 unset treepending
3103 if {$ids != $diffids} {
3104 if {![info exists diffmergeid]} {
3105 gettreediffs $diffids
3107 } else {
3108 addtocflist $ids
3110 return
3112 set file [lindex $line 5]
3113 lappend treediff $file
3116 proc getblobdiffs {ids} {
3117 global diffopts blobdifffd diffids env curdifftag curtagstart
3118 global difffilestart nextupdate diffinhdr treediffs
3120 set env(GIT_DIFF_OPTS) $diffopts
3121 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3122 if {[catch {set bdf [open $cmd r]} err]} {
3123 puts "error getting diffs: $err"
3124 return
3126 set diffinhdr 0
3127 fconfigure $bdf -blocking 0
3128 set blobdifffd($ids) $bdf
3129 set curdifftag Comments
3130 set curtagstart 0.0
3131 catch {unset difffilestart}
3132 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3133 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3136 proc getblobdiffline {bdf ids} {
3137 global diffids blobdifffd ctext curdifftag curtagstart
3138 global diffnexthead diffnextnote difffilestart
3139 global nextupdate diffinhdr treediffs
3141 set n [gets $bdf line]
3142 if {$n < 0} {
3143 if {[eof $bdf]} {
3144 close $bdf
3145 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3146 $ctext tag add $curdifftag $curtagstart end
3149 return
3151 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3152 return
3154 $ctext conf -state normal
3155 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3156 # start of a new file
3157 $ctext insert end "\n"
3158 $ctext tag add $curdifftag $curtagstart end
3159 set curtagstart [$ctext index "end - 1c"]
3160 set header $newname
3161 set here [$ctext index "end - 1c"]
3162 set i [lsearch -exact $treediffs($diffids) $fname]
3163 if {$i >= 0} {
3164 set difffilestart($i) $here
3165 incr i
3166 $ctext mark set fmark.$i $here
3167 $ctext mark gravity fmark.$i left
3169 if {$newname != $fname} {
3170 set i [lsearch -exact $treediffs($diffids) $newname]
3171 if {$i >= 0} {
3172 set difffilestart($i) $here
3173 incr i
3174 $ctext mark set fmark.$i $here
3175 $ctext mark gravity fmark.$i left
3178 set curdifftag "f:$fname"
3179 $ctext tag delete $curdifftag
3180 set l [expr {(78 - [string length $header]) / 2}]
3181 set pad [string range "----------------------------------------" 1 $l]
3182 $ctext insert end "$pad $header $pad\n" filesep
3183 set diffinhdr 1
3184 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3185 # do nothing
3186 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3187 set diffinhdr 0
3188 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3189 $line match f1l f1c f2l f2c rest]} {
3190 $ctext insert end "$line\n" hunksep
3191 set diffinhdr 0
3192 } else {
3193 set x [string range $line 0 0]
3194 if {$x == "-" || $x == "+"} {
3195 set tag [expr {$x == "+"}]
3196 $ctext insert end "$line\n" d$tag
3197 } elseif {$x == " "} {
3198 $ctext insert end "$line\n"
3199 } elseif {$diffinhdr || $x == "\\"} {
3200 # e.g. "\ No newline at end of file"
3201 $ctext insert end "$line\n" filesep
3202 } else {
3203 # Something else we don't recognize
3204 if {$curdifftag != "Comments"} {
3205 $ctext insert end "\n"
3206 $ctext tag add $curdifftag $curtagstart end
3207 set curtagstart [$ctext index "end - 1c"]
3208 set curdifftag Comments
3210 $ctext insert end "$line\n" filesep
3213 $ctext conf -state disabled
3214 if {[clock clicks -milliseconds] >= $nextupdate} {
3215 incr nextupdate 100
3216 fileevent $bdf readable {}
3217 update
3218 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3222 proc nextfile {} {
3223 global difffilestart ctext
3224 set here [$ctext index @0,0]
3225 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3226 if {[$ctext compare $difffilestart($i) > $here]} {
3227 if {![info exists pos]
3228 || [$ctext compare $difffilestart($i) < $pos]} {
3229 set pos $difffilestart($i)
3233 if {[info exists pos]} {
3234 $ctext yview $pos
3238 proc listboxsel {} {
3239 global ctext cflist currentid
3240 if {![info exists currentid]} return
3241 set sel [lsort [$cflist curselection]]
3242 if {$sel eq {}} return
3243 set first [lindex $sel 0]
3244 catch {$ctext yview fmark.$first}
3247 proc setcoords {} {
3248 global linespc charspc canvx0 canvy0 mainfont
3249 global xspc1 xspc2 lthickness
3251 set linespc [font metrics $mainfont -linespace]
3252 set charspc [font measure $mainfont "m"]
3253 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3254 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3255 set lthickness [expr {int($linespc / 9) + 1}]
3256 set xspc1(0) $linespc
3257 set xspc2 $linespc
3260 proc redisplay {} {
3261 global canv
3262 global selectedline
3264 set ymax [lindex [$canv cget -scrollregion] 3]
3265 if {$ymax eq {} || $ymax == 0} return
3266 set span [$canv yview]
3267 clear_display
3268 setcanvscroll
3269 allcanvs yview moveto [lindex $span 0]
3270 drawvisible
3271 if {[info exists selectedline]} {
3272 selectline $selectedline 0
3276 proc incrfont {inc} {
3277 global mainfont namefont textfont ctext canv phase
3278 global stopped entries
3279 unmarkmatches
3280 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3281 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3282 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3283 setcoords
3284 $ctext conf -font $textfont
3285 $ctext tag conf filesep -font [concat $textfont bold]
3286 foreach e $entries {
3287 $e conf -font $mainfont
3289 if {$phase eq "getcommits"} {
3290 $canv itemconf textitems -font $mainfont
3292 redisplay
3295 proc clearsha1 {} {
3296 global sha1entry sha1string
3297 if {[string length $sha1string] == 40} {
3298 $sha1entry delete 0 end
3302 proc sha1change {n1 n2 op} {
3303 global sha1string currentid sha1but
3304 if {$sha1string == {}
3305 || ([info exists currentid] && $sha1string == $currentid)} {
3306 set state disabled
3307 } else {
3308 set state normal
3310 if {[$sha1but cget -state] == $state} return
3311 if {$state == "normal"} {
3312 $sha1but conf -state normal -relief raised -text "Goto: "
3313 } else {
3314 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3318 proc gotocommit {} {
3319 global sha1string currentid commitrow tagids headids
3320 global displayorder numcommits
3322 if {$sha1string == {}
3323 || ([info exists currentid] && $sha1string == $currentid)} return
3324 if {[info exists tagids($sha1string)]} {
3325 set id $tagids($sha1string)
3326 } elseif {[info exists headids($sha1string)]} {
3327 set id $headids($sha1string)
3328 } else {
3329 set id [string tolower $sha1string]
3330 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3331 set matches {}
3332 foreach i $displayorder {
3333 if {[string match $id* $i]} {
3334 lappend matches $i
3337 if {$matches ne {}} {
3338 if {[llength $matches] > 1} {
3339 error_popup "Short SHA1 id $id is ambiguous"
3340 return
3342 set id [lindex $matches 0]
3346 if {[info exists commitrow($id)]} {
3347 selectline $commitrow($id) 1
3348 return
3350 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3351 set type "SHA1 id"
3352 } else {
3353 set type "Tag/Head"
3355 error_popup "$type $sha1string is not known"
3358 proc lineenter {x y id} {
3359 global hoverx hovery hoverid hovertimer
3360 global commitinfo canv
3362 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3363 set hoverx $x
3364 set hovery $y
3365 set hoverid $id
3366 if {[info exists hovertimer]} {
3367 after cancel $hovertimer
3369 set hovertimer [after 500 linehover]
3370 $canv delete hover
3373 proc linemotion {x y id} {
3374 global hoverx hovery hoverid hovertimer
3376 if {[info exists hoverid] && $id == $hoverid} {
3377 set hoverx $x
3378 set hovery $y
3379 if {[info exists hovertimer]} {
3380 after cancel $hovertimer
3382 set hovertimer [after 500 linehover]
3386 proc lineleave {id} {
3387 global hoverid hovertimer canv
3389 if {[info exists hoverid] && $id == $hoverid} {
3390 $canv delete hover
3391 if {[info exists hovertimer]} {
3392 after cancel $hovertimer
3393 unset hovertimer
3395 unset hoverid
3399 proc linehover {} {
3400 global hoverx hovery hoverid hovertimer
3401 global canv linespc lthickness
3402 global commitinfo mainfont
3404 set text [lindex $commitinfo($hoverid) 0]
3405 set ymax [lindex [$canv cget -scrollregion] 3]
3406 if {$ymax == {}} return
3407 set yfrac [lindex [$canv yview] 0]
3408 set x [expr {$hoverx + 2 * $linespc}]
3409 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3410 set x0 [expr {$x - 2 * $lthickness}]
3411 set y0 [expr {$y - 2 * $lthickness}]
3412 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3413 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3414 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3415 -fill \#ffff80 -outline black -width 1 -tags hover]
3416 $canv raise $t
3417 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3418 $canv raise $t
3421 proc clickisonarrow {id y} {
3422 global lthickness
3424 set ranges [rowranges $id]
3425 set thresh [expr {2 * $lthickness + 6}]
3426 set n [expr {[llength $ranges] - 1}]
3427 for {set i 1} {$i < $n} {incr i} {
3428 set row [lindex $ranges $i]
3429 if {abs([yc $row] - $y) < $thresh} {
3430 return $i
3433 return {}
3436 proc arrowjump {id n y} {
3437 global canv
3439 # 1 <-> 2, 3 <-> 4, etc...
3440 set n [expr {(($n - 1) ^ 1) + 1}]
3441 set row [lindex [rowranges $id] $n]
3442 set yt [yc $row]
3443 set ymax [lindex [$canv cget -scrollregion] 3]
3444 if {$ymax eq {} || $ymax <= 0} return
3445 set view [$canv yview]
3446 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3447 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3448 if {$yfrac < 0} {
3449 set yfrac 0
3451 allcanvs yview moveto $yfrac
3454 proc lineclick {x y id isnew} {
3455 global ctext commitinfo childlist commitrow cflist canv thickerline
3457 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3458 unmarkmatches
3459 unselectline
3460 normalline
3461 $canv delete hover
3462 # draw this line thicker than normal
3463 set thickerline $id
3464 drawlines $id
3465 if {$isnew} {
3466 set ymax [lindex [$canv cget -scrollregion] 3]
3467 if {$ymax eq {}} return
3468 set yfrac [lindex [$canv yview] 0]
3469 set y [expr {$y + $yfrac * $ymax}]
3471 set dirn [clickisonarrow $id $y]
3472 if {$dirn ne {}} {
3473 arrowjump $id $dirn $y
3474 return
3477 if {$isnew} {
3478 addtohistory [list lineclick $x $y $id 0]
3480 # fill the details pane with info about this line
3481 $ctext conf -state normal
3482 $ctext delete 0.0 end
3483 $ctext tag conf link -foreground blue -underline 1
3484 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3485 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3486 $ctext insert end "Parent:\t"
3487 $ctext insert end $id [list link link0]
3488 $ctext tag bind link0 <1> [list selbyid $id]
3489 set info $commitinfo($id)
3490 $ctext insert end "\n\t[lindex $info 0]\n"
3491 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3492 set date [formatdate [lindex $info 2]]
3493 $ctext insert end "\tDate:\t$date\n"
3494 set kids [lindex $childlist $commitrow($id)]
3495 if {$kids ne {}} {
3496 $ctext insert end "\nChildren:"
3497 set i 0
3498 foreach child $kids {
3499 incr i
3500 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3501 set info $commitinfo($child)
3502 $ctext insert end "\n\t"
3503 $ctext insert end $child [list link link$i]
3504 $ctext tag bind link$i <1> [list selbyid $child]
3505 $ctext insert end "\n\t[lindex $info 0]"
3506 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3507 set date [formatdate [lindex $info 2]]
3508 $ctext insert end "\n\tDate:\t$date\n"
3511 $ctext conf -state disabled
3513 $cflist delete 0 end
3516 proc normalline {} {
3517 global thickerline
3518 if {[info exists thickerline]} {
3519 set id $thickerline
3520 unset thickerline
3521 drawlines $id
3525 proc selbyid {id} {
3526 global commitrow
3527 if {[info exists commitrow($id)]} {
3528 selectline $commitrow($id) 1
3532 proc mstime {} {
3533 global startmstime
3534 if {![info exists startmstime]} {
3535 set startmstime [clock clicks -milliseconds]
3537 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3540 proc rowmenu {x y id} {
3541 global rowctxmenu commitrow selectedline rowmenuid
3543 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3544 set state disabled
3545 } else {
3546 set state normal
3548 $rowctxmenu entryconfigure 0 -state $state
3549 $rowctxmenu entryconfigure 1 -state $state
3550 $rowctxmenu entryconfigure 2 -state $state
3551 set rowmenuid $id
3552 tk_popup $rowctxmenu $x $y
3555 proc diffvssel {dirn} {
3556 global rowmenuid selectedline displayorder
3558 if {![info exists selectedline]} return
3559 if {$dirn} {
3560 set oldid [lindex $displayorder $selectedline]
3561 set newid $rowmenuid
3562 } else {
3563 set oldid $rowmenuid
3564 set newid [lindex $displayorder $selectedline]
3566 addtohistory [list doseldiff $oldid $newid]
3567 doseldiff $oldid $newid
3570 proc doseldiff {oldid newid} {
3571 global ctext cflist
3572 global commitinfo
3574 $ctext conf -state normal
3575 $ctext delete 0.0 end
3576 $ctext mark set fmark.0 0.0
3577 $ctext mark gravity fmark.0 left
3578 $cflist delete 0 end
3579 $cflist insert end "Top"
3580 $ctext insert end "From "
3581 $ctext tag conf link -foreground blue -underline 1
3582 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3583 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3584 $ctext tag bind link0 <1> [list selbyid $oldid]
3585 $ctext insert end $oldid [list link link0]
3586 $ctext insert end "\n "
3587 $ctext insert end [lindex $commitinfo($oldid) 0]
3588 $ctext insert end "\n\nTo "
3589 $ctext tag bind link1 <1> [list selbyid $newid]
3590 $ctext insert end $newid [list link link1]
3591 $ctext insert end "\n "
3592 $ctext insert end [lindex $commitinfo($newid) 0]
3593 $ctext insert end "\n"
3594 $ctext conf -state disabled
3595 $ctext tag delete Comments
3596 $ctext tag remove found 1.0 end
3597 startdiff [list $oldid $newid]
3600 proc mkpatch {} {
3601 global rowmenuid currentid commitinfo patchtop patchnum
3603 if {![info exists currentid]} return
3604 set oldid $currentid
3605 set oldhead [lindex $commitinfo($oldid) 0]
3606 set newid $rowmenuid
3607 set newhead [lindex $commitinfo($newid) 0]
3608 set top .patch
3609 set patchtop $top
3610 catch {destroy $top}
3611 toplevel $top
3612 label $top.title -text "Generate patch"
3613 grid $top.title - -pady 10
3614 label $top.from -text "From:"
3615 entry $top.fromsha1 -width 40 -relief flat
3616 $top.fromsha1 insert 0 $oldid
3617 $top.fromsha1 conf -state readonly
3618 grid $top.from $top.fromsha1 -sticky w
3619 entry $top.fromhead -width 60 -relief flat
3620 $top.fromhead insert 0 $oldhead
3621 $top.fromhead conf -state readonly
3622 grid x $top.fromhead -sticky w
3623 label $top.to -text "To:"
3624 entry $top.tosha1 -width 40 -relief flat
3625 $top.tosha1 insert 0 $newid
3626 $top.tosha1 conf -state readonly
3627 grid $top.to $top.tosha1 -sticky w
3628 entry $top.tohead -width 60 -relief flat
3629 $top.tohead insert 0 $newhead
3630 $top.tohead conf -state readonly
3631 grid x $top.tohead -sticky w
3632 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3633 grid $top.rev x -pady 10
3634 label $top.flab -text "Output file:"
3635 entry $top.fname -width 60
3636 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3637 incr patchnum
3638 grid $top.flab $top.fname -sticky w
3639 frame $top.buts
3640 button $top.buts.gen -text "Generate" -command mkpatchgo
3641 button $top.buts.can -text "Cancel" -command mkpatchcan
3642 grid $top.buts.gen $top.buts.can
3643 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3644 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3645 grid $top.buts - -pady 10 -sticky ew
3646 focus $top.fname
3649 proc mkpatchrev {} {
3650 global patchtop
3652 set oldid [$patchtop.fromsha1 get]
3653 set oldhead [$patchtop.fromhead get]
3654 set newid [$patchtop.tosha1 get]
3655 set newhead [$patchtop.tohead get]
3656 foreach e [list fromsha1 fromhead tosha1 tohead] \
3657 v [list $newid $newhead $oldid $oldhead] {
3658 $patchtop.$e conf -state normal
3659 $patchtop.$e delete 0 end
3660 $patchtop.$e insert 0 $v
3661 $patchtop.$e conf -state readonly
3665 proc mkpatchgo {} {
3666 global patchtop
3668 set oldid [$patchtop.fromsha1 get]
3669 set newid [$patchtop.tosha1 get]
3670 set fname [$patchtop.fname get]
3671 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3672 error_popup "Error creating patch: $err"
3674 catch {destroy $patchtop}
3675 unset patchtop
3678 proc mkpatchcan {} {
3679 global patchtop
3681 catch {destroy $patchtop}
3682 unset patchtop
3685 proc mktag {} {
3686 global rowmenuid mktagtop commitinfo
3688 set top .maketag
3689 set mktagtop $top
3690 catch {destroy $top}
3691 toplevel $top
3692 label $top.title -text "Create tag"
3693 grid $top.title - -pady 10
3694 label $top.id -text "ID:"
3695 entry $top.sha1 -width 40 -relief flat
3696 $top.sha1 insert 0 $rowmenuid
3697 $top.sha1 conf -state readonly
3698 grid $top.id $top.sha1 -sticky w
3699 entry $top.head -width 60 -relief flat
3700 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3701 $top.head conf -state readonly
3702 grid x $top.head -sticky w
3703 label $top.tlab -text "Tag name:"
3704 entry $top.tag -width 60
3705 grid $top.tlab $top.tag -sticky w
3706 frame $top.buts
3707 button $top.buts.gen -text "Create" -command mktaggo
3708 button $top.buts.can -text "Cancel" -command mktagcan
3709 grid $top.buts.gen $top.buts.can
3710 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3711 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3712 grid $top.buts - -pady 10 -sticky ew
3713 focus $top.tag
3716 proc domktag {} {
3717 global mktagtop env tagids idtags
3719 set id [$mktagtop.sha1 get]
3720 set tag [$mktagtop.tag get]
3721 if {$tag == {}} {
3722 error_popup "No tag name specified"
3723 return
3725 if {[info exists tagids($tag)]} {
3726 error_popup "Tag \"$tag\" already exists"
3727 return
3729 if {[catch {
3730 set dir [gitdir]
3731 set fname [file join $dir "refs/tags" $tag]
3732 set f [open $fname w]
3733 puts $f $id
3734 close $f
3735 } err]} {
3736 error_popup "Error creating tag: $err"
3737 return
3740 set tagids($tag) $id
3741 lappend idtags($id) $tag
3742 redrawtags $id
3745 proc redrawtags {id} {
3746 global canv linehtag commitrow idpos selectedline
3748 if {![info exists commitrow($id)]} return
3749 drawcmitrow $commitrow($id)
3750 $canv delete tag.$id
3751 set xt [eval drawtags $id $idpos($id)]
3752 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3753 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3754 selectline $selectedline 0
3758 proc mktagcan {} {
3759 global mktagtop
3761 catch {destroy $mktagtop}
3762 unset mktagtop
3765 proc mktaggo {} {
3766 domktag
3767 mktagcan
3770 proc writecommit {} {
3771 global rowmenuid wrcomtop commitinfo wrcomcmd
3773 set top .writecommit
3774 set wrcomtop $top
3775 catch {destroy $top}
3776 toplevel $top
3777 label $top.title -text "Write commit to file"
3778 grid $top.title - -pady 10
3779 label $top.id -text "ID:"
3780 entry $top.sha1 -width 40 -relief flat
3781 $top.sha1 insert 0 $rowmenuid
3782 $top.sha1 conf -state readonly
3783 grid $top.id $top.sha1 -sticky w
3784 entry $top.head -width 60 -relief flat
3785 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3786 $top.head conf -state readonly
3787 grid x $top.head -sticky w
3788 label $top.clab -text "Command:"
3789 entry $top.cmd -width 60 -textvariable wrcomcmd
3790 grid $top.clab $top.cmd -sticky w -pady 10
3791 label $top.flab -text "Output file:"
3792 entry $top.fname -width 60
3793 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3794 grid $top.flab $top.fname -sticky w
3795 frame $top.buts
3796 button $top.buts.gen -text "Write" -command wrcomgo
3797 button $top.buts.can -text "Cancel" -command wrcomcan
3798 grid $top.buts.gen $top.buts.can
3799 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3800 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3801 grid $top.buts - -pady 10 -sticky ew
3802 focus $top.fname
3805 proc wrcomgo {} {
3806 global wrcomtop
3808 set id [$wrcomtop.sha1 get]
3809 set cmd "echo $id | [$wrcomtop.cmd get]"
3810 set fname [$wrcomtop.fname get]
3811 if {[catch {exec sh -c $cmd >$fname &} err]} {
3812 error_popup "Error writing commit: $err"
3814 catch {destroy $wrcomtop}
3815 unset wrcomtop
3818 proc wrcomcan {} {
3819 global wrcomtop
3821 catch {destroy $wrcomtop}
3822 unset wrcomtop
3825 proc listrefs {id} {
3826 global idtags idheads idotherrefs
3828 set x {}
3829 if {[info exists idtags($id)]} {
3830 set x $idtags($id)
3832 set y {}
3833 if {[info exists idheads($id)]} {
3834 set y $idheads($id)
3836 set z {}
3837 if {[info exists idotherrefs($id)]} {
3838 set z $idotherrefs($id)
3840 return [list $x $y $z]
3843 proc rereadrefs {} {
3844 global idtags idheads idotherrefs
3846 set refids [concat [array names idtags] \
3847 [array names idheads] [array names idotherrefs]]
3848 foreach id $refids {
3849 if {![info exists ref($id)]} {
3850 set ref($id) [listrefs $id]
3853 readrefs
3854 set refids [lsort -unique [concat $refids [array names idtags] \
3855 [array names idheads] [array names idotherrefs]]]
3856 foreach id $refids {
3857 set v [listrefs $id]
3858 if {![info exists ref($id)] || $ref($id) != $v} {
3859 redrawtags $id
3864 proc showtag {tag isnew} {
3865 global ctext cflist tagcontents tagids linknum
3867 if {$isnew} {
3868 addtohistory [list showtag $tag 0]
3870 $ctext conf -state normal
3871 $ctext delete 0.0 end
3872 set linknum 0
3873 if {[info exists tagcontents($tag)]} {
3874 set text $tagcontents($tag)
3875 } else {
3876 set text "Tag: $tag\nId: $tagids($tag)"
3878 appendwithlinks $text
3879 $ctext conf -state disabled
3880 $cflist delete 0 end
3883 proc doquit {} {
3884 global stopped
3885 set stopped 100
3886 destroy .
3889 proc doprefs {} {
3890 global maxwidth maxgraphpct diffopts findmergefiles
3891 global oldprefs prefstop
3893 set top .gitkprefs
3894 set prefstop $top
3895 if {[winfo exists $top]} {
3896 raise $top
3897 return
3899 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3900 set oldprefs($v) [set $v]
3902 toplevel $top
3903 wm title $top "Gitk preferences"
3904 label $top.ldisp -text "Commit list display options"
3905 grid $top.ldisp - -sticky w -pady 10
3906 label $top.spacer -text " "
3907 label $top.maxwidthl -text "Maximum graph width (lines)" \
3908 -font optionfont
3909 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3910 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3911 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3912 -font optionfont
3913 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3914 grid x $top.maxpctl $top.maxpct -sticky w
3915 checkbutton $top.findm -variable findmergefiles
3916 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3917 -font optionfont
3918 grid $top.findm $top.findml - -sticky w
3919 label $top.ddisp -text "Diff display options"
3920 grid $top.ddisp - -sticky w -pady 10
3921 label $top.diffoptl -text "Options for diff program" \
3922 -font optionfont
3923 entry $top.diffopt -width 20 -textvariable diffopts
3924 grid x $top.diffoptl $top.diffopt -sticky w
3925 frame $top.buts
3926 button $top.buts.ok -text "OK" -command prefsok
3927 button $top.buts.can -text "Cancel" -command prefscan
3928 grid $top.buts.ok $top.buts.can
3929 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3930 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3931 grid $top.buts - - -pady 10 -sticky ew
3934 proc prefscan {} {
3935 global maxwidth maxgraphpct diffopts findmergefiles
3936 global oldprefs prefstop
3938 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3939 set $v $oldprefs($v)
3941 catch {destroy $prefstop}
3942 unset prefstop
3945 proc prefsok {} {
3946 global maxwidth maxgraphpct
3947 global oldprefs prefstop
3949 catch {destroy $prefstop}
3950 unset prefstop
3951 if {$maxwidth != $oldprefs(maxwidth)
3952 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3953 redisplay
3957 proc formatdate {d} {
3958 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3961 # This list of encoding names and aliases is distilled from
3962 # http://www.iana.org/assignments/character-sets.
3963 # Not all of them are supported by Tcl.
3964 set encoding_aliases {
3965 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3966 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3967 { ISO-10646-UTF-1 csISO10646UTF1 }
3968 { ISO_646.basic:1983 ref csISO646basic1983 }
3969 { INVARIANT csINVARIANT }
3970 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3971 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3972 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3973 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3974 { NATS-DANO iso-ir-9-1 csNATSDANO }
3975 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3976 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3977 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3978 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3979 { ISO-2022-KR csISO2022KR }
3980 { EUC-KR csEUCKR }
3981 { ISO-2022-JP csISO2022JP }
3982 { ISO-2022-JP-2 csISO2022JP2 }
3983 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3984 csISO13JISC6220jp }
3985 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3986 { IT iso-ir-15 ISO646-IT csISO15Italian }
3987 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3988 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3989 { greek7-old iso-ir-18 csISO18Greek7Old }
3990 { latin-greek iso-ir-19 csISO19LatinGreek }
3991 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3992 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3993 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3994 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3995 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3996 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3997 { INIS iso-ir-49 csISO49INIS }
3998 { INIS-8 iso-ir-50 csISO50INIS8 }
3999 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4000 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4001 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4002 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4003 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4004 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4005 csISO60Norwegian1 }
4006 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4007 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4008 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4009 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4010 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4011 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4012 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4013 { greek7 iso-ir-88 csISO88Greek7 }
4014 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4015 { iso-ir-90 csISO90 }
4016 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4017 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4018 csISO92JISC62991984b }
4019 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4020 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4021 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4022 csISO95JIS62291984handadd }
4023 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4024 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4025 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4026 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4027 CP819 csISOLatin1 }
4028 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4029 { T.61-7bit iso-ir-102 csISO102T617bit }
4030 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4031 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4032 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4033 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4034 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4035 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4036 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4037 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4038 arabic csISOLatinArabic }
4039 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4040 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4041 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4042 greek greek8 csISOLatinGreek }
4043 { T.101-G2 iso-ir-128 csISO128T101G2 }
4044 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4045 csISOLatinHebrew }
4046 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4047 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4048 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4049 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4050 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4051 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4052 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4053 csISOLatinCyrillic }
4054 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4055 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4056 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4057 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4058 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4059 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4060 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4061 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4062 { ISO_10367-box iso-ir-155 csISO10367Box }
4063 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4064 { latin-lap lap iso-ir-158 csISO158Lap }
4065 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4066 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4067 { us-dk csUSDK }
4068 { dk-us csDKUS }
4069 { JIS_X0201 X0201 csHalfWidthKatakana }
4070 { KSC5636 ISO646-KR csKSC5636 }
4071 { ISO-10646-UCS-2 csUnicode }
4072 { ISO-10646-UCS-4 csUCS4 }
4073 { DEC-MCS dec csDECMCS }
4074 { hp-roman8 roman8 r8 csHPRoman8 }
4075 { macintosh mac csMacintosh }
4076 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4077 csIBM037 }
4078 { IBM038 EBCDIC-INT cp038 csIBM038 }
4079 { IBM273 CP273 csIBM273 }
4080 { IBM274 EBCDIC-BE CP274 csIBM274 }
4081 { IBM275 EBCDIC-BR cp275 csIBM275 }
4082 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4083 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4084 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4085 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4086 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4087 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4088 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4089 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4090 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4091 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4092 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4093 { IBM437 cp437 437 csPC8CodePage437 }
4094 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4095 { IBM775 cp775 csPC775Baltic }
4096 { IBM850 cp850 850 csPC850Multilingual }
4097 { IBM851 cp851 851 csIBM851 }
4098 { IBM852 cp852 852 csPCp852 }
4099 { IBM855 cp855 855 csIBM855 }
4100 { IBM857 cp857 857 csIBM857 }
4101 { IBM860 cp860 860 csIBM860 }
4102 { IBM861 cp861 861 cp-is csIBM861 }
4103 { IBM862 cp862 862 csPC862LatinHebrew }
4104 { IBM863 cp863 863 csIBM863 }
4105 { IBM864 cp864 csIBM864 }
4106 { IBM865 cp865 865 csIBM865 }
4107 { IBM866 cp866 866 csIBM866 }
4108 { IBM868 CP868 cp-ar csIBM868 }
4109 { IBM869 cp869 869 cp-gr csIBM869 }
4110 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4111 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4112 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4113 { IBM891 cp891 csIBM891 }
4114 { IBM903 cp903 csIBM903 }
4115 { IBM904 cp904 904 csIBBM904 }
4116 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4117 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4118 { IBM1026 CP1026 csIBM1026 }
4119 { EBCDIC-AT-DE csIBMEBCDICATDE }
4120 { EBCDIC-AT-DE-A csEBCDICATDEA }
4121 { EBCDIC-CA-FR csEBCDICCAFR }
4122 { EBCDIC-DK-NO csEBCDICDKNO }
4123 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4124 { EBCDIC-FI-SE csEBCDICFISE }
4125 { EBCDIC-FI-SE-A csEBCDICFISEA }
4126 { EBCDIC-FR csEBCDICFR }
4127 { EBCDIC-IT csEBCDICIT }
4128 { EBCDIC-PT csEBCDICPT }
4129 { EBCDIC-ES csEBCDICES }
4130 { EBCDIC-ES-A csEBCDICESA }
4131 { EBCDIC-ES-S csEBCDICESS }
4132 { EBCDIC-UK csEBCDICUK }
4133 { EBCDIC-US csEBCDICUS }
4134 { UNKNOWN-8BIT csUnknown8BiT }
4135 { MNEMONIC csMnemonic }
4136 { MNEM csMnem }
4137 { VISCII csVISCII }
4138 { VIQR csVIQR }
4139 { KOI8-R csKOI8R }
4140 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4141 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4142 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4143 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4144 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4145 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4146 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4147 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4148 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4149 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4150 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4151 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4152 { IBM1047 IBM-1047 }
4153 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4154 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4155 { UNICODE-1-1 csUnicode11 }
4156 { CESU-8 csCESU-8 }
4157 { BOCU-1 csBOCU-1 }
4158 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4159 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4160 l8 }
4161 { ISO-8859-15 ISO_8859-15 Latin-9 }
4162 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4163 { GBK CP936 MS936 windows-936 }
4164 { JIS_Encoding csJISEncoding }
4165 { Shift_JIS MS_Kanji csShiftJIS }
4166 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4167 EUC-JP }
4168 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4169 { ISO-10646-UCS-Basic csUnicodeASCII }
4170 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4171 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4172 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4173 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4174 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4175 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4176 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4177 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4178 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4179 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4180 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4181 { Ventura-US csVenturaUS }
4182 { Ventura-International csVenturaInternational }
4183 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4184 { PC8-Turkish csPC8Turkish }
4185 { IBM-Symbols csIBMSymbols }
4186 { IBM-Thai csIBMThai }
4187 { HP-Legal csHPLegal }
4188 { HP-Pi-font csHPPiFont }
4189 { HP-Math8 csHPMath8 }
4190 { Adobe-Symbol-Encoding csHPPSMath }
4191 { HP-DeskTop csHPDesktop }
4192 { Ventura-Math csVenturaMath }
4193 { Microsoft-Publishing csMicrosoftPublishing }
4194 { Windows-31J csWindows31J }
4195 { GB2312 csGB2312 }
4196 { Big5 csBig5 }
4199 proc tcl_encoding {enc} {
4200 global encoding_aliases
4201 set names [encoding names]
4202 set lcnames [string tolower $names]
4203 set enc [string tolower $enc]
4204 set i [lsearch -exact $lcnames $enc]
4205 if {$i < 0} {
4206 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4207 if {[regsub {^iso[-_]} $enc iso encx]} {
4208 set i [lsearch -exact $lcnames $encx]
4211 if {$i < 0} {
4212 foreach l $encoding_aliases {
4213 set ll [string tolower $l]
4214 if {[lsearch -exact $ll $enc] < 0} continue
4215 # look through the aliases for one that tcl knows about
4216 foreach e $ll {
4217 set i [lsearch -exact $lcnames $e]
4218 if {$i < 0} {
4219 if {[regsub {^iso[-_]} $e iso ex]} {
4220 set i [lsearch -exact $lcnames $ex]
4223 if {$i >= 0} break
4225 break
4228 if {$i >= 0} {
4229 return [lindex $names $i]
4231 return {}
4234 # defaults...
4235 set datemode 0
4236 set diffopts "-U 5 -p"
4237 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4239 set gitencoding {}
4240 catch {
4241 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4243 if {$gitencoding == ""} {
4244 set gitencoding "utf-8"
4246 set tclencoding [tcl_encoding $gitencoding]
4247 if {$tclencoding == {}} {
4248 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4251 set mainfont {Helvetica 9}
4252 set textfont {Courier 9}
4253 set uifont {Helvetica 9 bold}
4254 set findmergefiles 0
4255 set maxgraphpct 50
4256 set maxwidth 16
4257 set revlistorder 0
4258 set fastdate 0
4259 set uparrowlen 7
4260 set downarrowlen 7
4261 set mingaplen 30
4263 set colors {green red blue magenta darkgrey brown orange}
4265 catch {source ~/.gitk}
4267 set namefont $mainfont
4269 font create optionfont -family sans-serif -size -12
4271 set revtreeargs {}
4272 foreach arg $argv {
4273 switch -regexp -- $arg {
4274 "^$" { }
4275 "^-d" { set datemode 1 }
4276 default {
4277 lappend revtreeargs $arg
4282 # check that we can find a .git directory somewhere...
4283 set gitdir [gitdir]
4284 if {![file isdirectory $gitdir]} {
4285 error_popup "Cannot find the git directory \"$gitdir\"."
4286 exit 1
4289 set history {}
4290 set historyindex 0
4292 set optim_delay 16
4294 set nextviewnum 1
4295 set curview 0
4296 set selectedview 0
4297 set viewfiles(0) {}
4298 set viewperm(0) 0
4300 set stopped 0
4301 set stuffsaved 0
4302 set patchnum 0
4303 setcoords
4304 makewindow
4305 readrefs
4307 set cmdline_files {}
4308 catch {
4309 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4310 set cmdline_files [split $fileargs "\n"]
4311 set n [llength $cmdline_files]
4312 set revtreeargs [lrange $revtreeargs 0 end-$n]
4314 if {[lindex $revtreeargs end] eq "--"} {
4315 set revtreeargs [lrange $revtreeargs 0 end-1]
4318 if {$cmdline_files ne {}} {
4319 # create a view for the files/dirs specified on the command line
4320 set curview 1
4321 set selectedview 1
4322 set nextviewnum 2
4323 set viewname(1) "Command line"
4324 set viewfiles(1) $cmdline_files
4325 set viewperm(1) 0
4326 .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4327 -variable selectedview -value 1
4328 .bar.view entryconf 2 -state normal
4329 .bar.view entryconf 3 -state normal
4332 if {[info exists permviews]} {
4333 foreach v $permviews {
4334 set n $nextviewnum
4335 incr nextviewnum
4336 set viewname($n) [lindex $v 0]
4337 set viewfiles($n) [lindex $v 1]
4338 set viewperm($n) 1
4339 .bar.view add radiobutton -label $viewname($n) \
4340 -command [list showview $n] -variable selectedview -value $n
4343 getcommits