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