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