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