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