Cleanup git-send-email.perl:extract_valid_email
[git/gitweb.git] / gitk
blob101cf9bd9ff8c3b8180ab50e6ceb4655576f9fbf
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
26 set ncmupdate 1
27 set commitidx($view) 0
28 set args $viewargs($view)
29 if {$viewfiles($view) ne {}} {
30 set args [concat $args "--" $viewfiles($view)]
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
36 if {[catch {
37 set fd [open [concat | git rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git rev-list: $err"
41 exit 1
43 set commfd($view) $fd
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
49 fileevent $fd readable [list getcommitlines $fd $view]
50 nowbusy $view
53 proc stop_rev_list {} {
54 global commfd curview
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
58 catch {
59 set pid [pid $fd]
60 exec kill $pid
62 catch {close $fd}
63 unset commfd($curview)
66 proc getcommits {} {
67 global phase canv mainfont curview
69 set phase getcommits
70 initlayout
71 start_rev_list $curview
72 show_status "Reading commits..."
75 proc getcommitlines {fd view} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
82 set stuff [read $fd]
83 if {$stuff == {}} {
84 if {![eof $fd]} return
85 global viewname
86 unset commfd($view)
87 notbusy $view
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {[catch {close $fd} err]} {
91 set fv {}
92 if {$view != $curview} {
93 set fv " for the \"$viewname($view)\" view"
95 if {[string range $err 0 4] == "usage"} {
96 set err "Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq "Command line"} {
99 append err \
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
103 } else {
104 set err "Error reading commits$fv: $err"
106 error_popup $err
108 if {$view == $curview} {
109 after idle finishcommits
111 return
113 set start 0
114 set gotsome 0
115 while 1 {
116 set i [string first "\0" $stuff $start]
117 if {$i < 0} {
118 append leftover($view) [string range $stuff $start end]
119 break
121 if {$start == 0} {
122 set cmit $leftover($view)
123 append cmit [string range $stuff 0 [expr {$i - 1}]]
124 set leftover($view) {}
125 } else {
126 set cmit [string range $stuff $start [expr {$i - 1}]]
128 set start [expr {$i + 1}]
129 set j [string first "\n" $cmit]
130 set ok 0
131 set listed 1
132 if {$j >= 0} {
133 set ids [string range $cmit 0 [expr {$j - 1}]]
134 if {[string range $ids 0 0] == "-"} {
135 set listed 0
136 set ids [string range $ids 1 end]
138 set ok 1
139 foreach id $ids {
140 if {[string length $id] != 40} {
141 set ok 0
142 break
146 if {!$ok} {
147 set shortcmit $cmit
148 if {[string length $shortcmit] > 80} {
149 set shortcmit "[string range $shortcmit 0 80]..."
151 error_popup "Can't parse git rev-list output: {$shortcmit}"
152 exit 1
154 set id [lindex $ids 0]
155 if {$listed} {
156 set olds [lrange $ids 1 end]
157 set i 0
158 foreach p $olds {
159 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160 lappend children($view,$p) $id
162 incr i
164 } else {
165 set olds {}
167 if {![info exists children($view,$id)]} {
168 set children($view,$id) {}
170 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
171 set commitrow($view,$id) $commitidx($view)
172 incr commitidx($view)
173 if {$view == $curview} {
174 lappend parentlist $olds
175 lappend childlist $children($view,$id)
176 lappend displayorder $id
177 lappend commitlisted $listed
178 } else {
179 lappend vparentlist($view) $olds
180 lappend vchildlist($view) $children($view,$id)
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) $listed
184 set gotsome 1
186 if {$gotsome} {
187 if {$view == $curview} {
188 layoutmore
189 } elseif {[info exists hlview] && $view == $hlview} {
190 highlightmore
193 if {[clock clicks -milliseconds] >= $nextupdate} {
194 doupdate
198 proc doupdate {} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
204 update
205 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate [expr {$numcommits + 1}]
208 } elseif {$numcommits < 10000} {
209 set ncmupdate [expr {$numcommits + 10}]
210 } else {
211 set ncmupdate [expr {$numcommits + 100}]
213 foreach v [array names commfd] {
214 set fd $commfd($v)
215 fileevent $fd readable [list getcommitlines $fd $v]
219 proc readcommit {id} {
220 if {[catch {set contents [exec git cat-file commit $id]}]} return
221 parsecommit $id $contents 0
224 proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow
228 if {$phase ne {}} {
229 stop_rev_list
230 set phase {}
232 set n $curview
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
237 set curview -1
238 catch {unset viewdata($n)}
239 readrefs
240 showview $n
243 proc parsecommit {id contents listed} {
244 global commitinfo cdate
246 set inhdr 1
247 set comment {}
248 set headline {}
249 set auname {}
250 set audate {}
251 set comname {}
252 set comdate {}
253 set hdrend [string first "\n\n" $contents]
254 if {$hdrend < 0} {
255 # should never happen...
256 set hdrend [string length $contents]
258 set header [string range $contents 0 [expr {$hdrend - 1}]]
259 set comment [string range $contents [expr {$hdrend + 2}] end]
260 foreach line [split $header "\n"] {
261 set tag [lindex $line 0]
262 if {$tag == "author"} {
263 set audate [lindex $line end-1]
264 set auname [lrange $line 1 end-2]
265 } elseif {$tag == "committer"} {
266 set comdate [lindex $line end-1]
267 set comname [lrange $line 1 end-2]
270 set headline {}
271 # take the first line of the comment as the headline
272 set i [string first "\n" $comment]
273 if {$i >= 0} {
274 set headline [string trim [string range $comment 0 $i]]
275 } else {
276 set headline $comment
278 if {!$listed} {
279 # git rev-list indents the comment by 4 spaces;
280 # if we got this via git cat-file, add the indentation
281 set newcomment {}
282 foreach line [split $comment "\n"] {
283 append newcomment " "
284 append newcomment $line
285 append newcomment "\n"
287 set comment $newcomment
289 if {$comdate != {}} {
290 set cdate($id) $comdate
292 set commitinfo($id) [list $headline $auname $audate \
293 $comname $comdate $comment]
296 proc getcommit {id} {
297 global commitdata commitinfo
299 if {[info exists commitdata($id)]} {
300 parsecommit $id $commitdata($id) 1
301 } else {
302 readcommit $id
303 if {![info exists commitinfo($id)]} {
304 set commitinfo($id) {"No commit information available"}
307 return 1
310 proc readrefs {} {
311 global tagids idtags headids idheads tagcontents
312 global otherrefids idotherrefs
314 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
315 catch {unset $v}
317 set refd [open [list | git ls-remote [gitdir]] r]
318 while {0 <= [set n [gets $refd line]]} {
319 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
320 match id path]} {
321 continue
323 if {[regexp {^remotes/.*/HEAD$} $path match]} {
324 continue
326 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
327 set type others
328 set name $path
330 if {[regexp {^remotes/} $path match]} {
331 set type heads
333 if {$type == "tags"} {
334 set tagids($name) $id
335 lappend idtags($id) $name
336 set obj {}
337 set type {}
338 set tag {}
339 catch {
340 set commit [exec git rev-parse "$id^0"]
341 if {"$commit" != "$id"} {
342 set tagids($name) $commit
343 lappend idtags($commit) $name
346 catch {
347 set tagcontents($name) [exec git cat-file tag "$id"]
349 } elseif { $type == "heads" } {
350 set headids($name) $id
351 lappend idheads($id) $name
352 } else {
353 set otherrefids($name) $id
354 lappend idotherrefs($id) $name
357 close $refd
360 proc show_error {w top msg} {
361 message $w.m -text $msg -justify center -aspect 400
362 pack $w.m -side top -fill x -padx 20 -pady 20
363 button $w.ok -text OK -command "destroy $top"
364 pack $w.ok -side bottom -fill x
365 bind $top <Visibility> "grab $top; focus $top"
366 bind $top <Key-Return> "destroy $top"
367 tkwait window $top
370 proc error_popup msg {
371 set w .error
372 toplevel $w
373 wm transient $w .
374 show_error $w $w $msg
377 proc makewindow {} {
378 global canv canv2 canv3 linespc charspc ctext cflist
379 global textfont mainfont uifont
380 global findtype findtypemenu findloc findstring fstring geometry
381 global entries sha1entry sha1string sha1but
382 global maincursor textcursor curtextcursor
383 global rowctxmenu mergemax wrapcomment
385 menu .bar
386 .bar add cascade -label "File" -menu .bar.file
387 .bar configure -font $uifont
388 menu .bar.file
389 .bar.file add command -label "Update" -command updatecommits
390 .bar.file add command -label "Reread references" -command rereadrefs
391 .bar.file add command -label "Quit" -command doquit
392 .bar.file configure -font $uifont
393 menu .bar.edit
394 .bar add cascade -label "Edit" -menu .bar.edit
395 .bar.edit add command -label "Preferences" -command doprefs
396 .bar.edit configure -font $uifont
398 menu .bar.view -font $uifont
399 menu .bar.view.hl -font $uifont -tearoff 0
400 .bar add cascade -label "View" -menu .bar.view
401 .bar.view add command -label "New view..." -command {newview 0}
402 .bar.view add command -label "Edit view..." -command editview \
403 -state disabled
404 .bar.view add command -label "Delete view" -command delview -state disabled
405 .bar.view add cascade -label "Highlight" -menu .bar.view.hl
406 .bar.view add separator
407 .bar.view add radiobutton -label "All files" -command {showview 0} \
408 -variable selectedview -value 0
409 .bar.view.hl add command -label "New view..." -command {newview 1}
410 .bar.view.hl add command -label "Remove" -command delhighlight \
411 -state disabled
412 .bar.view.hl add separator
414 menu .bar.help
415 .bar add cascade -label "Help" -menu .bar.help
416 .bar.help add command -label "About gitk" -command about
417 .bar.help add command -label "Key bindings" -command keys
418 .bar.help configure -font $uifont
419 . configure -menu .bar
421 if {![info exists geometry(canv1)]} {
422 set geometry(canv1) [expr {45 * $charspc}]
423 set geometry(canv2) [expr {30 * $charspc}]
424 set geometry(canv3) [expr {15 * $charspc}]
425 set geometry(canvh) [expr {25 * $linespc + 4}]
426 set geometry(ctextw) 80
427 set geometry(ctexth) 30
428 set geometry(cflistw) 30
430 panedwindow .ctop -orient vertical
431 if {[info exists geometry(width)]} {
432 .ctop conf -width $geometry(width) -height $geometry(height)
433 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
434 set geometry(ctexth) [expr {($texth - 8) /
435 [font metrics $textfont -linespace]}]
437 frame .ctop.top
438 frame .ctop.top.bar
439 pack .ctop.top.bar -side bottom -fill x
440 set cscroll .ctop.top.csb
441 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
442 pack $cscroll -side right -fill y
443 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
444 pack .ctop.top.clist -side top -fill both -expand 1
445 .ctop add .ctop.top
446 set canv .ctop.top.clist.canv
447 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
448 -bg white -bd 0 \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add $canv
451 set canv2 .ctop.top.clist.canv2
452 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
453 -bg white -bd 0 -yscrollincr $linespc
454 .ctop.top.clist add $canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
457 -bg white -bd 0 -yscrollincr $linespc
458 .ctop.top.clist add $canv3
459 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
461 set sha1entry .ctop.top.bar.sha1
462 set entries $sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
465 -command gotocommit -width 8 -font $uifont
466 $sha1but conf -disabledforeground [$sha1but cget -foreground]
467 pack .ctop.top.bar.sha1label -side left
468 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string write sha1change
470 pack $sha1entry -side left -pady 2
472 image create bitmap bm-left -data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right -data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut -image bm-left -command goback \
489 -state disabled -width 26
490 pack .ctop.top.bar.leftbut -side left -fill y
491 button .ctop.top.bar.rightbut -image bm-right -command goforw \
492 -state disabled -width 26
493 pack .ctop.top.bar.rightbut -side left -fill y
495 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
496 pack .ctop.top.bar.findbut -side left
497 set findstring {}
498 set fstring .ctop.top.bar.findstring
499 lappend entries $fstring
500 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
501 pack $fstring -side left -expand 1 -fill x
502 set findtype Exact
503 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
504 findtype Exact IgnCase Regexp]
505 .ctop.top.bar.findtype configure -font $uifont
506 .ctop.top.bar.findtype.menu configure -font $uifont
507 set findloc "All fields"
508 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
509 Comments Author Committer Files Pickaxe
510 .ctop.top.bar.findloc configure -font $uifont
511 .ctop.top.bar.findloc.menu configure -font $uifont
513 pack .ctop.top.bar.findloc -side right
514 pack .ctop.top.bar.findtype -side right
515 # for making sure type==Exact whenever loc==Pickaxe
516 trace add variable findloc write findlocchange
518 panedwindow .ctop.cdet -orient horizontal
519 .ctop add .ctop.cdet
520 frame .ctop.cdet.left
521 set ctext .ctop.cdet.left.ctext
522 text $ctext -bg white -state disabled -font $textfont \
523 -width $geometry(ctextw) -height $geometry(ctexth) \
524 -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
525 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
526 pack .ctop.cdet.left.sb -side right -fill y
527 pack $ctext -side left -fill both -expand 1
528 .ctop.cdet add .ctop.cdet.left
530 $ctext tag conf comment -wrap $wrapcomment
531 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
532 $ctext tag conf hunksep -fore blue
533 $ctext tag conf d0 -fore red
534 $ctext tag conf d1 -fore "#00a000"
535 $ctext tag conf m0 -fore red
536 $ctext tag conf m1 -fore blue
537 $ctext tag conf m2 -fore green
538 $ctext tag conf m3 -fore purple
539 $ctext tag conf m4 -fore brown
540 $ctext tag conf m5 -fore "#009090"
541 $ctext tag conf m6 -fore magenta
542 $ctext tag conf m7 -fore "#808000"
543 $ctext tag conf m8 -fore "#009000"
544 $ctext tag conf m9 -fore "#ff0080"
545 $ctext tag conf m10 -fore cyan
546 $ctext tag conf m11 -fore "#b07070"
547 $ctext tag conf m12 -fore "#70b0f0"
548 $ctext tag conf m13 -fore "#70f0b0"
549 $ctext tag conf m14 -fore "#f0b070"
550 $ctext tag conf m15 -fore "#ff70b0"
551 $ctext tag conf mmax -fore darkgrey
552 set mergemax 16
553 $ctext tag conf mresult -font [concat $textfont bold]
554 $ctext tag conf msep -font [concat $textfont bold]
555 $ctext tag conf found -back yellow
557 frame .ctop.cdet.right
558 frame .ctop.cdet.right.mode
559 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
560 -command reselectline -variable cmitmode -value "patch"
561 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
562 -command reselectline -variable cmitmode -value "tree"
563 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
564 pack .ctop.cdet.right.mode -side top -fill x
565 set cflist .ctop.cdet.right.cfiles
566 set indent [font measure $mainfont "nn"]
567 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
568 -tabs [list $indent [expr {2 * $indent}]] \
569 -yscrollcommand ".ctop.cdet.right.sb set" \
570 -cursor [. cget -cursor] \
571 -spacing1 1 -spacing3 1
572 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
573 pack .ctop.cdet.right.sb -side right -fill y
574 pack $cflist -side left -fill both -expand 1
575 $cflist tag configure highlight \
576 -background [$cflist cget -selectbackground]
577 .ctop.cdet add .ctop.cdet.right
578 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
580 pack .ctop -side top -fill both -expand 1
582 bindall <1> {selcanvline %W %x %y}
583 #bindall <B1-Motion> {selcanvline %W %x %y}
584 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
585 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
586 bindall <2> "canvscan mark %W %x %y"
587 bindall <B2-Motion> "canvscan dragto %W %x %y"
588 bindkey <Home> selfirstline
589 bindkey <End> sellastline
590 bind . <Key-Up> "selnextline -1"
591 bind . <Key-Down> "selnextline 1"
592 bindkey <Key-Right> "goforw"
593 bindkey <Key-Left> "goback"
594 bind . <Key-Prior> "selnextpage -1"
595 bind . <Key-Next> "selnextpage 1"
596 bind . <Control-Home> "allcanvs yview moveto 0.0"
597 bind . <Control-End> "allcanvs yview moveto 1.0"
598 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
599 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
600 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
601 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
602 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
603 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
604 bindkey <Key-space> "$ctext yview scroll 1 pages"
605 bindkey p "selnextline -1"
606 bindkey n "selnextline 1"
607 bindkey z "goback"
608 bindkey x "goforw"
609 bindkey i "selnextline -1"
610 bindkey k "selnextline 1"
611 bindkey j "goback"
612 bindkey l "goforw"
613 bindkey b "$ctext yview scroll -1 pages"
614 bindkey d "$ctext yview scroll 18 units"
615 bindkey u "$ctext yview scroll -18 units"
616 bindkey / {findnext 1}
617 bindkey <Key-Return> {findnext 0}
618 bindkey ? findprev
619 bindkey f nextfile
620 bind . <Control-q> doquit
621 bind . <Control-f> dofind
622 bind . <Control-g> {findnext 0}
623 bind . <Control-r> findprev
624 bind . <Control-equal> {incrfont 1}
625 bind . <Control-KP_Add> {incrfont 1}
626 bind . <Control-minus> {incrfont -1}
627 bind . <Control-KP_Subtract> {incrfont -1}
628 bind . <Destroy> {savestuff %W}
629 bind . <Button-1> "click %W"
630 bind $fstring <Key-Return> dofind
631 bind $sha1entry <Key-Return> gotocommit
632 bind $sha1entry <<PasteSelection>> clearsha1
633 bind $cflist <1> {sel_flist %W %x %y; break}
634 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
635 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
637 set maincursor [. cget -cursor]
638 set textcursor [$ctext cget -cursor]
639 set curtextcursor $textcursor
641 set rowctxmenu .rowctxmenu
642 menu $rowctxmenu -tearoff 0
643 $rowctxmenu add command -label "Diff this -> selected" \
644 -command {diffvssel 0}
645 $rowctxmenu add command -label "Diff selected -> this" \
646 -command {diffvssel 1}
647 $rowctxmenu add command -label "Make patch" -command mkpatch
648 $rowctxmenu add command -label "Create tag" -command mktag
649 $rowctxmenu add command -label "Write commit to file" -command writecommit
652 # mouse-2 makes all windows scan vertically, but only the one
653 # the cursor is in scans horizontally
654 proc canvscan {op w x y} {
655 global canv canv2 canv3
656 foreach c [list $canv $canv2 $canv3] {
657 if {$c == $w} {
658 $c scan $op $x $y
659 } else {
660 $c scan $op 0 $y
665 proc scrollcanv {cscroll f0 f1} {
666 $cscroll set $f0 $f1
667 drawfrac $f0 $f1
670 # when we make a key binding for the toplevel, make sure
671 # it doesn't get triggered when that key is pressed in the
672 # find string entry widget.
673 proc bindkey {ev script} {
674 global entries
675 bind . $ev $script
676 set escript [bind Entry $ev]
677 if {$escript == {}} {
678 set escript [bind Entry <Key>]
680 foreach e $entries {
681 bind $e $ev "$escript; break"
685 # set the focus back to the toplevel for any click outside
686 # the entry widgets
687 proc click {w} {
688 global entries
689 foreach e $entries {
690 if {$w == $e} return
692 focus .
695 proc savestuff {w} {
696 global canv canv2 canv3 ctext cflist mainfont textfont uifont
697 global stuffsaved findmergefiles maxgraphpct
698 global maxwidth
699 global viewname viewfiles viewargs viewperm nextviewnum
700 global cmitmode wrapcomment
702 if {$stuffsaved} return
703 if {![winfo viewable .]} return
704 catch {
705 set f [open "~/.gitk-new" w]
706 puts $f [list set mainfont $mainfont]
707 puts $f [list set textfont $textfont]
708 puts $f [list set uifont $uifont]
709 puts $f [list set findmergefiles $findmergefiles]
710 puts $f [list set maxgraphpct $maxgraphpct]
711 puts $f [list set maxwidth $maxwidth]
712 puts $f [list set cmitmode $cmitmode]
713 puts $f [list set wrapcomment $wrapcomment]
714 puts $f "set geometry(width) [winfo width .ctop]"
715 puts $f "set geometry(height) [winfo height .ctop]"
716 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
717 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
718 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
719 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
720 set wid [expr {([winfo width $ctext] - 8) \
721 / [font measure $textfont "0"]}]
722 puts $f "set geometry(ctextw) $wid"
723 set wid [expr {([winfo width $cflist] - 11) \
724 / [font measure [$cflist cget -font] "0"]}]
725 puts $f "set geometry(cflistw) $wid"
726 puts -nonewline $f "set permviews {"
727 for {set v 0} {$v < $nextviewnum} {incr v} {
728 if {$viewperm($v)} {
729 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
732 puts $f "}"
733 close $f
734 file rename -force "~/.gitk-new" "~/.gitk"
736 set stuffsaved 1
739 proc resizeclistpanes {win w} {
740 global oldwidth
741 if {[info exists oldwidth($win)]} {
742 set s0 [$win sash coord 0]
743 set s1 [$win sash coord 1]
744 if {$w < 60} {
745 set sash0 [expr {int($w/2 - 2)}]
746 set sash1 [expr {int($w*5/6 - 2)}]
747 } else {
748 set factor [expr {1.0 * $w / $oldwidth($win)}]
749 set sash0 [expr {int($factor * [lindex $s0 0])}]
750 set sash1 [expr {int($factor * [lindex $s1 0])}]
751 if {$sash0 < 30} {
752 set sash0 30
754 if {$sash1 < $sash0 + 20} {
755 set sash1 [expr {$sash0 + 20}]
757 if {$sash1 > $w - 10} {
758 set sash1 [expr {$w - 10}]
759 if {$sash0 > $sash1 - 20} {
760 set sash0 [expr {$sash1 - 20}]
764 $win sash place 0 $sash0 [lindex $s0 1]
765 $win sash place 1 $sash1 [lindex $s1 1]
767 set oldwidth($win) $w
770 proc resizecdetpanes {win w} {
771 global oldwidth
772 if {[info exists oldwidth($win)]} {
773 set s0 [$win sash coord 0]
774 if {$w < 60} {
775 set sash0 [expr {int($w*3/4 - 2)}]
776 } else {
777 set factor [expr {1.0 * $w / $oldwidth($win)}]
778 set sash0 [expr {int($factor * [lindex $s0 0])}]
779 if {$sash0 < 45} {
780 set sash0 45
782 if {$sash0 > $w - 15} {
783 set sash0 [expr {$w - 15}]
786 $win sash place 0 $sash0 [lindex $s0 1]
788 set oldwidth($win) $w
791 proc allcanvs args {
792 global canv canv2 canv3
793 eval $canv $args
794 eval $canv2 $args
795 eval $canv3 $args
798 proc bindall {event action} {
799 global canv canv2 canv3
800 bind $canv $event $action
801 bind $canv2 $event $action
802 bind $canv3 $event $action
805 proc about {} {
806 set w .about
807 if {[winfo exists $w]} {
808 raise $w
809 return
811 toplevel $w
812 wm title $w "About gitk"
813 message $w.m -text {
814 Gitk - a commit viewer for git
816 Copyright © 2005-2006 Paul Mackerras
818 Use and redistribute under the terms of the GNU General Public License} \
819 -justify center -aspect 400
820 pack $w.m -side top -fill x -padx 20 -pady 20
821 button $w.ok -text Close -command "destroy $w"
822 pack $w.ok -side bottom
825 proc keys {} {
826 set w .keys
827 if {[winfo exists $w]} {
828 raise $w
829 return
831 toplevel $w
832 wm title $w "Gitk key bindings"
833 message $w.m -text {
834 Gitk key bindings:
836 <Ctrl-Q> Quit
837 <Home> Move to first commit
838 <End> Move to last commit
839 <Up>, p, i Move up one commit
840 <Down>, n, k Move down one commit
841 <Left>, z, j Go back in history list
842 <Right>, x, l Go forward in history list
843 <PageUp> Move up one page in commit list
844 <PageDown> Move down one page in commit list
845 <Ctrl-Home> Scroll to top of commit list
846 <Ctrl-End> Scroll to bottom of commit list
847 <Ctrl-Up> Scroll commit list up one line
848 <Ctrl-Down> Scroll commit list down one line
849 <Ctrl-PageUp> Scroll commit list up one page
850 <Ctrl-PageDown> Scroll commit list down one page
851 <Delete>, b Scroll diff view up one page
852 <Backspace> Scroll diff view up one page
853 <Space> Scroll diff view down one page
854 u Scroll diff view up 18 lines
855 d Scroll diff view down 18 lines
856 <Ctrl-F> Find
857 <Ctrl-G> Move to next find hit
858 <Ctrl-R> Move to previous find hit
859 <Return> Move to next find hit
860 / Move to next find hit, or redo find
861 ? Move to previous find hit
862 f Scroll diff view to next file
863 <Ctrl-KP+> Increase font size
864 <Ctrl-plus> Increase font size
865 <Ctrl-KP-> Decrease font size
866 <Ctrl-minus> Decrease font size
868 -justify left -bg white -border 2 -relief sunken
869 pack $w.m -side top -fill both
870 button $w.ok -text Close -command "destroy $w"
871 pack $w.ok -side bottom
874 # Procedures for manipulating the file list window at the
875 # bottom right of the overall window.
877 proc treeview {w l openlevs} {
878 global treecontents treediropen treeheight treeparent treeindex
880 set ix 0
881 set treeindex() 0
882 set lev 0
883 set prefix {}
884 set prefixend -1
885 set prefendstack {}
886 set htstack {}
887 set ht 0
888 set treecontents() {}
889 $w conf -state normal
890 foreach f $l {
891 while {[string range $f 0 $prefixend] ne $prefix} {
892 if {$lev <= $openlevs} {
893 $w mark set e:$treeindex($prefix) "end -1c"
894 $w mark gravity e:$treeindex($prefix) left
896 set treeheight($prefix) $ht
897 incr ht [lindex $htstack end]
898 set htstack [lreplace $htstack end end]
899 set prefixend [lindex $prefendstack end]
900 set prefendstack [lreplace $prefendstack end end]
901 set prefix [string range $prefix 0 $prefixend]
902 incr lev -1
904 set tail [string range $f [expr {$prefixend+1}] end]
905 while {[set slash [string first "/" $tail]] >= 0} {
906 lappend htstack $ht
907 set ht 0
908 lappend prefendstack $prefixend
909 incr prefixend [expr {$slash + 1}]
910 set d [string range $tail 0 $slash]
911 lappend treecontents($prefix) $d
912 set oldprefix $prefix
913 append prefix $d
914 set treecontents($prefix) {}
915 set treeindex($prefix) [incr ix]
916 set treeparent($prefix) $oldprefix
917 set tail [string range $tail [expr {$slash+1}] end]
918 if {$lev <= $openlevs} {
919 set ht 1
920 set treediropen($prefix) [expr {$lev < $openlevs}]
921 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
922 $w mark set d:$ix "end -1c"
923 $w mark gravity d:$ix left
924 set str "\n"
925 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
926 $w insert end $str
927 $w image create end -align center -image $bm -padx 1 \
928 -name a:$ix
929 $w insert end $d
930 $w mark set s:$ix "end -1c"
931 $w mark gravity s:$ix left
933 incr lev
935 if {$tail ne {}} {
936 if {$lev <= $openlevs} {
937 incr ht
938 set str "\n"
939 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
940 $w insert end $str
941 $w insert end $tail
943 lappend treecontents($prefix) $tail
946 while {$htstack ne {}} {
947 set treeheight($prefix) $ht
948 incr ht [lindex $htstack end]
949 set htstack [lreplace $htstack end end]
951 $w conf -state disabled
954 proc linetoelt {l} {
955 global treeheight treecontents
957 set y 2
958 set prefix {}
959 while {1} {
960 foreach e $treecontents($prefix) {
961 if {$y == $l} {
962 return "$prefix$e"
964 set n 1
965 if {[string index $e end] eq "/"} {
966 set n $treeheight($prefix$e)
967 if {$y + $n > $l} {
968 append prefix $e
969 incr y
970 break
973 incr y $n
978 proc treeclosedir {w dir} {
979 global treediropen treeheight treeparent treeindex
981 set ix $treeindex($dir)
982 $w conf -state normal
983 $w delete s:$ix e:$ix
984 set treediropen($dir) 0
985 $w image configure a:$ix -image tri-rt
986 $w conf -state disabled
987 set n [expr {1 - $treeheight($dir)}]
988 while {$dir ne {}} {
989 incr treeheight($dir) $n
990 set dir $treeparent($dir)
994 proc treeopendir {w dir} {
995 global treediropen treeheight treeparent treecontents treeindex
997 set ix $treeindex($dir)
998 $w conf -state normal
999 $w image configure a:$ix -image tri-dn
1000 $w mark set e:$ix s:$ix
1001 $w mark gravity e:$ix right
1002 set lev 0
1003 set str "\n"
1004 set n [llength $treecontents($dir)]
1005 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1006 incr lev
1007 append str "\t"
1008 incr treeheight($x) $n
1010 foreach e $treecontents($dir) {
1011 if {[string index $e end] eq "/"} {
1012 set de $dir$e
1013 set iy $treeindex($de)
1014 $w mark set d:$iy e:$ix
1015 $w mark gravity d:$iy left
1016 $w insert e:$ix $str
1017 set treediropen($de) 0
1018 $w image create e:$ix -align center -image tri-rt -padx 1 \
1019 -name a:$iy
1020 $w insert e:$ix $e
1021 $w mark set s:$iy e:$ix
1022 $w mark gravity s:$iy left
1023 set treeheight($de) 1
1024 } else {
1025 $w insert e:$ix $str
1026 $w insert e:$ix $e
1029 $w mark gravity e:$ix left
1030 $w conf -state disabled
1031 set treediropen($dir) 1
1032 set top [lindex [split [$w index @0,0] .] 0]
1033 set ht [$w cget -height]
1034 set l [lindex [split [$w index s:$ix] .] 0]
1035 if {$l < $top} {
1036 $w yview $l.0
1037 } elseif {$l + $n + 1 > $top + $ht} {
1038 set top [expr {$l + $n + 2 - $ht}]
1039 if {$l < $top} {
1040 set top $l
1042 $w yview $top.0
1046 proc treeclick {w x y} {
1047 global treediropen cmitmode ctext cflist cflist_top
1049 if {$cmitmode ne "tree"} return
1050 if {![info exists cflist_top]} return
1051 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1052 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1053 $cflist tag add highlight $l.0 "$l.0 lineend"
1054 set cflist_top $l
1055 if {$l == 1} {
1056 $ctext yview 1.0
1057 return
1059 set e [linetoelt $l]
1060 if {[string index $e end] ne "/"} {
1061 showfile $e
1062 } elseif {$treediropen($e)} {
1063 treeclosedir $w $e
1064 } else {
1065 treeopendir $w $e
1069 proc setfilelist {id} {
1070 global treefilelist cflist
1072 treeview $cflist $treefilelist($id) 0
1075 image create bitmap tri-rt -background black -foreground blue -data {
1076 #define tri-rt_width 13
1077 #define tri-rt_height 13
1078 static unsigned char tri-rt_bits[] = {
1079 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1080 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1081 0x00, 0x00};
1082 } -maskdata {
1083 #define tri-rt-mask_width 13
1084 #define tri-rt-mask_height 13
1085 static unsigned char tri-rt-mask_bits[] = {
1086 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1087 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1088 0x08, 0x00};
1090 image create bitmap tri-dn -background black -foreground blue -data {
1091 #define tri-dn_width 13
1092 #define tri-dn_height 13
1093 static unsigned char tri-dn_bits[] = {
1094 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1095 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1096 0x00, 0x00};
1097 } -maskdata {
1098 #define tri-dn-mask_width 13
1099 #define tri-dn-mask_height 13
1100 static unsigned char tri-dn-mask_bits[] = {
1101 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1102 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1103 0x00, 0x00};
1106 proc init_flist {first} {
1107 global cflist cflist_top selectedline difffilestart
1109 $cflist conf -state normal
1110 $cflist delete 0.0 end
1111 if {$first ne {}} {
1112 $cflist insert end $first
1113 set cflist_top 1
1114 $cflist tag add highlight 1.0 "1.0 lineend"
1115 } else {
1116 catch {unset cflist_top}
1118 $cflist conf -state disabled
1119 set difffilestart {}
1122 proc add_flist {fl} {
1123 global flistmode cflist
1125 $cflist conf -state normal
1126 if {$flistmode eq "flat"} {
1127 foreach f $fl {
1128 $cflist insert end "\n$f"
1131 $cflist conf -state disabled
1134 proc sel_flist {w x y} {
1135 global flistmode ctext difffilestart cflist cflist_top cmitmode
1137 if {$cmitmode eq "tree"} return
1138 if {![info exists cflist_top]} return
1139 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1140 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1141 $cflist tag add highlight $l.0 "$l.0 lineend"
1142 set cflist_top $l
1143 if {$l == 1} {
1144 $ctext yview 1.0
1145 } else {
1146 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1150 # Functions for adding and removing shell-type quoting
1152 proc shellquote {str} {
1153 if {![string match "*\['\"\\ \t]*" $str]} {
1154 return $str
1156 if {![string match "*\['\"\\]*" $str]} {
1157 return "\"$str\""
1159 if {![string match "*'*" $str]} {
1160 return "'$str'"
1162 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1165 proc shellarglist {l} {
1166 set str {}
1167 foreach a $l {
1168 if {$str ne {}} {
1169 append str " "
1171 append str [shellquote $a]
1173 return $str
1176 proc shelldequote {str} {
1177 set ret {}
1178 set used -1
1179 while {1} {
1180 incr used
1181 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1182 append ret [string range $str $used end]
1183 set used [string length $str]
1184 break
1186 set first [lindex $first 0]
1187 set ch [string index $str $first]
1188 if {$first > $used} {
1189 append ret [string range $str $used [expr {$first - 1}]]
1190 set used $first
1192 if {$ch eq " " || $ch eq "\t"} break
1193 incr used
1194 if {$ch eq "'"} {
1195 set first [string first "'" $str $used]
1196 if {$first < 0} {
1197 error "unmatched single-quote"
1199 append ret [string range $str $used [expr {$first - 1}]]
1200 set used $first
1201 continue
1203 if {$ch eq "\\"} {
1204 if {$used >= [string length $str]} {
1205 error "trailing backslash"
1207 append ret [string index $str $used]
1208 continue
1210 # here ch == "\""
1211 while {1} {
1212 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1213 error "unmatched double-quote"
1215 set first [lindex $first 0]
1216 set ch [string index $str $first]
1217 if {$first > $used} {
1218 append ret [string range $str $used [expr {$first - 1}]]
1219 set used $first
1221 if {$ch eq "\""} break
1222 incr used
1223 append ret [string index $str $used]
1224 incr used
1227 return [list $used $ret]
1230 proc shellsplit {str} {
1231 set l {}
1232 while {1} {
1233 set str [string trimleft $str]
1234 if {$str eq {}} break
1235 set dq [shelldequote $str]
1236 set n [lindex $dq 0]
1237 set word [lindex $dq 1]
1238 set str [string range $str $n end]
1239 lappend l $word
1241 return $l
1244 # Code to implement multiple views
1246 proc newview {ishighlight} {
1247 global nextviewnum newviewname newviewperm uifont newishighlight
1248 global newviewargs revtreeargs
1250 set newishighlight $ishighlight
1251 set top .gitkview
1252 if {[winfo exists $top]} {
1253 raise $top
1254 return
1256 set newviewname($nextviewnum) "View $nextviewnum"
1257 set newviewperm($nextviewnum) 0
1258 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1259 vieweditor $top $nextviewnum "Gitk view definition"
1262 proc editview {} {
1263 global curview
1264 global viewname viewperm newviewname newviewperm
1265 global viewargs newviewargs
1267 set top .gitkvedit-$curview
1268 if {[winfo exists $top]} {
1269 raise $top
1270 return
1272 set newviewname($curview) $viewname($curview)
1273 set newviewperm($curview) $viewperm($curview)
1274 set newviewargs($curview) [shellarglist $viewargs($curview)]
1275 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1278 proc vieweditor {top n title} {
1279 global newviewname newviewperm viewfiles
1280 global uifont
1282 toplevel $top
1283 wm title $top $title
1284 label $top.nl -text "Name" -font $uifont
1285 entry $top.name -width 20 -textvariable newviewname($n)
1286 grid $top.nl $top.name -sticky w -pady 5
1287 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1288 grid $top.perm - -pady 5 -sticky w
1289 message $top.al -aspect 1000 -font $uifont \
1290 -text "Commits to include (arguments to git rev-list):"
1291 grid $top.al - -sticky w -pady 5
1292 entry $top.args -width 50 -textvariable newviewargs($n) \
1293 -background white
1294 grid $top.args - -sticky ew -padx 5
1295 message $top.l -aspect 1000 -font $uifont \
1296 -text "Enter files and directories to include, one per line:"
1297 grid $top.l - -sticky w
1298 text $top.t -width 40 -height 10 -background white
1299 if {[info exists viewfiles($n)]} {
1300 foreach f $viewfiles($n) {
1301 $top.t insert end $f
1302 $top.t insert end "\n"
1304 $top.t delete {end - 1c} end
1305 $top.t mark set insert 0.0
1307 grid $top.t - -sticky ew -padx 5
1308 frame $top.buts
1309 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1310 button $top.buts.can -text "Cancel" -command [list destroy $top]
1311 grid $top.buts.ok $top.buts.can
1312 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1313 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1314 grid $top.buts - -pady 10 -sticky ew
1315 focus $top.t
1318 proc doviewmenu {m first cmd op args} {
1319 set nmenu [$m index end]
1320 for {set i $first} {$i <= $nmenu} {incr i} {
1321 if {[$m entrycget $i -command] eq $cmd} {
1322 eval $m $op $i $args
1323 break
1328 proc allviewmenus {n op args} {
1329 doviewmenu .bar.view 7 [list showview $n] $op $args
1330 doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1333 proc newviewok {top n} {
1334 global nextviewnum newviewperm newviewname newishighlight
1335 global viewname viewfiles viewperm selectedview curview
1336 global viewargs newviewargs
1338 if {[catch {
1339 set newargs [shellsplit $newviewargs($n)]
1340 } err]} {
1341 error_popup "Error in commit selection arguments: $err"
1342 wm raise $top
1343 focus $top
1344 return
1346 set files {}
1347 foreach f [split [$top.t get 0.0 end] "\n"] {
1348 set ft [string trim $f]
1349 if {$ft ne {}} {
1350 lappend files $ft
1353 if {![info exists viewfiles($n)]} {
1354 # creating a new view
1355 incr nextviewnum
1356 set viewname($n) $newviewname($n)
1357 set viewperm($n) $newviewperm($n)
1358 set viewfiles($n) $files
1359 set viewargs($n) $newargs
1360 addviewmenu $n
1361 if {!$newishighlight} {
1362 after idle showview $n
1363 } else {
1364 after idle addhighlight $n
1366 } else {
1367 # editing an existing view
1368 set viewperm($n) $newviewperm($n)
1369 if {$newviewname($n) ne $viewname($n)} {
1370 set viewname($n) $newviewname($n)
1371 allviewmenus $n entryconf -label $viewname($n)
1373 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1374 set viewfiles($n) $files
1375 set viewargs($n) $newargs
1376 if {$curview == $n} {
1377 after idle updatecommits
1381 catch {destroy $top}
1384 proc delview {} {
1385 global curview viewdata viewperm
1387 if {$curview == 0} return
1388 allviewmenus $curview delete
1389 set viewdata($curview) {}
1390 set viewperm($curview) 0
1391 showview 0
1394 proc addviewmenu {n} {
1395 global viewname
1397 .bar.view add radiobutton -label $viewname($n) \
1398 -command [list showview $n] -variable selectedview -value $n
1399 .bar.view.hl add radiobutton -label $viewname($n) \
1400 -command [list addhighlight $n] -variable selectedhlview -value $n
1403 proc flatten {var} {
1404 global $var
1406 set ret {}
1407 foreach i [array names $var] {
1408 lappend ret $i [set $var\($i\)]
1410 return $ret
1413 proc unflatten {var l} {
1414 global $var
1416 catch {unset $var}
1417 foreach {i v} $l {
1418 set $var\($i\) $v
1422 proc showview {n} {
1423 global curview viewdata viewfiles
1424 global displayorder parentlist childlist rowidlist rowoffsets
1425 global colormap rowtextx commitrow nextcolor canvxmax
1426 global numcommits rowrangelist commitlisted idrowranges
1427 global selectedline currentid canv canvy0
1428 global matchinglines treediffs
1429 global pending_select phase
1430 global commitidx rowlaidout rowoptim linesegends
1431 global commfd nextupdate
1432 global selectedview hlview selectedhlview
1433 global vparentlist vchildlist vdisporder vcmitlisted
1435 if {$n == $curview} return
1436 set selid {}
1437 if {[info exists selectedline]} {
1438 set selid $currentid
1439 set y [yc $selectedline]
1440 set ymax [lindex [$canv cget -scrollregion] 3]
1441 set span [$canv yview]
1442 set ytop [expr {[lindex $span 0] * $ymax}]
1443 set ybot [expr {[lindex $span 1] * $ymax}]
1444 if {$ytop < $y && $y < $ybot} {
1445 set yscreen [expr {$y - $ytop}]
1446 } else {
1447 set yscreen [expr {($ybot - $ytop) / 2}]
1450 unselectline
1451 normalline
1452 stopfindproc
1453 if {$curview >= 0} {
1454 set vparentlist($curview) $parentlist
1455 set vchildlist($curview) $childlist
1456 set vdisporder($curview) $displayorder
1457 set vcmitlisted($curview) $commitlisted
1458 if {$phase ne {}} {
1459 set viewdata($curview) \
1460 [list $phase $rowidlist $rowoffsets $rowrangelist \
1461 [flatten idrowranges] [flatten idinlist] \
1462 $rowlaidout $rowoptim $numcommits $linesegends]
1463 } elseif {![info exists viewdata($curview)]
1464 || [lindex $viewdata($curview) 0] ne {}} {
1465 set viewdata($curview) \
1466 [list {} $rowidlist $rowoffsets $rowrangelist]
1469 catch {unset matchinglines}
1470 catch {unset treediffs}
1471 clear_display
1473 set curview $n
1474 set selectedview $n
1475 set selectedhlview -1
1476 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1477 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1478 catch {unset hlview}
1479 .bar.view.hl entryconf 1 -state disabled
1481 if {![info exists viewdata($n)]} {
1482 set pending_select $selid
1483 getcommits
1484 return
1487 set v $viewdata($n)
1488 set phase [lindex $v 0]
1489 set displayorder $vdisporder($n)
1490 set parentlist $vparentlist($n)
1491 set childlist $vchildlist($n)
1492 set commitlisted $vcmitlisted($n)
1493 set rowidlist [lindex $v 1]
1494 set rowoffsets [lindex $v 2]
1495 set rowrangelist [lindex $v 3]
1496 if {$phase eq {}} {
1497 set numcommits [llength $displayorder]
1498 catch {unset idrowranges}
1499 } else {
1500 unflatten idrowranges [lindex $v 4]
1501 unflatten idinlist [lindex $v 5]
1502 set rowlaidout [lindex $v 6]
1503 set rowoptim [lindex $v 7]
1504 set numcommits [lindex $v 8]
1505 set linesegends [lindex $v 9]
1508 catch {unset colormap}
1509 catch {unset rowtextx}
1510 set nextcolor 0
1511 set canvxmax [$canv cget -width]
1512 set curview $n
1513 set row 0
1514 setcanvscroll
1515 set yf 0
1516 set row 0
1517 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1518 set row $commitrow($n,$selid)
1519 # try to get the selected row in the same position on the screen
1520 set ymax [lindex [$canv cget -scrollregion] 3]
1521 set ytop [expr {[yc $row] - $yscreen}]
1522 if {$ytop < 0} {
1523 set ytop 0
1525 set yf [expr {$ytop * 1.0 / $ymax}]
1527 allcanvs yview moveto $yf
1528 drawvisible
1529 selectline $row 0
1530 if {$phase ne {}} {
1531 if {$phase eq "getcommits"} {
1532 show_status "Reading commits..."
1534 if {[info exists commfd($n)]} {
1535 layoutmore
1536 } else {
1537 finishcommits
1539 } elseif {$numcommits == 0} {
1540 show_status "No commits selected"
1544 proc addhighlight {n} {
1545 global hlview curview viewdata highlighted highlightedrows
1546 global selectedhlview
1548 if {[info exists hlview]} {
1549 delhighlight
1551 set hlview $n
1552 set selectedhlview $n
1553 .bar.view.hl entryconf 1 -state normal
1554 set highlighted($n) 0
1555 set highlightedrows {}
1556 if {$n != $curview && ![info exists viewdata($n)]} {
1557 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1558 set vparentlist($n) {}
1559 set vchildlist($n) {}
1560 set vdisporder($n) {}
1561 set vcmitlisted($n) {}
1562 start_rev_list $n
1563 } else {
1564 highlightmore
1568 proc delhighlight {} {
1569 global hlview highlightedrows canv linehtag mainfont
1570 global selectedhlview selectedline
1572 if {![info exists hlview]} return
1573 unset hlview
1574 set selectedhlview {}
1575 .bar.view.hl entryconf 1 -state disabled
1576 foreach l $highlightedrows {
1577 $canv itemconf $linehtag($l) -font $mainfont
1578 if {$l == $selectedline} {
1579 $canv delete secsel
1580 set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1581 -outline {{}} -tags secsel \
1582 -fill [$canv cget -selectbackground]]
1583 $canv lower $t
1588 proc highlightmore {} {
1589 global hlview highlighted commitidx highlightedrows linehtag mainfont
1590 global displayorder vdisporder curview canv commitrow selectedline
1592 set font [concat $mainfont bold]
1593 set max $commitidx($hlview)
1594 if {$hlview == $curview} {
1595 set disp $displayorder
1596 } else {
1597 set disp $vdisporder($hlview)
1599 for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1600 set id [lindex $disp $i]
1601 if {[info exists commitrow($curview,$id)]} {
1602 set row $commitrow($curview,$id)
1603 if {[info exists linehtag($row)]} {
1604 $canv itemconf $linehtag($row) -font $font
1605 lappend highlightedrows $row
1606 if {$row == $selectedline} {
1607 $canv delete secsel
1608 set t [eval $canv create rect \
1609 [$canv bbox $linehtag($row)] \
1610 -outline {{}} -tags secsel \
1611 -fill [$canv cget -selectbackground]]
1612 $canv lower $t
1617 set highlighted($hlview) $max
1620 # Graph layout functions
1622 proc shortids {ids} {
1623 set res {}
1624 foreach id $ids {
1625 if {[llength $id] > 1} {
1626 lappend res [shortids $id]
1627 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1628 lappend res [string range $id 0 7]
1629 } else {
1630 lappend res $id
1633 return $res
1636 proc incrange {l x o} {
1637 set n [llength $l]
1638 while {$x < $n} {
1639 set e [lindex $l $x]
1640 if {$e ne {}} {
1641 lset l $x [expr {$e + $o}]
1643 incr x
1645 return $l
1648 proc ntimes {n o} {
1649 set ret {}
1650 for {} {$n > 0} {incr n -1} {
1651 lappend ret $o
1653 return $ret
1656 proc usedinrange {id l1 l2} {
1657 global children commitrow childlist curview
1659 if {[info exists commitrow($curview,$id)]} {
1660 set r $commitrow($curview,$id)
1661 if {$l1 <= $r && $r <= $l2} {
1662 return [expr {$r - $l1 + 1}]
1664 set kids [lindex $childlist $r]
1665 } else {
1666 set kids $children($curview,$id)
1668 foreach c $kids {
1669 set r $commitrow($curview,$c)
1670 if {$l1 <= $r && $r <= $l2} {
1671 return [expr {$r - $l1 + 1}]
1674 return 0
1677 proc sanity {row {full 0}} {
1678 global rowidlist rowoffsets
1680 set col -1
1681 set ids [lindex $rowidlist $row]
1682 foreach id $ids {
1683 incr col
1684 if {$id eq {}} continue
1685 if {$col < [llength $ids] - 1 &&
1686 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1687 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1689 set o [lindex $rowoffsets $row $col]
1690 set y $row
1691 set x $col
1692 while {$o ne {}} {
1693 incr y -1
1694 incr x $o
1695 if {[lindex $rowidlist $y $x] != $id} {
1696 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1697 puts " id=[shortids $id] check started at row $row"
1698 for {set i $row} {$i >= $y} {incr i -1} {
1699 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1701 break
1703 if {!$full} break
1704 set o [lindex $rowoffsets $y $x]
1709 proc makeuparrow {oid x y z} {
1710 global rowidlist rowoffsets uparrowlen idrowranges
1712 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1713 incr y -1
1714 incr x $z
1715 set off0 [lindex $rowoffsets $y]
1716 for {set x0 $x} {1} {incr x0} {
1717 if {$x0 >= [llength $off0]} {
1718 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1719 break
1721 set z [lindex $off0 $x0]
1722 if {$z ne {}} {
1723 incr x0 $z
1724 break
1727 set z [expr {$x0 - $x}]
1728 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1729 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1731 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1732 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1733 lappend idrowranges($oid) $y
1736 proc initlayout {} {
1737 global rowidlist rowoffsets displayorder commitlisted
1738 global rowlaidout rowoptim
1739 global idinlist rowchk rowrangelist idrowranges
1740 global numcommits canvxmax canv
1741 global nextcolor
1742 global parentlist childlist children
1743 global colormap rowtextx
1744 global linesegends
1746 set numcommits 0
1747 set displayorder {}
1748 set commitlisted {}
1749 set parentlist {}
1750 set childlist {}
1751 set rowrangelist {}
1752 set nextcolor 0
1753 set rowidlist {{}}
1754 set rowoffsets {{}}
1755 catch {unset idinlist}
1756 catch {unset rowchk}
1757 set rowlaidout 0
1758 set rowoptim 0
1759 set canvxmax [$canv cget -width]
1760 catch {unset colormap}
1761 catch {unset rowtextx}
1762 catch {unset idrowranges}
1763 set linesegends {}
1766 proc setcanvscroll {} {
1767 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1769 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1770 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1771 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1772 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1775 proc visiblerows {} {
1776 global canv numcommits linespc
1778 set ymax [lindex [$canv cget -scrollregion] 3]
1779 if {$ymax eq {} || $ymax == 0} return
1780 set f [$canv yview]
1781 set y0 [expr {int([lindex $f 0] * $ymax)}]
1782 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1783 if {$r0 < 0} {
1784 set r0 0
1786 set y1 [expr {int([lindex $f 1] * $ymax)}]
1787 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1788 if {$r1 >= $numcommits} {
1789 set r1 [expr {$numcommits - 1}]
1791 return [list $r0 $r1]
1794 proc layoutmore {} {
1795 global rowlaidout rowoptim commitidx numcommits optim_delay
1796 global uparrowlen curview
1798 set row $rowlaidout
1799 set rowlaidout [layoutrows $row $commitidx($curview) 0]
1800 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1801 if {$orow > $rowoptim} {
1802 optimize_rows $rowoptim 0 $orow
1803 set rowoptim $orow
1805 set canshow [expr {$rowoptim - $optim_delay}]
1806 if {$canshow > $numcommits} {
1807 showstuff $canshow
1811 proc showstuff {canshow} {
1812 global numcommits commitrow pending_select selectedline
1813 global linesegends idrowranges idrangedrawn curview
1815 if {$numcommits == 0} {
1816 global phase
1817 set phase "incrdraw"
1818 allcanvs delete all
1820 set row $numcommits
1821 set numcommits $canshow
1822 setcanvscroll
1823 set rows [visiblerows]
1824 set r0 [lindex $rows 0]
1825 set r1 [lindex $rows 1]
1826 set selrow -1
1827 for {set r $row} {$r < $canshow} {incr r} {
1828 foreach id [lindex $linesegends [expr {$r+1}]] {
1829 set i -1
1830 foreach {s e} [rowranges $id] {
1831 incr i
1832 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1833 && ![info exists idrangedrawn($id,$i)]} {
1834 drawlineseg $id $i
1835 set idrangedrawn($id,$i) 1
1840 if {$canshow > $r1} {
1841 set canshow $r1
1843 while {$row < $canshow} {
1844 drawcmitrow $row
1845 incr row
1847 if {[info exists pending_select] &&
1848 [info exists commitrow($curview,$pending_select)] &&
1849 $commitrow($curview,$pending_select) < $numcommits} {
1850 selectline $commitrow($curview,$pending_select) 1
1852 if {![info exists selectedline] && ![info exists pending_select]} {
1853 selectline 0 1
1857 proc layoutrows {row endrow last} {
1858 global rowidlist rowoffsets displayorder
1859 global uparrowlen downarrowlen maxwidth mingaplen
1860 global childlist parentlist
1861 global idrowranges linesegends
1862 global commitidx curview
1863 global idinlist rowchk rowrangelist
1865 set idlist [lindex $rowidlist $row]
1866 set offs [lindex $rowoffsets $row]
1867 while {$row < $endrow} {
1868 set id [lindex $displayorder $row]
1869 set oldolds {}
1870 set newolds {}
1871 foreach p [lindex $parentlist $row] {
1872 if {![info exists idinlist($p)]} {
1873 lappend newolds $p
1874 } elseif {!$idinlist($p)} {
1875 lappend oldolds $p
1878 set lse {}
1879 set nev [expr {[llength $idlist] + [llength $newolds]
1880 + [llength $oldolds] - $maxwidth + 1}]
1881 if {$nev > 0} {
1882 if {!$last &&
1883 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1884 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1885 set i [lindex $idlist $x]
1886 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1887 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1888 [expr {$row + $uparrowlen + $mingaplen}]]
1889 if {$r == 0} {
1890 set idlist [lreplace $idlist $x $x]
1891 set offs [lreplace $offs $x $x]
1892 set offs [incrange $offs $x 1]
1893 set idinlist($i) 0
1894 set rm1 [expr {$row - 1}]
1895 lappend lse $i
1896 lappend idrowranges($i) $rm1
1897 if {[incr nev -1] <= 0} break
1898 continue
1900 set rowchk($id) [expr {$row + $r}]
1903 lset rowidlist $row $idlist
1904 lset rowoffsets $row $offs
1906 lappend linesegends $lse
1907 set col [lsearch -exact $idlist $id]
1908 if {$col < 0} {
1909 set col [llength $idlist]
1910 lappend idlist $id
1911 lset rowidlist $row $idlist
1912 set z {}
1913 if {[lindex $childlist $row] ne {}} {
1914 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1915 unset idinlist($id)
1917 lappend offs $z
1918 lset rowoffsets $row $offs
1919 if {$z ne {}} {
1920 makeuparrow $id $col $row $z
1922 } else {
1923 unset idinlist($id)
1925 set ranges {}
1926 if {[info exists idrowranges($id)]} {
1927 set ranges $idrowranges($id)
1928 lappend ranges $row
1929 unset idrowranges($id)
1931 lappend rowrangelist $ranges
1932 incr row
1933 set offs [ntimes [llength $idlist] 0]
1934 set l [llength $newolds]
1935 set idlist [eval lreplace \$idlist $col $col $newolds]
1936 set o 0
1937 if {$l != 1} {
1938 set offs [lrange $offs 0 [expr {$col - 1}]]
1939 foreach x $newolds {
1940 lappend offs {}
1941 incr o -1
1943 incr o
1944 set tmp [expr {[llength $idlist] - [llength $offs]}]
1945 if {$tmp > 0} {
1946 set offs [concat $offs [ntimes $tmp $o]]
1948 } else {
1949 lset offs $col {}
1951 foreach i $newolds {
1952 set idinlist($i) 1
1953 set idrowranges($i) $row
1955 incr col $l
1956 foreach oid $oldolds {
1957 set idinlist($oid) 1
1958 set idlist [linsert $idlist $col $oid]
1959 set offs [linsert $offs $col $o]
1960 makeuparrow $oid $col $row $o
1961 incr col
1963 lappend rowidlist $idlist
1964 lappend rowoffsets $offs
1966 return $row
1969 proc addextraid {id row} {
1970 global displayorder commitrow commitinfo
1971 global commitidx commitlisted
1972 global parentlist childlist children curview
1974 incr commitidx($curview)
1975 lappend displayorder $id
1976 lappend commitlisted 0
1977 lappend parentlist {}
1978 set commitrow($curview,$id) $row
1979 readcommit $id
1980 if {![info exists commitinfo($id)]} {
1981 set commitinfo($id) {"No commit information available"}
1983 if {![info exists children($curview,$id)]} {
1984 set children($curview,$id) {}
1986 lappend childlist $children($curview,$id)
1989 proc layouttail {} {
1990 global rowidlist rowoffsets idinlist commitidx curview
1991 global idrowranges rowrangelist
1993 set row $commitidx($curview)
1994 set idlist [lindex $rowidlist $row]
1995 while {$idlist ne {}} {
1996 set col [expr {[llength $idlist] - 1}]
1997 set id [lindex $idlist $col]
1998 addextraid $id $row
1999 unset idinlist($id)
2000 lappend idrowranges($id) $row
2001 lappend rowrangelist $idrowranges($id)
2002 unset idrowranges($id)
2003 incr row
2004 set offs [ntimes $col 0]
2005 set idlist [lreplace $idlist $col $col]
2006 lappend rowidlist $idlist
2007 lappend rowoffsets $offs
2010 foreach id [array names idinlist] {
2011 addextraid $id $row
2012 lset rowidlist $row [list $id]
2013 lset rowoffsets $row 0
2014 makeuparrow $id 0 $row 0
2015 lappend idrowranges($id) $row
2016 lappend rowrangelist $idrowranges($id)
2017 unset idrowranges($id)
2018 incr row
2019 lappend rowidlist {}
2020 lappend rowoffsets {}
2024 proc insert_pad {row col npad} {
2025 global rowidlist rowoffsets
2027 set pad [ntimes $npad {}]
2028 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2029 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2030 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2033 proc optimize_rows {row col endrow} {
2034 global rowidlist rowoffsets idrowranges displayorder
2036 for {} {$row < $endrow} {incr row} {
2037 set idlist [lindex $rowidlist $row]
2038 set offs [lindex $rowoffsets $row]
2039 set haspad 0
2040 for {} {$col < [llength $offs]} {incr col} {
2041 if {[lindex $idlist $col] eq {}} {
2042 set haspad 1
2043 continue
2045 set z [lindex $offs $col]
2046 if {$z eq {}} continue
2047 set isarrow 0
2048 set x0 [expr {$col + $z}]
2049 set y0 [expr {$row - 1}]
2050 set z0 [lindex $rowoffsets $y0 $x0]
2051 if {$z0 eq {}} {
2052 set id [lindex $idlist $col]
2053 set ranges [rowranges $id]
2054 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2055 set isarrow 1
2058 if {$z < -1 || ($z < 0 && $isarrow)} {
2059 set npad [expr {-1 - $z + $isarrow}]
2060 set offs [incrange $offs $col $npad]
2061 insert_pad $y0 $x0 $npad
2062 if {$y0 > 0} {
2063 optimize_rows $y0 $x0 $row
2065 set z [lindex $offs $col]
2066 set x0 [expr {$col + $z}]
2067 set z0 [lindex $rowoffsets $y0 $x0]
2068 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2069 set npad [expr {$z - 1 + $isarrow}]
2070 set y1 [expr {$row + 1}]
2071 set offs2 [lindex $rowoffsets $y1]
2072 set x1 -1
2073 foreach z $offs2 {
2074 incr x1
2075 if {$z eq {} || $x1 + $z < $col} continue
2076 if {$x1 + $z > $col} {
2077 incr npad
2079 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2080 break
2082 set pad [ntimes $npad {}]
2083 set idlist [eval linsert \$idlist $col $pad]
2084 set tmp [eval linsert \$offs $col $pad]
2085 incr col $npad
2086 set offs [incrange $tmp $col [expr {-$npad}]]
2087 set z [lindex $offs $col]
2088 set haspad 1
2090 if {$z0 eq {} && !$isarrow} {
2091 # this line links to its first child on row $row-2
2092 set rm2 [expr {$row - 2}]
2093 set id [lindex $displayorder $rm2]
2094 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2095 if {$xc >= 0} {
2096 set z0 [expr {$xc - $x0}]
2099 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2100 insert_pad $y0 $x0 1
2101 set offs [incrange $offs $col 1]
2102 optimize_rows $y0 [expr {$x0 + 1}] $row
2105 if {!$haspad} {
2106 set o {}
2107 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2108 set o [lindex $offs $col]
2109 if {$o eq {}} {
2110 # check if this is the link to the first child
2111 set id [lindex $idlist $col]
2112 set ranges [rowranges $id]
2113 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2114 # it is, work out offset to child
2115 set y0 [expr {$row - 1}]
2116 set id [lindex $displayorder $y0]
2117 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2118 if {$x0 >= 0} {
2119 set o [expr {$x0 - $col}]
2123 if {$o eq {} || $o <= 0} break
2125 if {$o ne {} && [incr col] < [llength $idlist]} {
2126 set y1 [expr {$row + 1}]
2127 set offs2 [lindex $rowoffsets $y1]
2128 set x1 -1
2129 foreach z $offs2 {
2130 incr x1
2131 if {$z eq {} || $x1 + $z < $col} continue
2132 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2133 break
2135 set idlist [linsert $idlist $col {}]
2136 set tmp [linsert $offs $col {}]
2137 incr col
2138 set offs [incrange $tmp $col -1]
2141 lset rowidlist $row $idlist
2142 lset rowoffsets $row $offs
2143 set col 0
2147 proc xc {row col} {
2148 global canvx0 linespc
2149 return [expr {$canvx0 + $col * $linespc}]
2152 proc yc {row} {
2153 global canvy0 linespc
2154 return [expr {$canvy0 + $row * $linespc}]
2157 proc linewidth {id} {
2158 global thickerline lthickness
2160 set wid $lthickness
2161 if {[info exists thickerline] && $id eq $thickerline} {
2162 set wid [expr {2 * $lthickness}]
2164 return $wid
2167 proc rowranges {id} {
2168 global phase idrowranges commitrow rowlaidout rowrangelist curview
2170 set ranges {}
2171 if {$phase eq {} ||
2172 ([info exists commitrow($curview,$id)]
2173 && $commitrow($curview,$id) < $rowlaidout)} {
2174 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2175 } elseif {[info exists idrowranges($id)]} {
2176 set ranges $idrowranges($id)
2178 return $ranges
2181 proc drawlineseg {id i} {
2182 global rowoffsets rowidlist
2183 global displayorder
2184 global canv colormap linespc
2185 global numcommits commitrow curview
2187 set ranges [rowranges $id]
2188 set downarrow 1
2189 if {[info exists commitrow($curview,$id)]
2190 && $commitrow($curview,$id) < $numcommits} {
2191 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2192 } else {
2193 set downarrow 1
2195 set startrow [lindex $ranges [expr {2 * $i}]]
2196 set row [lindex $ranges [expr {2 * $i + 1}]]
2197 if {$startrow == $row} return
2198 assigncolor $id
2199 set coords {}
2200 set col [lsearch -exact [lindex $rowidlist $row] $id]
2201 if {$col < 0} {
2202 puts "oops: drawline: id $id not on row $row"
2203 return
2205 set lasto {}
2206 set ns 0
2207 while {1} {
2208 set o [lindex $rowoffsets $row $col]
2209 if {$o eq {}} break
2210 if {$o ne $lasto} {
2211 # changing direction
2212 set x [xc $row $col]
2213 set y [yc $row]
2214 lappend coords $x $y
2215 set lasto $o
2217 incr col $o
2218 incr row -1
2220 set x [xc $row $col]
2221 set y [yc $row]
2222 lappend coords $x $y
2223 if {$i == 0} {
2224 # draw the link to the first child as part of this line
2225 incr row -1
2226 set child [lindex $displayorder $row]
2227 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2228 if {$ccol >= 0} {
2229 set x [xc $row $ccol]
2230 set y [yc $row]
2231 if {$ccol < $col - 1} {
2232 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2233 } elseif {$ccol > $col + 1} {
2234 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2236 lappend coords $x $y
2239 if {[llength $coords] < 4} return
2240 if {$downarrow} {
2241 # This line has an arrow at the lower end: check if the arrow is
2242 # on a diagonal segment, and if so, work around the Tk 8.4
2243 # refusal to draw arrows on diagonal lines.
2244 set x0 [lindex $coords 0]
2245 set x1 [lindex $coords 2]
2246 if {$x0 != $x1} {
2247 set y0 [lindex $coords 1]
2248 set y1 [lindex $coords 3]
2249 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2250 # we have a nearby vertical segment, just trim off the diag bit
2251 set coords [lrange $coords 2 end]
2252 } else {
2253 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2254 set xi [expr {$x0 - $slope * $linespc / 2}]
2255 set yi [expr {$y0 - $linespc / 2}]
2256 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2260 set arrow [expr {2 * ($i > 0) + $downarrow}]
2261 set arrow [lindex {none first last both} $arrow]
2262 set t [$canv create line $coords -width [linewidth $id] \
2263 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2264 $canv lower $t
2265 bindline $t $id
2268 proc drawparentlinks {id row col olds} {
2269 global rowidlist canv colormap
2271 set row2 [expr {$row + 1}]
2272 set x [xc $row $col]
2273 set y [yc $row]
2274 set y2 [yc $row2]
2275 set ids [lindex $rowidlist $row2]
2276 # rmx = right-most X coord used
2277 set rmx 0
2278 foreach p $olds {
2279 set i [lsearch -exact $ids $p]
2280 if {$i < 0} {
2281 puts "oops, parent $p of $id not in list"
2282 continue
2284 set x2 [xc $row2 $i]
2285 if {$x2 > $rmx} {
2286 set rmx $x2
2288 set ranges [rowranges $p]
2289 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2290 && $row2 < [lindex $ranges 1]} {
2291 # drawlineseg will do this one for us
2292 continue
2294 assigncolor $p
2295 # should handle duplicated parents here...
2296 set coords [list $x $y]
2297 if {$i < $col - 1} {
2298 lappend coords [xc $row [expr {$i + 1}]] $y
2299 } elseif {$i > $col + 1} {
2300 lappend coords [xc $row [expr {$i - 1}]] $y
2302 lappend coords $x2 $y2
2303 set t [$canv create line $coords -width [linewidth $p] \
2304 -fill $colormap($p) -tags lines.$p]
2305 $canv lower $t
2306 bindline $t $p
2308 return $rmx
2311 proc drawlines {id} {
2312 global colormap canv
2313 global idrangedrawn
2314 global children iddrawn commitrow rowidlist curview
2316 $canv delete lines.$id
2317 set nr [expr {[llength [rowranges $id]] / 2}]
2318 for {set i 0} {$i < $nr} {incr i} {
2319 if {[info exists idrangedrawn($id,$i)]} {
2320 drawlineseg $id $i
2323 foreach child $children($curview,$id) {
2324 if {[info exists iddrawn($child)]} {
2325 set row $commitrow($curview,$child)
2326 set col [lsearch -exact [lindex $rowidlist $row] $child]
2327 if {$col >= 0} {
2328 drawparentlinks $child $row $col [list $id]
2334 proc drawcmittext {id row col rmx} {
2335 global linespc canv canv2 canv3 canvy0
2336 global commitlisted commitinfo rowidlist
2337 global rowtextx idpos idtags idheads idotherrefs
2338 global linehtag linentag linedtag
2339 global mainfont canvxmax
2340 global hlview commitrow highlightedrows
2342 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2343 set x [xc $row $col]
2344 set y [yc $row]
2345 set orad [expr {$linespc / 3}]
2346 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2347 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2348 -fill $ofill -outline black -width 1]
2349 $canv raise $t
2350 $canv bind $t <1> {selcanvline {} %x %y}
2351 set xt [xc $row [llength [lindex $rowidlist $row]]]
2352 if {$xt < $rmx} {
2353 set xt $rmx
2355 set rowtextx($row) $xt
2356 set idpos($id) [list $x $xt $y]
2357 if {[info exists idtags($id)] || [info exists idheads($id)]
2358 || [info exists idotherrefs($id)]} {
2359 set xt [drawtags $id $x $xt $y]
2361 set headline [lindex $commitinfo($id) 0]
2362 set name [lindex $commitinfo($id) 1]
2363 set date [lindex $commitinfo($id) 2]
2364 set date [formatdate $date]
2365 set font $mainfont
2366 if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2367 lappend font bold
2368 lappend highlightedrows $row
2370 set linehtag($row) [$canv create text $xt $y -anchor w \
2371 -text $headline -font $font]
2372 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2373 set linentag($row) [$canv2 create text 3 $y -anchor w \
2374 -text $name -font $mainfont]
2375 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2376 -text $date -font $mainfont]
2377 set xr [expr {$xt + [font measure $mainfont $headline]}]
2378 if {$xr > $canvxmax} {
2379 set canvxmax $xr
2380 setcanvscroll
2384 proc drawcmitrow {row} {
2385 global displayorder rowidlist
2386 global idrangedrawn iddrawn
2387 global commitinfo parentlist numcommits
2389 if {$row >= $numcommits} return
2390 foreach id [lindex $rowidlist $row] {
2391 if {$id eq {}} continue
2392 set i -1
2393 foreach {s e} [rowranges $id] {
2394 incr i
2395 if {$row < $s} continue
2396 if {$e eq {}} break
2397 if {$row <= $e} {
2398 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2399 drawlineseg $id $i
2400 set idrangedrawn($id,$i) 1
2402 break
2407 set id [lindex $displayorder $row]
2408 if {[info exists iddrawn($id)]} return
2409 set col [lsearch -exact [lindex $rowidlist $row] $id]
2410 if {$col < 0} {
2411 puts "oops, row $row id $id not in list"
2412 return
2414 if {![info exists commitinfo($id)]} {
2415 getcommit $id
2417 assigncolor $id
2418 set olds [lindex $parentlist $row]
2419 if {$olds ne {}} {
2420 set rmx [drawparentlinks $id $row $col $olds]
2421 } else {
2422 set rmx 0
2424 drawcmittext $id $row $col $rmx
2425 set iddrawn($id) 1
2428 proc drawfrac {f0 f1} {
2429 global numcommits canv
2430 global linespc
2432 set ymax [lindex [$canv cget -scrollregion] 3]
2433 if {$ymax eq {} || $ymax == 0} return
2434 set y0 [expr {int($f0 * $ymax)}]
2435 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2436 if {$row < 0} {
2437 set row 0
2439 set y1 [expr {int($f1 * $ymax)}]
2440 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2441 if {$endrow >= $numcommits} {
2442 set endrow [expr {$numcommits - 1}]
2444 for {} {$row <= $endrow} {incr row} {
2445 drawcmitrow $row
2449 proc drawvisible {} {
2450 global canv
2451 eval drawfrac [$canv yview]
2454 proc clear_display {} {
2455 global iddrawn idrangedrawn
2457 allcanvs delete all
2458 catch {unset iddrawn}
2459 catch {unset idrangedrawn}
2462 proc findcrossings {id} {
2463 global rowidlist parentlist numcommits rowoffsets displayorder
2465 set cross {}
2466 set ccross {}
2467 foreach {s e} [rowranges $id] {
2468 if {$e >= $numcommits} {
2469 set e [expr {$numcommits - 1}]
2471 if {$e <= $s} continue
2472 set x [lsearch -exact [lindex $rowidlist $e] $id]
2473 if {$x < 0} {
2474 puts "findcrossings: oops, no [shortids $id] in row $e"
2475 continue
2477 for {set row $e} {[incr row -1] >= $s} {} {
2478 set olds [lindex $parentlist $row]
2479 set kid [lindex $displayorder $row]
2480 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2481 if {$kidx < 0} continue
2482 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2483 foreach p $olds {
2484 set px [lsearch -exact $nextrow $p]
2485 if {$px < 0} continue
2486 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2487 if {[lsearch -exact $ccross $p] >= 0} continue
2488 if {$x == $px + ($kidx < $px? -1: 1)} {
2489 lappend ccross $p
2490 } elseif {[lsearch -exact $cross $p] < 0} {
2491 lappend cross $p
2495 set inc [lindex $rowoffsets $row $x]
2496 if {$inc eq {}} break
2497 incr x $inc
2500 return [concat $ccross {{}} $cross]
2503 proc assigncolor {id} {
2504 global colormap colors nextcolor
2505 global commitrow parentlist children children curview
2507 if {[info exists colormap($id)]} return
2508 set ncolors [llength $colors]
2509 if {[info exists children($curview,$id)]} {
2510 set kids $children($curview,$id)
2511 } else {
2512 set kids {}
2514 if {[llength $kids] == 1} {
2515 set child [lindex $kids 0]
2516 if {[info exists colormap($child)]
2517 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2518 set colormap($id) $colormap($child)
2519 return
2522 set badcolors {}
2523 set origbad {}
2524 foreach x [findcrossings $id] {
2525 if {$x eq {}} {
2526 # delimiter between corner crossings and other crossings
2527 if {[llength $badcolors] >= $ncolors - 1} break
2528 set origbad $badcolors
2530 if {[info exists colormap($x)]
2531 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2532 lappend badcolors $colormap($x)
2535 if {[llength $badcolors] >= $ncolors} {
2536 set badcolors $origbad
2538 set origbad $badcolors
2539 if {[llength $badcolors] < $ncolors - 1} {
2540 foreach child $kids {
2541 if {[info exists colormap($child)]
2542 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2543 lappend badcolors $colormap($child)
2545 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2546 if {[info exists colormap($p)]
2547 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2548 lappend badcolors $colormap($p)
2552 if {[llength $badcolors] >= $ncolors} {
2553 set badcolors $origbad
2556 for {set i 0} {$i <= $ncolors} {incr i} {
2557 set c [lindex $colors $nextcolor]
2558 if {[incr nextcolor] >= $ncolors} {
2559 set nextcolor 0
2561 if {[lsearch -exact $badcolors $c]} break
2563 set colormap($id) $c
2566 proc bindline {t id} {
2567 global canv
2569 $canv bind $t <Enter> "lineenter %x %y $id"
2570 $canv bind $t <Motion> "linemotion %x %y $id"
2571 $canv bind $t <Leave> "lineleave $id"
2572 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2575 proc drawtags {id x xt y1} {
2576 global idtags idheads idotherrefs
2577 global linespc lthickness
2578 global canv mainfont commitrow rowtextx curview
2580 set marks {}
2581 set ntags 0
2582 set nheads 0
2583 if {[info exists idtags($id)]} {
2584 set marks $idtags($id)
2585 set ntags [llength $marks]
2587 if {[info exists idheads($id)]} {
2588 set marks [concat $marks $idheads($id)]
2589 set nheads [llength $idheads($id)]
2591 if {[info exists idotherrefs($id)]} {
2592 set marks [concat $marks $idotherrefs($id)]
2594 if {$marks eq {}} {
2595 return $xt
2598 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2599 set yt [expr {$y1 - 0.5 * $linespc}]
2600 set yb [expr {$yt + $linespc - 1}]
2601 set xvals {}
2602 set wvals {}
2603 foreach tag $marks {
2604 set wid [font measure $mainfont $tag]
2605 lappend xvals $xt
2606 lappend wvals $wid
2607 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2609 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2610 -width $lthickness -fill black -tags tag.$id]
2611 $canv lower $t
2612 foreach tag $marks x $xvals wid $wvals {
2613 set xl [expr {$x + $delta}]
2614 set xr [expr {$x + $delta + $wid + $lthickness}]
2615 if {[incr ntags -1] >= 0} {
2616 # draw a tag
2617 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2618 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2619 -width 1 -outline black -fill yellow -tags tag.$id]
2620 $canv bind $t <1> [list showtag $tag 1]
2621 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2622 } else {
2623 # draw a head or other ref
2624 if {[incr nheads -1] >= 0} {
2625 set col green
2626 } else {
2627 set col "#ddddff"
2629 set xl [expr {$xl - $delta/2}]
2630 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2631 -width 1 -outline black -fill $col -tags tag.$id
2632 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2633 set rwid [font measure $mainfont $remoteprefix]
2634 set xi [expr {$x + 1}]
2635 set yti [expr {$yt + 1}]
2636 set xri [expr {$x + $rwid}]
2637 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2638 -width 0 -fill "#ffddaa" -tags tag.$id
2641 set t [$canv create text $xl $y1 -anchor w -text $tag \
2642 -font $mainfont -tags tag.$id]
2643 if {$ntags >= 0} {
2644 $canv bind $t <1> [list showtag $tag 1]
2647 return $xt
2650 proc xcoord {i level ln} {
2651 global canvx0 xspc1 xspc2
2653 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2654 if {$i > 0 && $i == $level} {
2655 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2656 } elseif {$i > $level} {
2657 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2659 return $x
2662 proc show_status {msg} {
2663 global canv mainfont
2665 clear_display
2666 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2669 proc finishcommits {} {
2670 global commitidx phase curview
2671 global canv mainfont ctext maincursor textcursor
2672 global findinprogress pending_select
2674 if {$commitidx($curview) > 0} {
2675 drawrest
2676 } else {
2677 show_status "No commits selected"
2679 set phase {}
2680 catch {unset pending_select}
2683 # Don't change the text pane cursor if it is currently the hand cursor,
2684 # showing that we are over a sha1 ID link.
2685 proc settextcursor {c} {
2686 global ctext curtextcursor
2688 if {[$ctext cget -cursor] == $curtextcursor} {
2689 $ctext config -cursor $c
2691 set curtextcursor $c
2694 proc nowbusy {what} {
2695 global isbusy
2697 if {[array names isbusy] eq {}} {
2698 . config -cursor watch
2699 settextcursor watch
2701 set isbusy($what) 1
2704 proc notbusy {what} {
2705 global isbusy maincursor textcursor
2707 catch {unset isbusy($what)}
2708 if {[array names isbusy] eq {}} {
2709 . config -cursor $maincursor
2710 settextcursor $textcursor
2714 proc drawrest {} {
2715 global numcommits
2716 global startmsecs
2717 global canvy0 numcommits linespc
2718 global rowlaidout commitidx curview
2719 global pending_select
2721 set row $rowlaidout
2722 layoutrows $rowlaidout $commitidx($curview) 1
2723 layouttail
2724 optimize_rows $row 0 $commitidx($curview)
2725 showstuff $commitidx($curview)
2726 if {[info exists pending_select]} {
2727 selectline 0 1
2730 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2731 #puts "overall $drawmsecs ms for $numcommits commits"
2734 proc findmatches {f} {
2735 global findtype foundstring foundstrlen
2736 if {$findtype == "Regexp"} {
2737 set matches [regexp -indices -all -inline $foundstring $f]
2738 } else {
2739 if {$findtype == "IgnCase"} {
2740 set str [string tolower $f]
2741 } else {
2742 set str $f
2744 set matches {}
2745 set i 0
2746 while {[set j [string first $foundstring $str $i]] >= 0} {
2747 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2748 set i [expr {$j + $foundstrlen}]
2751 return $matches
2754 proc dofind {} {
2755 global findtype findloc findstring markedmatches commitinfo
2756 global numcommits displayorder linehtag linentag linedtag
2757 global mainfont canv canv2 canv3 selectedline
2758 global matchinglines foundstring foundstrlen matchstring
2759 global commitdata
2761 stopfindproc
2762 unmarkmatches
2763 focus .
2764 set matchinglines {}
2765 if {$findloc == "Pickaxe"} {
2766 findpatches
2767 return
2769 if {$findtype == "IgnCase"} {
2770 set foundstring [string tolower $findstring]
2771 } else {
2772 set foundstring $findstring
2774 set foundstrlen [string length $findstring]
2775 if {$foundstrlen == 0} return
2776 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2777 set matchstring "*$matchstring*"
2778 if {$findloc == "Files"} {
2779 findfiles
2780 return
2782 if {![info exists selectedline]} {
2783 set oldsel -1
2784 } else {
2785 set oldsel $selectedline
2787 set didsel 0
2788 set fldtypes {Headline Author Date Committer CDate Comment}
2789 set l -1
2790 foreach id $displayorder {
2791 set d $commitdata($id)
2792 incr l
2793 if {$findtype == "Regexp"} {
2794 set doesmatch [regexp $foundstring $d]
2795 } elseif {$findtype == "IgnCase"} {
2796 set doesmatch [string match -nocase $matchstring $d]
2797 } else {
2798 set doesmatch [string match $matchstring $d]
2800 if {!$doesmatch} continue
2801 if {![info exists commitinfo($id)]} {
2802 getcommit $id
2804 set info $commitinfo($id)
2805 set doesmatch 0
2806 foreach f $info ty $fldtypes {
2807 if {$findloc != "All fields" && $findloc != $ty} {
2808 continue
2810 set matches [findmatches $f]
2811 if {$matches == {}} continue
2812 set doesmatch 1
2813 if {$ty == "Headline"} {
2814 drawcmitrow $l
2815 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2816 } elseif {$ty == "Author"} {
2817 drawcmitrow $l
2818 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2819 } elseif {$ty == "Date"} {
2820 drawcmitrow $l
2821 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2824 if {$doesmatch} {
2825 lappend matchinglines $l
2826 if {!$didsel && $l > $oldsel} {
2827 findselectline $l
2828 set didsel 1
2832 if {$matchinglines == {}} {
2833 bell
2834 } elseif {!$didsel} {
2835 findselectline [lindex $matchinglines 0]
2839 proc findselectline {l} {
2840 global findloc commentend ctext
2841 selectline $l 1
2842 if {$findloc == "All fields" || $findloc == "Comments"} {
2843 # highlight the matches in the comments
2844 set f [$ctext get 1.0 $commentend]
2845 set matches [findmatches $f]
2846 foreach match $matches {
2847 set start [lindex $match 0]
2848 set end [expr {[lindex $match 1] + 1}]
2849 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2854 proc findnext {restart} {
2855 global matchinglines selectedline
2856 if {![info exists matchinglines]} {
2857 if {$restart} {
2858 dofind
2860 return
2862 if {![info exists selectedline]} return
2863 foreach l $matchinglines {
2864 if {$l > $selectedline} {
2865 findselectline $l
2866 return
2869 bell
2872 proc findprev {} {
2873 global matchinglines selectedline
2874 if {![info exists matchinglines]} {
2875 dofind
2876 return
2878 if {![info exists selectedline]} return
2879 set prev {}
2880 foreach l $matchinglines {
2881 if {$l >= $selectedline} break
2882 set prev $l
2884 if {$prev != {}} {
2885 findselectline $prev
2886 } else {
2887 bell
2891 proc findlocchange {name ix op} {
2892 global findloc findtype findtypemenu
2893 if {$findloc == "Pickaxe"} {
2894 set findtype Exact
2895 set state disabled
2896 } else {
2897 set state normal
2899 $findtypemenu entryconf 1 -state $state
2900 $findtypemenu entryconf 2 -state $state
2903 proc stopfindproc {{done 0}} {
2904 global findprocpid findprocfile findids
2905 global ctext findoldcursor phase maincursor textcursor
2906 global findinprogress
2908 catch {unset findids}
2909 if {[info exists findprocpid]} {
2910 if {!$done} {
2911 catch {exec kill $findprocpid}
2913 catch {close $findprocfile}
2914 unset findprocpid
2916 catch {unset findinprogress}
2917 notbusy find
2920 proc findpatches {} {
2921 global findstring selectedline numcommits
2922 global findprocpid findprocfile
2923 global finddidsel ctext displayorder findinprogress
2924 global findinsertpos
2926 if {$numcommits == 0} return
2928 # make a list of all the ids to search, starting at the one
2929 # after the selected line (if any)
2930 if {[info exists selectedline]} {
2931 set l $selectedline
2932 } else {
2933 set l -1
2935 set inputids {}
2936 for {set i 0} {$i < $numcommits} {incr i} {
2937 if {[incr l] >= $numcommits} {
2938 set l 0
2940 append inputids [lindex $displayorder $l] "\n"
2943 if {[catch {
2944 set f [open [list | git diff-tree --stdin -s -r -S$findstring \
2945 << $inputids] r]
2946 } err]} {
2947 error_popup "Error starting search process: $err"
2948 return
2951 set findinsertpos end
2952 set findprocfile $f
2953 set findprocpid [pid $f]
2954 fconfigure $f -blocking 0
2955 fileevent $f readable readfindproc
2956 set finddidsel 0
2957 nowbusy find
2958 set findinprogress 1
2961 proc readfindproc {} {
2962 global findprocfile finddidsel
2963 global commitrow matchinglines findinsertpos curview
2965 set n [gets $findprocfile line]
2966 if {$n < 0} {
2967 if {[eof $findprocfile]} {
2968 stopfindproc 1
2969 if {!$finddidsel} {
2970 bell
2973 return
2975 if {![regexp {^[0-9a-f]{40}} $line id]} {
2976 error_popup "Can't parse git diff-tree output: $line"
2977 stopfindproc
2978 return
2980 if {![info exists commitrow($curview,$id)]} {
2981 puts stderr "spurious id: $id"
2982 return
2984 set l $commitrow($curview,$id)
2985 insertmatch $l $id
2988 proc insertmatch {l id} {
2989 global matchinglines findinsertpos finddidsel
2991 if {$findinsertpos == "end"} {
2992 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2993 set matchinglines [linsert $matchinglines 0 $l]
2994 set findinsertpos 1
2995 } else {
2996 lappend matchinglines $l
2998 } else {
2999 set matchinglines [linsert $matchinglines $findinsertpos $l]
3000 incr findinsertpos
3002 markheadline $l $id
3003 if {!$finddidsel} {
3004 findselectline $l
3005 set finddidsel 1
3009 proc findfiles {} {
3010 global selectedline numcommits displayorder ctext
3011 global ffileline finddidsel parentlist
3012 global findinprogress findstartline findinsertpos
3013 global treediffs fdiffid fdiffsneeded fdiffpos
3014 global findmergefiles
3016 if {$numcommits == 0} return
3018 if {[info exists selectedline]} {
3019 set l [expr {$selectedline + 1}]
3020 } else {
3021 set l 0
3023 set ffileline $l
3024 set findstartline $l
3025 set diffsneeded {}
3026 set fdiffsneeded {}
3027 while 1 {
3028 set id [lindex $displayorder $l]
3029 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3030 if {![info exists treediffs($id)]} {
3031 append diffsneeded "$id\n"
3032 lappend fdiffsneeded $id
3035 if {[incr l] >= $numcommits} {
3036 set l 0
3038 if {$l == $findstartline} break
3041 # start off a git diff-tree process if needed
3042 if {$diffsneeded ne {}} {
3043 if {[catch {
3044 set df [open [list | git diff-tree -r --stdin << $diffsneeded] r]
3045 } err ]} {
3046 error_popup "Error starting search process: $err"
3047 return
3049 catch {unset fdiffid}
3050 set fdiffpos 0
3051 fconfigure $df -blocking 0
3052 fileevent $df readable [list readfilediffs $df]
3055 set finddidsel 0
3056 set findinsertpos end
3057 set id [lindex $displayorder $l]
3058 nowbusy find
3059 set findinprogress 1
3060 findcont
3061 update
3064 proc readfilediffs {df} {
3065 global findid fdiffid fdiffs
3067 set n [gets $df line]
3068 if {$n < 0} {
3069 if {[eof $df]} {
3070 donefilediff
3071 if {[catch {close $df} err]} {
3072 stopfindproc
3073 bell
3074 error_popup "Error in git diff-tree: $err"
3075 } elseif {[info exists findid]} {
3076 set id $findid
3077 stopfindproc
3078 bell
3079 error_popup "Couldn't find diffs for $id"
3082 return
3084 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3085 # start of a new string of diffs
3086 donefilediff
3087 set fdiffid $id
3088 set fdiffs {}
3089 } elseif {[string match ":*" $line]} {
3090 lappend fdiffs [lindex $line 5]
3094 proc donefilediff {} {
3095 global fdiffid fdiffs treediffs findid
3096 global fdiffsneeded fdiffpos
3098 if {[info exists fdiffid]} {
3099 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3100 && $fdiffpos < [llength $fdiffsneeded]} {
3101 # git diff-tree doesn't output anything for a commit
3102 # which doesn't change anything
3103 set nullid [lindex $fdiffsneeded $fdiffpos]
3104 set treediffs($nullid) {}
3105 if {[info exists findid] && $nullid eq $findid} {
3106 unset findid
3107 findcont
3109 incr fdiffpos
3111 incr fdiffpos
3113 if {![info exists treediffs($fdiffid)]} {
3114 set treediffs($fdiffid) $fdiffs
3116 if {[info exists findid] && $fdiffid eq $findid} {
3117 unset findid
3118 findcont
3123 proc findcont {} {
3124 global findid treediffs parentlist
3125 global ffileline findstartline finddidsel
3126 global displayorder numcommits matchinglines findinprogress
3127 global findmergefiles
3129 set l $ffileline
3130 while {1} {
3131 set id [lindex $displayorder $l]
3132 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3133 if {![info exists treediffs($id)]} {
3134 set findid $id
3135 set ffileline $l
3136 return
3138 set doesmatch 0
3139 foreach f $treediffs($id) {
3140 set x [findmatches $f]
3141 if {$x != {}} {
3142 set doesmatch 1
3143 break
3146 if {$doesmatch} {
3147 insertmatch $l $id
3150 if {[incr l] >= $numcommits} {
3151 set l 0
3153 if {$l == $findstartline} break
3155 stopfindproc
3156 if {!$finddidsel} {
3157 bell
3161 # mark a commit as matching by putting a yellow background
3162 # behind the headline
3163 proc markheadline {l id} {
3164 global canv mainfont linehtag
3166 drawcmitrow $l
3167 set bbox [$canv bbox $linehtag($l)]
3168 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3169 $canv lower $t
3172 # mark the bits of a headline, author or date that match a find string
3173 proc markmatches {canv l str tag matches font} {
3174 set bbox [$canv bbox $tag]
3175 set x0 [lindex $bbox 0]
3176 set y0 [lindex $bbox 1]
3177 set y1 [lindex $bbox 3]
3178 foreach match $matches {
3179 set start [lindex $match 0]
3180 set end [lindex $match 1]
3181 if {$start > $end} continue
3182 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3183 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3184 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3185 [expr {$x0+$xlen+2}] $y1 \
3186 -outline {} -tags matches -fill yellow]
3187 $canv lower $t
3191 proc unmarkmatches {} {
3192 global matchinglines findids
3193 allcanvs delete matches
3194 catch {unset matchinglines}
3195 catch {unset findids}
3198 proc selcanvline {w x y} {
3199 global canv canvy0 ctext linespc
3200 global rowtextx
3201 set ymax [lindex [$canv cget -scrollregion] 3]
3202 if {$ymax == {}} return
3203 set yfrac [lindex [$canv yview] 0]
3204 set y [expr {$y + $yfrac * $ymax}]
3205 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3206 if {$l < 0} {
3207 set l 0
3209 if {$w eq $canv} {
3210 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3212 unmarkmatches
3213 selectline $l 1
3216 proc commit_descriptor {p} {
3217 global commitinfo
3218 if {![info exists commitinfo($p)]} {
3219 getcommit $p
3221 set l "..."
3222 if {[llength $commitinfo($p)] > 1} {
3223 set l [lindex $commitinfo($p) 0]
3225 return "$p ($l)"
3228 # append some text to the ctext widget, and make any SHA1 ID
3229 # that we know about be a clickable link.
3230 proc appendwithlinks {text tags} {
3231 global ctext commitrow linknum curview
3233 set start [$ctext index "end - 1c"]
3234 $ctext insert end $text $tags
3235 $ctext insert end "\n"
3236 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3237 foreach l $links {
3238 set s [lindex $l 0]
3239 set e [lindex $l 1]
3240 set linkid [string range $text $s $e]
3241 if {![info exists commitrow($curview,$linkid)]} continue
3242 incr e
3243 $ctext tag add link "$start + $s c" "$start + $e c"
3244 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3245 $ctext tag bind link$linknum <1> \
3246 [list selectline $commitrow($curview,$linkid) 1]
3247 incr linknum
3249 $ctext tag conf link -foreground blue -underline 1
3250 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3251 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3254 proc viewnextline {dir} {
3255 global canv linespc
3257 $canv delete hover
3258 set ymax [lindex [$canv cget -scrollregion] 3]
3259 set wnow [$canv yview]
3260 set wtop [expr {[lindex $wnow 0] * $ymax}]
3261 set newtop [expr {$wtop + $dir * $linespc}]
3262 if {$newtop < 0} {
3263 set newtop 0
3264 } elseif {$newtop > $ymax} {
3265 set newtop $ymax
3267 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3270 proc selectline {l isnew} {
3271 global canv canv2 canv3 ctext commitinfo selectedline
3272 global displayorder linehtag linentag linedtag
3273 global canvy0 linespc parentlist childlist
3274 global currentid sha1entry
3275 global commentend idtags linknum
3276 global mergemax numcommits pending_select
3277 global cmitmode
3279 catch {unset pending_select}
3280 $canv delete hover
3281 normalline
3282 if {$l < 0 || $l >= $numcommits} return
3283 set y [expr {$canvy0 + $l * $linespc}]
3284 set ymax [lindex [$canv cget -scrollregion] 3]
3285 set ytop [expr {$y - $linespc - 1}]
3286 set ybot [expr {$y + $linespc + 1}]
3287 set wnow [$canv yview]
3288 set wtop [expr {[lindex $wnow 0] * $ymax}]
3289 set wbot [expr {[lindex $wnow 1] * $ymax}]
3290 set wh [expr {$wbot - $wtop}]
3291 set newtop $wtop
3292 if {$ytop < $wtop} {
3293 if {$ybot < $wtop} {
3294 set newtop [expr {$y - $wh / 2.0}]
3295 } else {
3296 set newtop $ytop
3297 if {$newtop > $wtop - $linespc} {
3298 set newtop [expr {$wtop - $linespc}]
3301 } elseif {$ybot > $wbot} {
3302 if {$ytop > $wbot} {
3303 set newtop [expr {$y - $wh / 2.0}]
3304 } else {
3305 set newtop [expr {$ybot - $wh}]
3306 if {$newtop < $wtop + $linespc} {
3307 set newtop [expr {$wtop + $linespc}]
3311 if {$newtop != $wtop} {
3312 if {$newtop < 0} {
3313 set newtop 0
3315 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3316 drawvisible
3319 if {![info exists linehtag($l)]} return
3320 $canv delete secsel
3321 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3322 -tags secsel -fill [$canv cget -selectbackground]]
3323 $canv lower $t
3324 $canv2 delete secsel
3325 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3326 -tags secsel -fill [$canv2 cget -selectbackground]]
3327 $canv2 lower $t
3328 $canv3 delete secsel
3329 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3330 -tags secsel -fill [$canv3 cget -selectbackground]]
3331 $canv3 lower $t
3333 if {$isnew} {
3334 addtohistory [list selectline $l 0]
3337 set selectedline $l
3339 set id [lindex $displayorder $l]
3340 set currentid $id
3341 $sha1entry delete 0 end
3342 $sha1entry insert 0 $id
3343 $sha1entry selection from 0
3344 $sha1entry selection to end
3346 $ctext conf -state normal
3347 $ctext delete 0.0 end
3348 set linknum 0
3349 set info $commitinfo($id)
3350 set date [formatdate [lindex $info 2]]
3351 $ctext insert end "Author: [lindex $info 1] $date\n"
3352 set date [formatdate [lindex $info 4]]
3353 $ctext insert end "Committer: [lindex $info 3] $date\n"
3354 if {[info exists idtags($id)]} {
3355 $ctext insert end "Tags:"
3356 foreach tag $idtags($id) {
3357 $ctext insert end " $tag"
3359 $ctext insert end "\n"
3362 set headers {}
3363 set olds [lindex $parentlist $l]
3364 if {[llength $olds] > 1} {
3365 set np 0
3366 foreach p $olds {
3367 if {$np >= $mergemax} {
3368 set tag mmax
3369 } else {
3370 set tag m$np
3372 $ctext insert end "Parent: " $tag
3373 appendwithlinks [commit_descriptor $p] {}
3374 incr np
3376 } else {
3377 foreach p $olds {
3378 append headers "Parent: [commit_descriptor $p]\n"
3382 foreach c [lindex $childlist $l] {
3383 append headers "Child: [commit_descriptor $c]\n"
3386 # make anything that looks like a SHA1 ID be a clickable link
3387 appendwithlinks $headers {}
3388 appendwithlinks [lindex $info 5] {comment}
3390 $ctext tag delete Comments
3391 $ctext tag remove found 1.0 end
3392 $ctext conf -state disabled
3393 set commentend [$ctext index "end - 1c"]
3395 init_flist "Comments"
3396 if {$cmitmode eq "tree"} {
3397 gettree $id
3398 } elseif {[llength $olds] <= 1} {
3399 startdiff $id
3400 } else {
3401 mergediff $id $l
3405 proc selfirstline {} {
3406 unmarkmatches
3407 selectline 0 1
3410 proc sellastline {} {
3411 global numcommits
3412 unmarkmatches
3413 set l [expr {$numcommits - 1}]
3414 selectline $l 1
3417 proc selnextline {dir} {
3418 global selectedline
3419 if {![info exists selectedline]} return
3420 set l [expr {$selectedline + $dir}]
3421 unmarkmatches
3422 selectline $l 1
3425 proc selnextpage {dir} {
3426 global canv linespc selectedline numcommits
3428 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3429 if {$lpp < 1} {
3430 set lpp 1
3432 allcanvs yview scroll [expr {$dir * $lpp}] units
3433 drawvisible
3434 if {![info exists selectedline]} return
3435 set l [expr {$selectedline + $dir * $lpp}]
3436 if {$l < 0} {
3437 set l 0
3438 } elseif {$l >= $numcommits} {
3439 set l [expr $numcommits - 1]
3441 unmarkmatches
3442 selectline $l 1
3445 proc unselectline {} {
3446 global selectedline currentid
3448 catch {unset selectedline}
3449 catch {unset currentid}
3450 allcanvs delete secsel
3453 proc reselectline {} {
3454 global selectedline
3456 if {[info exists selectedline]} {
3457 selectline $selectedline 0
3461 proc addtohistory {cmd} {
3462 global history historyindex curview
3464 set elt [list $curview $cmd]
3465 if {$historyindex > 0
3466 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3467 return
3470 if {$historyindex < [llength $history]} {
3471 set history [lreplace $history $historyindex end $elt]
3472 } else {
3473 lappend history $elt
3475 incr historyindex
3476 if {$historyindex > 1} {
3477 .ctop.top.bar.leftbut conf -state normal
3478 } else {
3479 .ctop.top.bar.leftbut conf -state disabled
3481 .ctop.top.bar.rightbut conf -state disabled
3484 proc godo {elt} {
3485 global curview
3487 set view [lindex $elt 0]
3488 set cmd [lindex $elt 1]
3489 if {$curview != $view} {
3490 showview $view
3492 eval $cmd
3495 proc goback {} {
3496 global history historyindex
3498 if {$historyindex > 1} {
3499 incr historyindex -1
3500 godo [lindex $history [expr {$historyindex - 1}]]
3501 .ctop.top.bar.rightbut conf -state normal
3503 if {$historyindex <= 1} {
3504 .ctop.top.bar.leftbut conf -state disabled
3508 proc goforw {} {
3509 global history historyindex
3511 if {$historyindex < [llength $history]} {
3512 set cmd [lindex $history $historyindex]
3513 incr historyindex
3514 godo $cmd
3515 .ctop.top.bar.leftbut conf -state normal
3517 if {$historyindex >= [llength $history]} {
3518 .ctop.top.bar.rightbut conf -state disabled
3522 proc gettree {id} {
3523 global treefilelist treeidlist diffids diffmergeid treepending
3525 set diffids $id
3526 catch {unset diffmergeid}
3527 if {![info exists treefilelist($id)]} {
3528 if {![info exists treepending]} {
3529 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3530 return
3532 set treepending $id
3533 set treefilelist($id) {}
3534 set treeidlist($id) {}
3535 fconfigure $gtf -blocking 0
3536 fileevent $gtf readable [list gettreeline $gtf $id]
3538 } else {
3539 setfilelist $id
3543 proc gettreeline {gtf id} {
3544 global treefilelist treeidlist treepending cmitmode diffids
3546 while {[gets $gtf line] >= 0} {
3547 if {[lindex $line 1] ne "blob"} continue
3548 set sha1 [lindex $line 2]
3549 set fname [lindex $line 3]
3550 lappend treefilelist($id) $fname
3551 lappend treeidlist($id) $sha1
3553 if {![eof $gtf]} return
3554 close $gtf
3555 unset treepending
3556 if {$cmitmode ne "tree"} {
3557 if {![info exists diffmergeid]} {
3558 gettreediffs $diffids
3560 } elseif {$id ne $diffids} {
3561 gettree $diffids
3562 } else {
3563 setfilelist $id
3567 proc showfile {f} {
3568 global treefilelist treeidlist diffids
3569 global ctext commentend
3571 set i [lsearch -exact $treefilelist($diffids) $f]
3572 if {$i < 0} {
3573 puts "oops, $f not in list for id $diffids"
3574 return
3576 set blob [lindex $treeidlist($diffids) $i]
3577 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3578 puts "oops, error reading blob $blob: $err"
3579 return
3581 fconfigure $bf -blocking 0
3582 fileevent $bf readable [list getblobline $bf $diffids]
3583 $ctext config -state normal
3584 $ctext delete $commentend end
3585 $ctext insert end "\n"
3586 $ctext insert end "$f\n" filesep
3587 $ctext config -state disabled
3588 $ctext yview $commentend
3591 proc getblobline {bf id} {
3592 global diffids cmitmode ctext
3594 if {$id ne $diffids || $cmitmode ne "tree"} {
3595 catch {close $bf}
3596 return
3598 $ctext config -state normal
3599 while {[gets $bf line] >= 0} {
3600 $ctext insert end "$line\n"
3602 if {[eof $bf]} {
3603 # delete last newline
3604 $ctext delete "end - 2c" "end - 1c"
3605 close $bf
3607 $ctext config -state disabled
3610 proc mergediff {id l} {
3611 global diffmergeid diffopts mdifffd
3612 global diffids
3613 global parentlist
3615 set diffmergeid $id
3616 set diffids $id
3617 # this doesn't seem to actually affect anything...
3618 set env(GIT_DIFF_OPTS) $diffopts
3619 set cmd [concat | git diff-tree --no-commit-id --cc $id]
3620 if {[catch {set mdf [open $cmd r]} err]} {
3621 error_popup "Error getting merge diffs: $err"
3622 return
3624 fconfigure $mdf -blocking 0
3625 set mdifffd($id) $mdf
3626 set np [llength [lindex $parentlist $l]]
3627 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3628 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3631 proc getmergediffline {mdf id np} {
3632 global diffmergeid ctext cflist nextupdate mergemax
3633 global difffilestart mdifffd
3635 set n [gets $mdf line]
3636 if {$n < 0} {
3637 if {[eof $mdf]} {
3638 close $mdf
3640 return
3642 if {![info exists diffmergeid] || $id != $diffmergeid
3643 || $mdf != $mdifffd($id)} {
3644 return
3646 $ctext conf -state normal
3647 if {[regexp {^diff --cc (.*)} $line match fname]} {
3648 # start of a new file
3649 $ctext insert end "\n"
3650 set here [$ctext index "end - 1c"]
3651 lappend difffilestart $here
3652 add_flist [list $fname]
3653 set l [expr {(78 - [string length $fname]) / 2}]
3654 set pad [string range "----------------------------------------" 1 $l]
3655 $ctext insert end "$pad $fname $pad\n" filesep
3656 } elseif {[regexp {^@@} $line]} {
3657 $ctext insert end "$line\n" hunksep
3658 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3659 # do nothing
3660 } else {
3661 # parse the prefix - one ' ', '-' or '+' for each parent
3662 set spaces {}
3663 set minuses {}
3664 set pluses {}
3665 set isbad 0
3666 for {set j 0} {$j < $np} {incr j} {
3667 set c [string range $line $j $j]
3668 if {$c == " "} {
3669 lappend spaces $j
3670 } elseif {$c == "-"} {
3671 lappend minuses $j
3672 } elseif {$c == "+"} {
3673 lappend pluses $j
3674 } else {
3675 set isbad 1
3676 break
3679 set tags {}
3680 set num {}
3681 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3682 # line doesn't appear in result, parents in $minuses have the line
3683 set num [lindex $minuses 0]
3684 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3685 # line appears in result, parents in $pluses don't have the line
3686 lappend tags mresult
3687 set num [lindex $spaces 0]
3689 if {$num ne {}} {
3690 if {$num >= $mergemax} {
3691 set num "max"
3693 lappend tags m$num
3695 $ctext insert end "$line\n" $tags
3697 $ctext conf -state disabled
3698 if {[clock clicks -milliseconds] >= $nextupdate} {
3699 incr nextupdate 100
3700 fileevent $mdf readable {}
3701 update
3702 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3706 proc startdiff {ids} {
3707 global treediffs diffids treepending diffmergeid
3709 set diffids $ids
3710 catch {unset diffmergeid}
3711 if {![info exists treediffs($ids)]} {
3712 if {![info exists treepending]} {
3713 gettreediffs $ids
3715 } else {
3716 addtocflist $ids
3720 proc addtocflist {ids} {
3721 global treediffs cflist
3722 add_flist $treediffs($ids)
3723 getblobdiffs $ids
3726 proc gettreediffs {ids} {
3727 global treediff treepending
3728 set treepending $ids
3729 set treediff {}
3730 if {[catch \
3731 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
3732 ]} return
3733 fconfigure $gdtf -blocking 0
3734 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3737 proc gettreediffline {gdtf ids} {
3738 global treediff treediffs treepending diffids diffmergeid
3739 global cmitmode
3741 set n [gets $gdtf line]
3742 if {$n < 0} {
3743 if {![eof $gdtf]} return
3744 close $gdtf
3745 set treediffs($ids) $treediff
3746 unset treepending
3747 if {$cmitmode eq "tree"} {
3748 gettree $diffids
3749 } elseif {$ids != $diffids} {
3750 if {![info exists diffmergeid]} {
3751 gettreediffs $diffids
3753 } else {
3754 addtocflist $ids
3756 return
3758 set file [lindex $line 5]
3759 lappend treediff $file
3762 proc getblobdiffs {ids} {
3763 global diffopts blobdifffd diffids env curdifftag curtagstart
3764 global nextupdate diffinhdr treediffs
3766 set env(GIT_DIFF_OPTS) $diffopts
3767 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
3768 if {[catch {set bdf [open $cmd r]} err]} {
3769 puts "error getting diffs: $err"
3770 return
3772 set diffinhdr 0
3773 fconfigure $bdf -blocking 0
3774 set blobdifffd($ids) $bdf
3775 set curdifftag Comments
3776 set curtagstart 0.0
3777 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3778 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3781 proc setinlist {var i val} {
3782 global $var
3784 while {[llength [set $var]] < $i} {
3785 lappend $var {}
3787 if {[llength [set $var]] == $i} {
3788 lappend $var $val
3789 } else {
3790 lset $var $i $val
3794 proc getblobdiffline {bdf ids} {
3795 global diffids blobdifffd ctext curdifftag curtagstart
3796 global diffnexthead diffnextnote difffilestart
3797 global nextupdate diffinhdr treediffs
3799 set n [gets $bdf line]
3800 if {$n < 0} {
3801 if {[eof $bdf]} {
3802 close $bdf
3803 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3804 $ctext tag add $curdifftag $curtagstart end
3807 return
3809 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3810 return
3812 $ctext conf -state normal
3813 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3814 # start of a new file
3815 $ctext insert end "\n"
3816 $ctext tag add $curdifftag $curtagstart end
3817 set here [$ctext index "end - 1c"]
3818 set curtagstart $here
3819 set header $newname
3820 set i [lsearch -exact $treediffs($ids) $fname]
3821 if {$i >= 0} {
3822 setinlist difffilestart $i $here
3824 if {$newname ne $fname} {
3825 set i [lsearch -exact $treediffs($ids) $newname]
3826 if {$i >= 0} {
3827 setinlist difffilestart $i $here
3830 set curdifftag "f:$fname"
3831 $ctext tag delete $curdifftag
3832 set l [expr {(78 - [string length $header]) / 2}]
3833 set pad [string range "----------------------------------------" 1 $l]
3834 $ctext insert end "$pad $header $pad\n" filesep
3835 set diffinhdr 1
3836 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3837 # do nothing
3838 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3839 set diffinhdr 0
3840 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3841 $line match f1l f1c f2l f2c rest]} {
3842 $ctext insert end "$line\n" hunksep
3843 set diffinhdr 0
3844 } else {
3845 set x [string range $line 0 0]
3846 if {$x == "-" || $x == "+"} {
3847 set tag [expr {$x == "+"}]
3848 $ctext insert end "$line\n" d$tag
3849 } elseif {$x == " "} {
3850 $ctext insert end "$line\n"
3851 } elseif {$diffinhdr || $x == "\\"} {
3852 # e.g. "\ No newline at end of file"
3853 $ctext insert end "$line\n" filesep
3854 } else {
3855 # Something else we don't recognize
3856 if {$curdifftag != "Comments"} {
3857 $ctext insert end "\n"
3858 $ctext tag add $curdifftag $curtagstart end
3859 set curtagstart [$ctext index "end - 1c"]
3860 set curdifftag Comments
3862 $ctext insert end "$line\n" filesep
3865 $ctext conf -state disabled
3866 if {[clock clicks -milliseconds] >= $nextupdate} {
3867 incr nextupdate 100
3868 fileevent $bdf readable {}
3869 update
3870 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3874 proc nextfile {} {
3875 global difffilestart ctext
3876 set here [$ctext index @0,0]
3877 foreach loc $difffilestart {
3878 if {[$ctext compare $loc > $here]} {
3879 $ctext yview $loc
3884 proc setcoords {} {
3885 global linespc charspc canvx0 canvy0 mainfont
3886 global xspc1 xspc2 lthickness
3888 set linespc [font metrics $mainfont -linespace]
3889 set charspc [font measure $mainfont "m"]
3890 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3891 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3892 set lthickness [expr {int($linespc / 9) + 1}]
3893 set xspc1(0) $linespc
3894 set xspc2 $linespc
3897 proc redisplay {} {
3898 global canv
3899 global selectedline
3901 set ymax [lindex [$canv cget -scrollregion] 3]
3902 if {$ymax eq {} || $ymax == 0} return
3903 set span [$canv yview]
3904 clear_display
3905 setcanvscroll
3906 allcanvs yview moveto [lindex $span 0]
3907 drawvisible
3908 if {[info exists selectedline]} {
3909 selectline $selectedline 0
3913 proc incrfont {inc} {
3914 global mainfont textfont ctext canv phase
3915 global stopped entries
3916 unmarkmatches
3917 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3918 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3919 setcoords
3920 $ctext conf -font $textfont
3921 $ctext tag conf filesep -font [concat $textfont bold]
3922 foreach e $entries {
3923 $e conf -font $mainfont
3925 if {$phase eq "getcommits"} {
3926 $canv itemconf textitems -font $mainfont
3928 redisplay
3931 proc clearsha1 {} {
3932 global sha1entry sha1string
3933 if {[string length $sha1string] == 40} {
3934 $sha1entry delete 0 end
3938 proc sha1change {n1 n2 op} {
3939 global sha1string currentid sha1but
3940 if {$sha1string == {}
3941 || ([info exists currentid] && $sha1string == $currentid)} {
3942 set state disabled
3943 } else {
3944 set state normal
3946 if {[$sha1but cget -state] == $state} return
3947 if {$state == "normal"} {
3948 $sha1but conf -state normal -relief raised -text "Goto: "
3949 } else {
3950 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3954 proc gotocommit {} {
3955 global sha1string currentid commitrow tagids headids
3956 global displayorder numcommits curview
3958 if {$sha1string == {}
3959 || ([info exists currentid] && $sha1string == $currentid)} return
3960 if {[info exists tagids($sha1string)]} {
3961 set id $tagids($sha1string)
3962 } elseif {[info exists headids($sha1string)]} {
3963 set id $headids($sha1string)
3964 } else {
3965 set id [string tolower $sha1string]
3966 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3967 set matches {}
3968 foreach i $displayorder {
3969 if {[string match $id* $i]} {
3970 lappend matches $i
3973 if {$matches ne {}} {
3974 if {[llength $matches] > 1} {
3975 error_popup "Short SHA1 id $id is ambiguous"
3976 return
3978 set id [lindex $matches 0]
3982 if {[info exists commitrow($curview,$id)]} {
3983 selectline $commitrow($curview,$id) 1
3984 return
3986 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3987 set type "SHA1 id"
3988 } else {
3989 set type "Tag/Head"
3991 error_popup "$type $sha1string is not known"
3994 proc lineenter {x y id} {
3995 global hoverx hovery hoverid hovertimer
3996 global commitinfo canv
3998 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3999 set hoverx $x
4000 set hovery $y
4001 set hoverid $id
4002 if {[info exists hovertimer]} {
4003 after cancel $hovertimer
4005 set hovertimer [after 500 linehover]
4006 $canv delete hover
4009 proc linemotion {x y id} {
4010 global hoverx hovery hoverid hovertimer
4012 if {[info exists hoverid] && $id == $hoverid} {
4013 set hoverx $x
4014 set hovery $y
4015 if {[info exists hovertimer]} {
4016 after cancel $hovertimer
4018 set hovertimer [after 500 linehover]
4022 proc lineleave {id} {
4023 global hoverid hovertimer canv
4025 if {[info exists hoverid] && $id == $hoverid} {
4026 $canv delete hover
4027 if {[info exists hovertimer]} {
4028 after cancel $hovertimer
4029 unset hovertimer
4031 unset hoverid
4035 proc linehover {} {
4036 global hoverx hovery hoverid hovertimer
4037 global canv linespc lthickness
4038 global commitinfo mainfont
4040 set text [lindex $commitinfo($hoverid) 0]
4041 set ymax [lindex [$canv cget -scrollregion] 3]
4042 if {$ymax == {}} return
4043 set yfrac [lindex [$canv yview] 0]
4044 set x [expr {$hoverx + 2 * $linespc}]
4045 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4046 set x0 [expr {$x - 2 * $lthickness}]
4047 set y0 [expr {$y - 2 * $lthickness}]
4048 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4049 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4050 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4051 -fill \#ffff80 -outline black -width 1 -tags hover]
4052 $canv raise $t
4053 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4054 $canv raise $t
4057 proc clickisonarrow {id y} {
4058 global lthickness
4060 set ranges [rowranges $id]
4061 set thresh [expr {2 * $lthickness + 6}]
4062 set n [expr {[llength $ranges] - 1}]
4063 for {set i 1} {$i < $n} {incr i} {
4064 set row [lindex $ranges $i]
4065 if {abs([yc $row] - $y) < $thresh} {
4066 return $i
4069 return {}
4072 proc arrowjump {id n y} {
4073 global canv
4075 # 1 <-> 2, 3 <-> 4, etc...
4076 set n [expr {(($n - 1) ^ 1) + 1}]
4077 set row [lindex [rowranges $id] $n]
4078 set yt [yc $row]
4079 set ymax [lindex [$canv cget -scrollregion] 3]
4080 if {$ymax eq {} || $ymax <= 0} return
4081 set view [$canv yview]
4082 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4083 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4084 if {$yfrac < 0} {
4085 set yfrac 0
4087 allcanvs yview moveto $yfrac
4090 proc lineclick {x y id isnew} {
4091 global ctext commitinfo children canv thickerline curview
4093 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4094 unmarkmatches
4095 unselectline
4096 normalline
4097 $canv delete hover
4098 # draw this line thicker than normal
4099 set thickerline $id
4100 drawlines $id
4101 if {$isnew} {
4102 set ymax [lindex [$canv cget -scrollregion] 3]
4103 if {$ymax eq {}} return
4104 set yfrac [lindex [$canv yview] 0]
4105 set y [expr {$y + $yfrac * $ymax}]
4107 set dirn [clickisonarrow $id $y]
4108 if {$dirn ne {}} {
4109 arrowjump $id $dirn $y
4110 return
4113 if {$isnew} {
4114 addtohistory [list lineclick $x $y $id 0]
4116 # fill the details pane with info about this line
4117 $ctext conf -state normal
4118 $ctext delete 0.0 end
4119 $ctext tag conf link -foreground blue -underline 1
4120 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4121 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4122 $ctext insert end "Parent:\t"
4123 $ctext insert end $id [list link link0]
4124 $ctext tag bind link0 <1> [list selbyid $id]
4125 set info $commitinfo($id)
4126 $ctext insert end "\n\t[lindex $info 0]\n"
4127 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4128 set date [formatdate [lindex $info 2]]
4129 $ctext insert end "\tDate:\t$date\n"
4130 set kids $children($curview,$id)
4131 if {$kids ne {}} {
4132 $ctext insert end "\nChildren:"
4133 set i 0
4134 foreach child $kids {
4135 incr i
4136 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4137 set info $commitinfo($child)
4138 $ctext insert end "\n\t"
4139 $ctext insert end $child [list link link$i]
4140 $ctext tag bind link$i <1> [list selbyid $child]
4141 $ctext insert end "\n\t[lindex $info 0]"
4142 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4143 set date [formatdate [lindex $info 2]]
4144 $ctext insert end "\n\tDate:\t$date\n"
4147 $ctext conf -state disabled
4148 init_flist {}
4151 proc normalline {} {
4152 global thickerline
4153 if {[info exists thickerline]} {
4154 set id $thickerline
4155 unset thickerline
4156 drawlines $id
4160 proc selbyid {id} {
4161 global commitrow curview
4162 if {[info exists commitrow($curview,$id)]} {
4163 selectline $commitrow($curview,$id) 1
4167 proc mstime {} {
4168 global startmstime
4169 if {![info exists startmstime]} {
4170 set startmstime [clock clicks -milliseconds]
4172 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4175 proc rowmenu {x y id} {
4176 global rowctxmenu commitrow selectedline rowmenuid curview
4178 if {![info exists selectedline]
4179 || $commitrow($curview,$id) eq $selectedline} {
4180 set state disabled
4181 } else {
4182 set state normal
4184 $rowctxmenu entryconfigure 0 -state $state
4185 $rowctxmenu entryconfigure 1 -state $state
4186 $rowctxmenu entryconfigure 2 -state $state
4187 set rowmenuid $id
4188 tk_popup $rowctxmenu $x $y
4191 proc diffvssel {dirn} {
4192 global rowmenuid selectedline displayorder
4194 if {![info exists selectedline]} return
4195 if {$dirn} {
4196 set oldid [lindex $displayorder $selectedline]
4197 set newid $rowmenuid
4198 } else {
4199 set oldid $rowmenuid
4200 set newid [lindex $displayorder $selectedline]
4202 addtohistory [list doseldiff $oldid $newid]
4203 doseldiff $oldid $newid
4206 proc doseldiff {oldid newid} {
4207 global ctext
4208 global commitinfo
4210 $ctext conf -state normal
4211 $ctext delete 0.0 end
4212 init_flist "Top"
4213 $ctext insert end "From "
4214 $ctext tag conf link -foreground blue -underline 1
4215 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4216 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4217 $ctext tag bind link0 <1> [list selbyid $oldid]
4218 $ctext insert end $oldid [list link link0]
4219 $ctext insert end "\n "
4220 $ctext insert end [lindex $commitinfo($oldid) 0]
4221 $ctext insert end "\n\nTo "
4222 $ctext tag bind link1 <1> [list selbyid $newid]
4223 $ctext insert end $newid [list link link1]
4224 $ctext insert end "\n "
4225 $ctext insert end [lindex $commitinfo($newid) 0]
4226 $ctext insert end "\n"
4227 $ctext conf -state disabled
4228 $ctext tag delete Comments
4229 $ctext tag remove found 1.0 end
4230 startdiff [list $oldid $newid]
4233 proc mkpatch {} {
4234 global rowmenuid currentid commitinfo patchtop patchnum
4236 if {![info exists currentid]} return
4237 set oldid $currentid
4238 set oldhead [lindex $commitinfo($oldid) 0]
4239 set newid $rowmenuid
4240 set newhead [lindex $commitinfo($newid) 0]
4241 set top .patch
4242 set patchtop $top
4243 catch {destroy $top}
4244 toplevel $top
4245 label $top.title -text "Generate patch"
4246 grid $top.title - -pady 10
4247 label $top.from -text "From:"
4248 entry $top.fromsha1 -width 40 -relief flat
4249 $top.fromsha1 insert 0 $oldid
4250 $top.fromsha1 conf -state readonly
4251 grid $top.from $top.fromsha1 -sticky w
4252 entry $top.fromhead -width 60 -relief flat
4253 $top.fromhead insert 0 $oldhead
4254 $top.fromhead conf -state readonly
4255 grid x $top.fromhead -sticky w
4256 label $top.to -text "To:"
4257 entry $top.tosha1 -width 40 -relief flat
4258 $top.tosha1 insert 0 $newid
4259 $top.tosha1 conf -state readonly
4260 grid $top.to $top.tosha1 -sticky w
4261 entry $top.tohead -width 60 -relief flat
4262 $top.tohead insert 0 $newhead
4263 $top.tohead conf -state readonly
4264 grid x $top.tohead -sticky w
4265 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4266 grid $top.rev x -pady 10
4267 label $top.flab -text "Output file:"
4268 entry $top.fname -width 60
4269 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4270 incr patchnum
4271 grid $top.flab $top.fname -sticky w
4272 frame $top.buts
4273 button $top.buts.gen -text "Generate" -command mkpatchgo
4274 button $top.buts.can -text "Cancel" -command mkpatchcan
4275 grid $top.buts.gen $top.buts.can
4276 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4277 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4278 grid $top.buts - -pady 10 -sticky ew
4279 focus $top.fname
4282 proc mkpatchrev {} {
4283 global patchtop
4285 set oldid [$patchtop.fromsha1 get]
4286 set oldhead [$patchtop.fromhead get]
4287 set newid [$patchtop.tosha1 get]
4288 set newhead [$patchtop.tohead get]
4289 foreach e [list fromsha1 fromhead tosha1 tohead] \
4290 v [list $newid $newhead $oldid $oldhead] {
4291 $patchtop.$e conf -state normal
4292 $patchtop.$e delete 0 end
4293 $patchtop.$e insert 0 $v
4294 $patchtop.$e conf -state readonly
4298 proc mkpatchgo {} {
4299 global patchtop
4301 set oldid [$patchtop.fromsha1 get]
4302 set newid [$patchtop.tosha1 get]
4303 set fname [$patchtop.fname get]
4304 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4305 error_popup "Error creating patch: $err"
4307 catch {destroy $patchtop}
4308 unset patchtop
4311 proc mkpatchcan {} {
4312 global patchtop
4314 catch {destroy $patchtop}
4315 unset patchtop
4318 proc mktag {} {
4319 global rowmenuid mktagtop commitinfo
4321 set top .maketag
4322 set mktagtop $top
4323 catch {destroy $top}
4324 toplevel $top
4325 label $top.title -text "Create tag"
4326 grid $top.title - -pady 10
4327 label $top.id -text "ID:"
4328 entry $top.sha1 -width 40 -relief flat
4329 $top.sha1 insert 0 $rowmenuid
4330 $top.sha1 conf -state readonly
4331 grid $top.id $top.sha1 -sticky w
4332 entry $top.head -width 60 -relief flat
4333 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4334 $top.head conf -state readonly
4335 grid x $top.head -sticky w
4336 label $top.tlab -text "Tag name:"
4337 entry $top.tag -width 60
4338 grid $top.tlab $top.tag -sticky w
4339 frame $top.buts
4340 button $top.buts.gen -text "Create" -command mktaggo
4341 button $top.buts.can -text "Cancel" -command mktagcan
4342 grid $top.buts.gen $top.buts.can
4343 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4344 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4345 grid $top.buts - -pady 10 -sticky ew
4346 focus $top.tag
4349 proc domktag {} {
4350 global mktagtop env tagids idtags
4352 set id [$mktagtop.sha1 get]
4353 set tag [$mktagtop.tag get]
4354 if {$tag == {}} {
4355 error_popup "No tag name specified"
4356 return
4358 if {[info exists tagids($tag)]} {
4359 error_popup "Tag \"$tag\" already exists"
4360 return
4362 if {[catch {
4363 set dir [gitdir]
4364 set fname [file join $dir "refs/tags" $tag]
4365 set f [open $fname w]
4366 puts $f $id
4367 close $f
4368 } err]} {
4369 error_popup "Error creating tag: $err"
4370 return
4373 set tagids($tag) $id
4374 lappend idtags($id) $tag
4375 redrawtags $id
4378 proc redrawtags {id} {
4379 global canv linehtag commitrow idpos selectedline curview
4381 if {![info exists commitrow($curview,$id)]} return
4382 drawcmitrow $commitrow($curview,$id)
4383 $canv delete tag.$id
4384 set xt [eval drawtags $id $idpos($id)]
4385 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4386 if {[info exists selectedline]
4387 && $selectedline == $commitrow($curview,$id)} {
4388 selectline $selectedline 0
4392 proc mktagcan {} {
4393 global mktagtop
4395 catch {destroy $mktagtop}
4396 unset mktagtop
4399 proc mktaggo {} {
4400 domktag
4401 mktagcan
4404 proc writecommit {} {
4405 global rowmenuid wrcomtop commitinfo wrcomcmd
4407 set top .writecommit
4408 set wrcomtop $top
4409 catch {destroy $top}
4410 toplevel $top
4411 label $top.title -text "Write commit to file"
4412 grid $top.title - -pady 10
4413 label $top.id -text "ID:"
4414 entry $top.sha1 -width 40 -relief flat
4415 $top.sha1 insert 0 $rowmenuid
4416 $top.sha1 conf -state readonly
4417 grid $top.id $top.sha1 -sticky w
4418 entry $top.head -width 60 -relief flat
4419 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4420 $top.head conf -state readonly
4421 grid x $top.head -sticky w
4422 label $top.clab -text "Command:"
4423 entry $top.cmd -width 60 -textvariable wrcomcmd
4424 grid $top.clab $top.cmd -sticky w -pady 10
4425 label $top.flab -text "Output file:"
4426 entry $top.fname -width 60
4427 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4428 grid $top.flab $top.fname -sticky w
4429 frame $top.buts
4430 button $top.buts.gen -text "Write" -command wrcomgo
4431 button $top.buts.can -text "Cancel" -command wrcomcan
4432 grid $top.buts.gen $top.buts.can
4433 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4434 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4435 grid $top.buts - -pady 10 -sticky ew
4436 focus $top.fname
4439 proc wrcomgo {} {
4440 global wrcomtop
4442 set id [$wrcomtop.sha1 get]
4443 set cmd "echo $id | [$wrcomtop.cmd get]"
4444 set fname [$wrcomtop.fname get]
4445 if {[catch {exec sh -c $cmd >$fname &} err]} {
4446 error_popup "Error writing commit: $err"
4448 catch {destroy $wrcomtop}
4449 unset wrcomtop
4452 proc wrcomcan {} {
4453 global wrcomtop
4455 catch {destroy $wrcomtop}
4456 unset wrcomtop
4459 proc listrefs {id} {
4460 global idtags idheads idotherrefs
4462 set x {}
4463 if {[info exists idtags($id)]} {
4464 set x $idtags($id)
4466 set y {}
4467 if {[info exists idheads($id)]} {
4468 set y $idheads($id)
4470 set z {}
4471 if {[info exists idotherrefs($id)]} {
4472 set z $idotherrefs($id)
4474 return [list $x $y $z]
4477 proc rereadrefs {} {
4478 global idtags idheads idotherrefs
4480 set refids [concat [array names idtags] \
4481 [array names idheads] [array names idotherrefs]]
4482 foreach id $refids {
4483 if {![info exists ref($id)]} {
4484 set ref($id) [listrefs $id]
4487 readrefs
4488 set refids [lsort -unique [concat $refids [array names idtags] \
4489 [array names idheads] [array names idotherrefs]]]
4490 foreach id $refids {
4491 set v [listrefs $id]
4492 if {![info exists ref($id)] || $ref($id) != $v} {
4493 redrawtags $id
4498 proc showtag {tag isnew} {
4499 global ctext tagcontents tagids linknum
4501 if {$isnew} {
4502 addtohistory [list showtag $tag 0]
4504 $ctext conf -state normal
4505 $ctext delete 0.0 end
4506 set linknum 0
4507 if {[info exists tagcontents($tag)]} {
4508 set text $tagcontents($tag)
4509 } else {
4510 set text "Tag: $tag\nId: $tagids($tag)"
4512 appendwithlinks $text {}
4513 $ctext conf -state disabled
4514 init_flist {}
4517 proc doquit {} {
4518 global stopped
4519 set stopped 100
4520 destroy .
4523 proc doprefs {} {
4524 global maxwidth maxgraphpct diffopts findmergefiles
4525 global oldprefs prefstop
4527 set top .gitkprefs
4528 set prefstop $top
4529 if {[winfo exists $top]} {
4530 raise $top
4531 return
4533 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4534 set oldprefs($v) [set $v]
4536 toplevel $top
4537 wm title $top "Gitk preferences"
4538 label $top.ldisp -text "Commit list display options"
4539 grid $top.ldisp - -sticky w -pady 10
4540 label $top.spacer -text " "
4541 label $top.maxwidthl -text "Maximum graph width (lines)" \
4542 -font optionfont
4543 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4544 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4545 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4546 -font optionfont
4547 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4548 grid x $top.maxpctl $top.maxpct -sticky w
4549 checkbutton $top.findm -variable findmergefiles
4550 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4551 -font optionfont
4552 grid $top.findm $top.findml - -sticky w
4553 label $top.ddisp -text "Diff display options"
4554 grid $top.ddisp - -sticky w -pady 10
4555 label $top.diffoptl -text "Options for diff program" \
4556 -font optionfont
4557 entry $top.diffopt -width 20 -textvariable diffopts
4558 grid x $top.diffoptl $top.diffopt -sticky w
4559 frame $top.buts
4560 button $top.buts.ok -text "OK" -command prefsok
4561 button $top.buts.can -text "Cancel" -command prefscan
4562 grid $top.buts.ok $top.buts.can
4563 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4564 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4565 grid $top.buts - - -pady 10 -sticky ew
4568 proc prefscan {} {
4569 global maxwidth maxgraphpct diffopts findmergefiles
4570 global oldprefs prefstop
4572 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4573 set $v $oldprefs($v)
4575 catch {destroy $prefstop}
4576 unset prefstop
4579 proc prefsok {} {
4580 global maxwidth maxgraphpct
4581 global oldprefs prefstop
4583 catch {destroy $prefstop}
4584 unset prefstop
4585 if {$maxwidth != $oldprefs(maxwidth)
4586 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4587 redisplay
4591 proc formatdate {d} {
4592 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4595 # This list of encoding names and aliases is distilled from
4596 # http://www.iana.org/assignments/character-sets.
4597 # Not all of them are supported by Tcl.
4598 set encoding_aliases {
4599 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4600 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4601 { ISO-10646-UTF-1 csISO10646UTF1 }
4602 { ISO_646.basic:1983 ref csISO646basic1983 }
4603 { INVARIANT csINVARIANT }
4604 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4605 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4606 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4607 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4608 { NATS-DANO iso-ir-9-1 csNATSDANO }
4609 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4610 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4611 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4612 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4613 { ISO-2022-KR csISO2022KR }
4614 { EUC-KR csEUCKR }
4615 { ISO-2022-JP csISO2022JP }
4616 { ISO-2022-JP-2 csISO2022JP2 }
4617 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4618 csISO13JISC6220jp }
4619 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4620 { IT iso-ir-15 ISO646-IT csISO15Italian }
4621 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4622 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4623 { greek7-old iso-ir-18 csISO18Greek7Old }
4624 { latin-greek iso-ir-19 csISO19LatinGreek }
4625 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4626 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4627 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4628 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4629 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4630 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4631 { INIS iso-ir-49 csISO49INIS }
4632 { INIS-8 iso-ir-50 csISO50INIS8 }
4633 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4634 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4635 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4636 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4637 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4638 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4639 csISO60Norwegian1 }
4640 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4641 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4642 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4643 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4644 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4645 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4646 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4647 { greek7 iso-ir-88 csISO88Greek7 }
4648 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4649 { iso-ir-90 csISO90 }
4650 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4651 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4652 csISO92JISC62991984b }
4653 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4654 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4655 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4656 csISO95JIS62291984handadd }
4657 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4658 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4659 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4660 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4661 CP819 csISOLatin1 }
4662 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4663 { T.61-7bit iso-ir-102 csISO102T617bit }
4664 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4665 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4666 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4667 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4668 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4669 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4670 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4671 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4672 arabic csISOLatinArabic }
4673 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4674 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4675 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4676 greek greek8 csISOLatinGreek }
4677 { T.101-G2 iso-ir-128 csISO128T101G2 }
4678 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4679 csISOLatinHebrew }
4680 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4681 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4682 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4683 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4684 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4685 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4686 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4687 csISOLatinCyrillic }
4688 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4689 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4690 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4691 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4692 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4693 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4694 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4695 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4696 { ISO_10367-box iso-ir-155 csISO10367Box }
4697 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4698 { latin-lap lap iso-ir-158 csISO158Lap }
4699 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4700 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4701 { us-dk csUSDK }
4702 { dk-us csDKUS }
4703 { JIS_X0201 X0201 csHalfWidthKatakana }
4704 { KSC5636 ISO646-KR csKSC5636 }
4705 { ISO-10646-UCS-2 csUnicode }
4706 { ISO-10646-UCS-4 csUCS4 }
4707 { DEC-MCS dec csDECMCS }
4708 { hp-roman8 roman8 r8 csHPRoman8 }
4709 { macintosh mac csMacintosh }
4710 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4711 csIBM037 }
4712 { IBM038 EBCDIC-INT cp038 csIBM038 }
4713 { IBM273 CP273 csIBM273 }
4714 { IBM274 EBCDIC-BE CP274 csIBM274 }
4715 { IBM275 EBCDIC-BR cp275 csIBM275 }
4716 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4717 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4718 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4719 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4720 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4721 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4722 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4723 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4724 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4725 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4726 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4727 { IBM437 cp437 437 csPC8CodePage437 }
4728 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4729 { IBM775 cp775 csPC775Baltic }
4730 { IBM850 cp850 850 csPC850Multilingual }
4731 { IBM851 cp851 851 csIBM851 }
4732 { IBM852 cp852 852 csPCp852 }
4733 { IBM855 cp855 855 csIBM855 }
4734 { IBM857 cp857 857 csIBM857 }
4735 { IBM860 cp860 860 csIBM860 }
4736 { IBM861 cp861 861 cp-is csIBM861 }
4737 { IBM862 cp862 862 csPC862LatinHebrew }
4738 { IBM863 cp863 863 csIBM863 }
4739 { IBM864 cp864 csIBM864 }
4740 { IBM865 cp865 865 csIBM865 }
4741 { IBM866 cp866 866 csIBM866 }
4742 { IBM868 CP868 cp-ar csIBM868 }
4743 { IBM869 cp869 869 cp-gr csIBM869 }
4744 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4745 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4746 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4747 { IBM891 cp891 csIBM891 }
4748 { IBM903 cp903 csIBM903 }
4749 { IBM904 cp904 904 csIBBM904 }
4750 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4751 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4752 { IBM1026 CP1026 csIBM1026 }
4753 { EBCDIC-AT-DE csIBMEBCDICATDE }
4754 { EBCDIC-AT-DE-A csEBCDICATDEA }
4755 { EBCDIC-CA-FR csEBCDICCAFR }
4756 { EBCDIC-DK-NO csEBCDICDKNO }
4757 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4758 { EBCDIC-FI-SE csEBCDICFISE }
4759 { EBCDIC-FI-SE-A csEBCDICFISEA }
4760 { EBCDIC-FR csEBCDICFR }
4761 { EBCDIC-IT csEBCDICIT }
4762 { EBCDIC-PT csEBCDICPT }
4763 { EBCDIC-ES csEBCDICES }
4764 { EBCDIC-ES-A csEBCDICESA }
4765 { EBCDIC-ES-S csEBCDICESS }
4766 { EBCDIC-UK csEBCDICUK }
4767 { EBCDIC-US csEBCDICUS }
4768 { UNKNOWN-8BIT csUnknown8BiT }
4769 { MNEMONIC csMnemonic }
4770 { MNEM csMnem }
4771 { VISCII csVISCII }
4772 { VIQR csVIQR }
4773 { KOI8-R csKOI8R }
4774 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4775 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4776 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4777 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4778 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4779 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4780 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4781 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4782 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4783 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4784 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4785 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4786 { IBM1047 IBM-1047 }
4787 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4788 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4789 { UNICODE-1-1 csUnicode11 }
4790 { CESU-8 csCESU-8 }
4791 { BOCU-1 csBOCU-1 }
4792 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4793 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4794 l8 }
4795 { ISO-8859-15 ISO_8859-15 Latin-9 }
4796 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4797 { GBK CP936 MS936 windows-936 }
4798 { JIS_Encoding csJISEncoding }
4799 { Shift_JIS MS_Kanji csShiftJIS }
4800 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4801 EUC-JP }
4802 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4803 { ISO-10646-UCS-Basic csUnicodeASCII }
4804 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4805 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4806 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4807 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4808 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4809 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4810 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4811 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4812 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4813 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4814 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4815 { Ventura-US csVenturaUS }
4816 { Ventura-International csVenturaInternational }
4817 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4818 { PC8-Turkish csPC8Turkish }
4819 { IBM-Symbols csIBMSymbols }
4820 { IBM-Thai csIBMThai }
4821 { HP-Legal csHPLegal }
4822 { HP-Pi-font csHPPiFont }
4823 { HP-Math8 csHPMath8 }
4824 { Adobe-Symbol-Encoding csHPPSMath }
4825 { HP-DeskTop csHPDesktop }
4826 { Ventura-Math csVenturaMath }
4827 { Microsoft-Publishing csMicrosoftPublishing }
4828 { Windows-31J csWindows31J }
4829 { GB2312 csGB2312 }
4830 { Big5 csBig5 }
4833 proc tcl_encoding {enc} {
4834 global encoding_aliases
4835 set names [encoding names]
4836 set lcnames [string tolower $names]
4837 set enc [string tolower $enc]
4838 set i [lsearch -exact $lcnames $enc]
4839 if {$i < 0} {
4840 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4841 if {[regsub {^iso[-_]} $enc iso encx]} {
4842 set i [lsearch -exact $lcnames $encx]
4845 if {$i < 0} {
4846 foreach l $encoding_aliases {
4847 set ll [string tolower $l]
4848 if {[lsearch -exact $ll $enc] < 0} continue
4849 # look through the aliases for one that tcl knows about
4850 foreach e $ll {
4851 set i [lsearch -exact $lcnames $e]
4852 if {$i < 0} {
4853 if {[regsub {^iso[-_]} $e iso ex]} {
4854 set i [lsearch -exact $lcnames $ex]
4857 if {$i >= 0} break
4859 break
4862 if {$i >= 0} {
4863 return [lindex $names $i]
4865 return {}
4868 # defaults...
4869 set datemode 0
4870 set diffopts "-U 5 -p"
4871 set wrcomcmd "git diff-tree --stdin -p --pretty"
4873 set gitencoding {}
4874 catch {
4875 set gitencoding [exec git repo-config --get i18n.commitencoding]
4877 if {$gitencoding == ""} {
4878 set gitencoding "utf-8"
4880 set tclencoding [tcl_encoding $gitencoding]
4881 if {$tclencoding == {}} {
4882 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4885 set mainfont {Helvetica 9}
4886 set textfont {Courier 9}
4887 set uifont {Helvetica 9 bold}
4888 set findmergefiles 0
4889 set maxgraphpct 50
4890 set maxwidth 16
4891 set revlistorder 0
4892 set fastdate 0
4893 set uparrowlen 7
4894 set downarrowlen 7
4895 set mingaplen 30
4896 set flistmode "flat"
4897 set cmitmode "patch"
4898 set wrapcomment "none"
4900 set colors {green red blue magenta darkgrey brown orange}
4902 catch {source ~/.gitk}
4904 font create optionfont -family sans-serif -size -12
4906 set revtreeargs {}
4907 foreach arg $argv {
4908 switch -regexp -- $arg {
4909 "^$" { }
4910 "^-d" { set datemode 1 }
4911 default {
4912 lappend revtreeargs $arg
4917 # check that we can find a .git directory somewhere...
4918 set gitdir [gitdir]
4919 if {![file isdirectory $gitdir]} {
4920 show_error {} . "Cannot find the git directory \"$gitdir\"."
4921 exit 1
4924 set cmdline_files {}
4925 set i [lsearch -exact $revtreeargs "--"]
4926 if {$i >= 0} {
4927 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
4928 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
4929 } elseif {$revtreeargs ne {}} {
4930 if {[catch {
4931 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
4932 set cmdline_files [split $f "\n"]
4933 set n [llength $cmdline_files]
4934 set revtreeargs [lrange $revtreeargs 0 end-$n]
4935 } err]} {
4936 # unfortunately we get both stdout and stderr in $err,
4937 # so look for "fatal:".
4938 set i [string first "fatal:" $err]
4939 if {$i > 0} {
4940 set err [string range $err [expr {$i + 6}] end]
4942 show_error {} . "Bad arguments to gitk:\n$err"
4943 exit 1
4947 set history {}
4948 set historyindex 0
4950 set optim_delay 16
4952 set nextviewnum 1
4953 set curview 0
4954 set selectedview 0
4955 set selectedhlview {}
4956 set viewfiles(0) {}
4957 set viewperm(0) 0
4958 set viewargs(0) {}
4960 set cmdlineok 0
4961 set stopped 0
4962 set stuffsaved 0
4963 set patchnum 0
4964 setcoords
4965 makewindow
4966 readrefs
4968 if {$cmdline_files ne {} || $revtreeargs ne {}} {
4969 # create a view for the files/dirs specified on the command line
4970 set curview 1
4971 set selectedview 1
4972 set nextviewnum 2
4973 set viewname(1) "Command line"
4974 set viewfiles(1) $cmdline_files
4975 set viewargs(1) $revtreeargs
4976 set viewperm(1) 0
4977 addviewmenu 1
4978 .bar.view entryconf 2 -state normal
4979 .bar.view entryconf 3 -state normal
4982 if {[info exists permviews]} {
4983 foreach v $permviews {
4984 set n $nextviewnum
4985 incr nextviewnum
4986 set viewname($n) [lindex $v 0]
4987 set viewfiles($n) [lindex $v 1]
4988 set viewargs($n) [lindex $v 2]
4989 set viewperm($n) 1
4990 addviewmenu $n
4993 getcommits