Merge branch 'jc/apply'
[git/gitweb.git] / gitk
blob4aa57c01ce56e505aba5384f716376a68a7fdc7a
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 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 $w"
364 pack $w.ok -side bottom -fill x
365 bind $w <Visibility> "grab $w; focus $w"
366 bind $w <Key-Return> "destroy $w"
367 tkwait window $w
370 proc error_popup msg {
371 set w .error
372 toplevel $w
373 wm transient $w .
374 show_error $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
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 filesep -font [concat $textfont bold] -back "#aaaaaa"
531 $ctext tag conf hunksep -fore blue
532 $ctext tag conf d0 -fore red
533 $ctext tag conf d1 -fore "#00a000"
534 $ctext tag conf m0 -fore red
535 $ctext tag conf m1 -fore blue
536 $ctext tag conf m2 -fore green
537 $ctext tag conf m3 -fore purple
538 $ctext tag conf m4 -fore brown
539 $ctext tag conf m5 -fore "#009090"
540 $ctext tag conf m6 -fore magenta
541 $ctext tag conf m7 -fore "#808000"
542 $ctext tag conf m8 -fore "#009000"
543 $ctext tag conf m9 -fore "#ff0080"
544 $ctext tag conf m10 -fore cyan
545 $ctext tag conf m11 -fore "#b07070"
546 $ctext tag conf m12 -fore "#70b0f0"
547 $ctext tag conf m13 -fore "#70f0b0"
548 $ctext tag conf m14 -fore "#f0b070"
549 $ctext tag conf m15 -fore "#ff70b0"
550 $ctext tag conf mmax -fore darkgrey
551 set mergemax 16
552 $ctext tag conf mresult -font [concat $textfont bold]
553 $ctext tag conf msep -font [concat $textfont bold]
554 $ctext tag conf found -back yellow
556 frame .ctop.cdet.right
557 frame .ctop.cdet.right.mode
558 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
559 -command reselectline -variable cmitmode -value "patch"
560 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
561 -command reselectline -variable cmitmode -value "tree"
562 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
563 pack .ctop.cdet.right.mode -side top -fill x
564 set cflist .ctop.cdet.right.cfiles
565 set indent [font measure $mainfont "nn"]
566 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
567 -tabs [list $indent [expr {2 * $indent}]] \
568 -yscrollcommand ".ctop.cdet.right.sb set" \
569 -cursor [. cget -cursor] \
570 -spacing1 1 -spacing3 1
571 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
572 pack .ctop.cdet.right.sb -side right -fill y
573 pack $cflist -side left -fill both -expand 1
574 $cflist tag configure highlight \
575 -background [$cflist cget -selectbackground]
576 .ctop.cdet add .ctop.cdet.right
577 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
579 pack .ctop -side top -fill both -expand 1
581 bindall <1> {selcanvline %W %x %y}
582 #bindall <B1-Motion> {selcanvline %W %x %y}
583 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
584 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
585 bindall <2> "canvscan mark %W %x %y"
586 bindall <B2-Motion> "canvscan dragto %W %x %y"
587 bindkey <Home> selfirstline
588 bindkey <End> sellastline
589 bind . <Key-Up> "selnextline -1"
590 bind . <Key-Down> "selnextline 1"
591 bindkey <Key-Right> "goforw"
592 bindkey <Key-Left> "goback"
593 bind . <Key-Prior> "selnextpage -1"
594 bind . <Key-Next> "selnextpage 1"
595 bind . <Control-Home> "allcanvs yview moveto 0.0"
596 bind . <Control-End> "allcanvs yview moveto 1.0"
597 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
598 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
599 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
600 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
601 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
602 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
603 bindkey <Key-space> "$ctext yview scroll 1 pages"
604 bindkey p "selnextline -1"
605 bindkey n "selnextline 1"
606 bindkey z "goback"
607 bindkey x "goforw"
608 bindkey i "selnextline -1"
609 bindkey k "selnextline 1"
610 bindkey j "goback"
611 bindkey l "goforw"
612 bindkey b "$ctext yview scroll -1 pages"
613 bindkey d "$ctext yview scroll 18 units"
614 bindkey u "$ctext yview scroll -18 units"
615 bindkey / {findnext 1}
616 bindkey <Key-Return> {findnext 0}
617 bindkey ? findprev
618 bindkey f nextfile
619 bind . <Control-q> doquit
620 bind . <Control-f> dofind
621 bind . <Control-g> {findnext 0}
622 bind . <Control-r> findprev
623 bind . <Control-equal> {incrfont 1}
624 bind . <Control-KP_Add> {incrfont 1}
625 bind . <Control-minus> {incrfont -1}
626 bind . <Control-KP_Subtract> {incrfont -1}
627 bind . <Destroy> {savestuff %W}
628 bind . <Button-1> "click %W"
629 bind $fstring <Key-Return> dofind
630 bind $sha1entry <Key-Return> gotocommit
631 bind $sha1entry <<PasteSelection>> clearsha1
632 bind $cflist <1> {sel_flist %W %x %y; break}
633 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
634 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
636 set maincursor [. cget -cursor]
637 set textcursor [$ctext cget -cursor]
638 set curtextcursor $textcursor
640 set rowctxmenu .rowctxmenu
641 menu $rowctxmenu -tearoff 0
642 $rowctxmenu add command -label "Diff this -> selected" \
643 -command {diffvssel 0}
644 $rowctxmenu add command -label "Diff selected -> this" \
645 -command {diffvssel 1}
646 $rowctxmenu add command -label "Make patch" -command mkpatch
647 $rowctxmenu add command -label "Create tag" -command mktag
648 $rowctxmenu add command -label "Write commit to file" -command writecommit
651 # mouse-2 makes all windows scan vertically, but only the one
652 # the cursor is in scans horizontally
653 proc canvscan {op w x y} {
654 global canv canv2 canv3
655 foreach c [list $canv $canv2 $canv3] {
656 if {$c == $w} {
657 $c scan $op $x $y
658 } else {
659 $c scan $op 0 $y
664 proc scrollcanv {cscroll f0 f1} {
665 $cscroll set $f0 $f1
666 drawfrac $f0 $f1
669 # when we make a key binding for the toplevel, make sure
670 # it doesn't get triggered when that key is pressed in the
671 # find string entry widget.
672 proc bindkey {ev script} {
673 global entries
674 bind . $ev $script
675 set escript [bind Entry $ev]
676 if {$escript == {}} {
677 set escript [bind Entry <Key>]
679 foreach e $entries {
680 bind $e $ev "$escript; break"
684 # set the focus back to the toplevel for any click outside
685 # the entry widgets
686 proc click {w} {
687 global entries
688 foreach e $entries {
689 if {$w == $e} return
691 focus .
694 proc savestuff {w} {
695 global canv canv2 canv3 ctext cflist mainfont textfont uifont
696 global stuffsaved findmergefiles maxgraphpct
697 global maxwidth
698 global viewname viewfiles viewargs viewperm nextviewnum
699 global cmitmode
701 if {$stuffsaved} return
702 if {![winfo viewable .]} return
703 catch {
704 set f [open "~/.gitk-new" w]
705 puts $f [list set mainfont $mainfont]
706 puts $f [list set textfont $textfont]
707 puts $f [list set uifont $uifont]
708 puts $f [list set findmergefiles $findmergefiles]
709 puts $f [list set maxgraphpct $maxgraphpct]
710 puts $f [list set maxwidth $maxwidth]
711 puts $f [list set cmitmode $cmitmode]
712 puts $f "set geometry(width) [winfo width .ctop]"
713 puts $f "set geometry(height) [winfo height .ctop]"
714 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
715 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
716 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
717 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
718 set wid [expr {([winfo width $ctext] - 8) \
719 / [font measure $textfont "0"]}]
720 puts $f "set geometry(ctextw) $wid"
721 set wid [expr {([winfo width $cflist] - 11) \
722 / [font measure [$cflist cget -font] "0"]}]
723 puts $f "set geometry(cflistw) $wid"
724 puts -nonewline $f "set permviews {"
725 for {set v 0} {$v < $nextviewnum} {incr v} {
726 if {$viewperm($v)} {
727 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
730 puts $f "}"
731 close $f
732 file rename -force "~/.gitk-new" "~/.gitk"
734 set stuffsaved 1
737 proc resizeclistpanes {win w} {
738 global oldwidth
739 if {[info exists oldwidth($win)]} {
740 set s0 [$win sash coord 0]
741 set s1 [$win sash coord 1]
742 if {$w < 60} {
743 set sash0 [expr {int($w/2 - 2)}]
744 set sash1 [expr {int($w*5/6 - 2)}]
745 } else {
746 set factor [expr {1.0 * $w / $oldwidth($win)}]
747 set sash0 [expr {int($factor * [lindex $s0 0])}]
748 set sash1 [expr {int($factor * [lindex $s1 0])}]
749 if {$sash0 < 30} {
750 set sash0 30
752 if {$sash1 < $sash0 + 20} {
753 set sash1 [expr {$sash0 + 20}]
755 if {$sash1 > $w - 10} {
756 set sash1 [expr {$w - 10}]
757 if {$sash0 > $sash1 - 20} {
758 set sash0 [expr {$sash1 - 20}]
762 $win sash place 0 $sash0 [lindex $s0 1]
763 $win sash place 1 $sash1 [lindex $s1 1]
765 set oldwidth($win) $w
768 proc resizecdetpanes {win w} {
769 global oldwidth
770 if {[info exists oldwidth($win)]} {
771 set s0 [$win sash coord 0]
772 if {$w < 60} {
773 set sash0 [expr {int($w*3/4 - 2)}]
774 } else {
775 set factor [expr {1.0 * $w / $oldwidth($win)}]
776 set sash0 [expr {int($factor * [lindex $s0 0])}]
777 if {$sash0 < 45} {
778 set sash0 45
780 if {$sash0 > $w - 15} {
781 set sash0 [expr {$w - 15}]
784 $win sash place 0 $sash0 [lindex $s0 1]
786 set oldwidth($win) $w
789 proc allcanvs args {
790 global canv canv2 canv3
791 eval $canv $args
792 eval $canv2 $args
793 eval $canv3 $args
796 proc bindall {event action} {
797 global canv canv2 canv3
798 bind $canv $event $action
799 bind $canv2 $event $action
800 bind $canv3 $event $action
803 proc about {} {
804 set w .about
805 if {[winfo exists $w]} {
806 raise $w
807 return
809 toplevel $w
810 wm title $w "About gitk"
811 message $w.m -text {
812 Gitk - a commit viewer for git
814 Copyright © 2005-2006 Paul Mackerras
816 Use and redistribute under the terms of the GNU General Public License} \
817 -justify center -aspect 400
818 pack $w.m -side top -fill x -padx 20 -pady 20
819 button $w.ok -text Close -command "destroy $w"
820 pack $w.ok -side bottom
823 proc keys {} {
824 set w .keys
825 if {[winfo exists $w]} {
826 raise $w
827 return
829 toplevel $w
830 wm title $w "Gitk key bindings"
831 message $w.m -text {
832 Gitk key bindings:
834 <Ctrl-Q> Quit
835 <Home> Move to first commit
836 <End> Move to last commit
837 <Up>, p, i Move up one commit
838 <Down>, n, k Move down one commit
839 <Left>, z, j Go back in history list
840 <Right>, x, l Go forward in history list
841 <PageUp> Move up one page in commit list
842 <PageDown> Move down one page in commit list
843 <Ctrl-Home> Scroll to top of commit list
844 <Ctrl-End> Scroll to bottom of commit list
845 <Ctrl-Up> Scroll commit list up one line
846 <Ctrl-Down> Scroll commit list down one line
847 <Ctrl-PageUp> Scroll commit list up one page
848 <Ctrl-PageDown> Scroll commit list down one page
849 <Delete>, b Scroll diff view up one page
850 <Backspace> Scroll diff view up one page
851 <Space> Scroll diff view down one page
852 u Scroll diff view up 18 lines
853 d Scroll diff view down 18 lines
854 <Ctrl-F> Find
855 <Ctrl-G> Move to next find hit
856 <Ctrl-R> Move to previous find hit
857 <Return> Move to next find hit
858 / Move to next find hit, or redo find
859 ? Move to previous find hit
860 f Scroll diff view to next file
861 <Ctrl-KP+> Increase font size
862 <Ctrl-plus> Increase font size
863 <Ctrl-KP-> Decrease font size
864 <Ctrl-minus> Decrease font size
866 -justify left -bg white -border 2 -relief sunken
867 pack $w.m -side top -fill both
868 button $w.ok -text Close -command "destroy $w"
869 pack $w.ok -side bottom
872 # Procedures for manipulating the file list window at the
873 # bottom right of the overall window.
875 proc treeview {w l openlevs} {
876 global treecontents treediropen treeheight treeparent treeindex
878 set ix 0
879 set treeindex() 0
880 set lev 0
881 set prefix {}
882 set prefixend -1
883 set prefendstack {}
884 set htstack {}
885 set ht 0
886 set treecontents() {}
887 $w conf -state normal
888 foreach f $l {
889 while {[string range $f 0 $prefixend] ne $prefix} {
890 if {$lev <= $openlevs} {
891 $w mark set e:$treeindex($prefix) "end -1c"
892 $w mark gravity e:$treeindex($prefix) left
894 set treeheight($prefix) $ht
895 incr ht [lindex $htstack end]
896 set htstack [lreplace $htstack end end]
897 set prefixend [lindex $prefendstack end]
898 set prefendstack [lreplace $prefendstack end end]
899 set prefix [string range $prefix 0 $prefixend]
900 incr lev -1
902 set tail [string range $f [expr {$prefixend+1}] end]
903 while {[set slash [string first "/" $tail]] >= 0} {
904 lappend htstack $ht
905 set ht 0
906 lappend prefendstack $prefixend
907 incr prefixend [expr {$slash + 1}]
908 set d [string range $tail 0 $slash]
909 lappend treecontents($prefix) $d
910 set oldprefix $prefix
911 append prefix $d
912 set treecontents($prefix) {}
913 set treeindex($prefix) [incr ix]
914 set treeparent($prefix) $oldprefix
915 set tail [string range $tail [expr {$slash+1}] end]
916 if {$lev <= $openlevs} {
917 set ht 1
918 set treediropen($prefix) [expr {$lev < $openlevs}]
919 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
920 $w mark set d:$ix "end -1c"
921 $w mark gravity d:$ix left
922 set str "\n"
923 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
924 $w insert end $str
925 $w image create end -align center -image $bm -padx 1 \
926 -name a:$ix
927 $w insert end $d
928 $w mark set s:$ix "end -1c"
929 $w mark gravity s:$ix left
931 incr lev
933 if {$tail ne {}} {
934 if {$lev <= $openlevs} {
935 incr ht
936 set str "\n"
937 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
938 $w insert end $str
939 $w insert end $tail
941 lappend treecontents($prefix) $tail
944 while {$htstack ne {}} {
945 set treeheight($prefix) $ht
946 incr ht [lindex $htstack end]
947 set htstack [lreplace $htstack end end]
949 $w conf -state disabled
952 proc linetoelt {l} {
953 global treeheight treecontents
955 set y 2
956 set prefix {}
957 while {1} {
958 foreach e $treecontents($prefix) {
959 if {$y == $l} {
960 return "$prefix$e"
962 set n 1
963 if {[string index $e end] eq "/"} {
964 set n $treeheight($prefix$e)
965 if {$y + $n > $l} {
966 append prefix $e
967 incr y
968 break
971 incr y $n
976 proc treeclosedir {w dir} {
977 global treediropen treeheight treeparent treeindex
979 set ix $treeindex($dir)
980 $w conf -state normal
981 $w delete s:$ix e:$ix
982 set treediropen($dir) 0
983 $w image configure a:$ix -image tri-rt
984 $w conf -state disabled
985 set n [expr {1 - $treeheight($dir)}]
986 while {$dir ne {}} {
987 incr treeheight($dir) $n
988 set dir $treeparent($dir)
992 proc treeopendir {w dir} {
993 global treediropen treeheight treeparent treecontents treeindex
995 set ix $treeindex($dir)
996 $w conf -state normal
997 $w image configure a:$ix -image tri-dn
998 $w mark set e:$ix s:$ix
999 $w mark gravity e:$ix right
1000 set lev 0
1001 set str "\n"
1002 set n [llength $treecontents($dir)]
1003 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1004 incr lev
1005 append str "\t"
1006 incr treeheight($x) $n
1008 foreach e $treecontents($dir) {
1009 if {[string index $e end] eq "/"} {
1010 set de $dir$e
1011 set iy $treeindex($de)
1012 $w mark set d:$iy e:$ix
1013 $w mark gravity d:$iy left
1014 $w insert e:$ix $str
1015 set treediropen($de) 0
1016 $w image create e:$ix -align center -image tri-rt -padx 1 \
1017 -name a:$iy
1018 $w insert e:$ix $e
1019 $w mark set s:$iy e:$ix
1020 $w mark gravity s:$iy left
1021 set treeheight($de) 1
1022 } else {
1023 $w insert e:$ix $str
1024 $w insert e:$ix $e
1027 $w mark gravity e:$ix left
1028 $w conf -state disabled
1029 set treediropen($dir) 1
1030 set top [lindex [split [$w index @0,0] .] 0]
1031 set ht [$w cget -height]
1032 set l [lindex [split [$w index s:$ix] .] 0]
1033 if {$l < $top} {
1034 $w yview $l.0
1035 } elseif {$l + $n + 1 > $top + $ht} {
1036 set top [expr {$l + $n + 2 - $ht}]
1037 if {$l < $top} {
1038 set top $l
1040 $w yview $top.0
1044 proc treeclick {w x y} {
1045 global treediropen cmitmode ctext cflist cflist_top
1047 if {$cmitmode ne "tree"} return
1048 if {![info exists cflist_top]} return
1049 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1050 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1051 $cflist tag add highlight $l.0 "$l.0 lineend"
1052 set cflist_top $l
1053 if {$l == 1} {
1054 $ctext yview 1.0
1055 return
1057 set e [linetoelt $l]
1058 if {[string index $e end] ne "/"} {
1059 showfile $e
1060 } elseif {$treediropen($e)} {
1061 treeclosedir $w $e
1062 } else {
1063 treeopendir $w $e
1067 proc setfilelist {id} {
1068 global treefilelist cflist
1070 treeview $cflist $treefilelist($id) 0
1073 image create bitmap tri-rt -background black -foreground blue -data {
1074 #define tri-rt_width 13
1075 #define tri-rt_height 13
1076 static unsigned char tri-rt_bits[] = {
1077 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1078 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1079 0x00, 0x00};
1080 } -maskdata {
1081 #define tri-rt-mask_width 13
1082 #define tri-rt-mask_height 13
1083 static unsigned char tri-rt-mask_bits[] = {
1084 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1085 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1086 0x08, 0x00};
1088 image create bitmap tri-dn -background black -foreground blue -data {
1089 #define tri-dn_width 13
1090 #define tri-dn_height 13
1091 static unsigned char tri-dn_bits[] = {
1092 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1093 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1094 0x00, 0x00};
1095 } -maskdata {
1096 #define tri-dn-mask_width 13
1097 #define tri-dn-mask_height 13
1098 static unsigned char tri-dn-mask_bits[] = {
1099 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1100 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1101 0x00, 0x00};
1104 proc init_flist {first} {
1105 global cflist cflist_top selectedline difffilestart
1107 $cflist conf -state normal
1108 $cflist delete 0.0 end
1109 if {$first ne {}} {
1110 $cflist insert end $first
1111 set cflist_top 1
1112 $cflist tag add highlight 1.0 "1.0 lineend"
1113 } else {
1114 catch {unset cflist_top}
1116 $cflist conf -state disabled
1117 set difffilestart {}
1120 proc add_flist {fl} {
1121 global flistmode cflist
1123 $cflist conf -state normal
1124 if {$flistmode eq "flat"} {
1125 foreach f $fl {
1126 $cflist insert end "\n$f"
1129 $cflist conf -state disabled
1132 proc sel_flist {w x y} {
1133 global flistmode ctext difffilestart cflist cflist_top cmitmode
1135 if {$cmitmode eq "tree"} return
1136 if {![info exists cflist_top]} return
1137 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1138 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1139 $cflist tag add highlight $l.0 "$l.0 lineend"
1140 set cflist_top $l
1141 if {$l == 1} {
1142 $ctext yview 1.0
1143 } else {
1144 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1148 # Functions for adding and removing shell-type quoting
1150 proc shellquote {str} {
1151 if {![string match "*\['\"\\ \t]*" $str]} {
1152 return $str
1154 if {![string match "*\['\"\\]*" $str]} {
1155 return "\"$str\""
1157 if {![string match "*'*" $str]} {
1158 return "'$str'"
1160 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1163 proc shellarglist {l} {
1164 set str {}
1165 foreach a $l {
1166 if {$str ne {}} {
1167 append str " "
1169 append str [shellquote $a]
1171 return $str
1174 proc shelldequote {str} {
1175 set ret {}
1176 set used -1
1177 while {1} {
1178 incr used
1179 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1180 append ret [string range $str $used end]
1181 set used [string length $str]
1182 break
1184 set first [lindex $first 0]
1185 set ch [string index $str $first]
1186 if {$first > $used} {
1187 append ret [string range $str $used [expr {$first - 1}]]
1188 set used $first
1190 if {$ch eq " " || $ch eq "\t"} break
1191 incr used
1192 if {$ch eq "'"} {
1193 set first [string first "'" $str $used]
1194 if {$first < 0} {
1195 error "unmatched single-quote"
1197 append ret [string range $str $used [expr {$first - 1}]]
1198 set used $first
1199 continue
1201 if {$ch eq "\\"} {
1202 if {$used >= [string length $str]} {
1203 error "trailing backslash"
1205 append ret [string index $str $used]
1206 continue
1208 # here ch == "\""
1209 while {1} {
1210 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1211 error "unmatched double-quote"
1213 set first [lindex $first 0]
1214 set ch [string index $str $first]
1215 if {$first > $used} {
1216 append ret [string range $str $used [expr {$first - 1}]]
1217 set used $first
1219 if {$ch eq "\""} break
1220 incr used
1221 append ret [string index $str $used]
1222 incr used
1225 return [list $used $ret]
1228 proc shellsplit {str} {
1229 set l {}
1230 while {1} {
1231 set str [string trimleft $str]
1232 if {$str eq {}} break
1233 set dq [shelldequote $str]
1234 set n [lindex $dq 0]
1235 set word [lindex $dq 1]
1236 set str [string range $str $n end]
1237 lappend l $word
1239 return $l
1242 # Code to implement multiple views
1244 proc newview {ishighlight} {
1245 global nextviewnum newviewname newviewperm uifont newishighlight
1246 global newviewargs revtreeargs
1248 set newishighlight $ishighlight
1249 set top .gitkview
1250 if {[winfo exists $top]} {
1251 raise $top
1252 return
1254 set newviewname($nextviewnum) "View $nextviewnum"
1255 set newviewperm($nextviewnum) 0
1256 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1257 vieweditor $top $nextviewnum "Gitk view definition"
1260 proc editview {} {
1261 global curview
1262 global viewname viewperm newviewname newviewperm
1263 global viewargs newviewargs
1265 set top .gitkvedit-$curview
1266 if {[winfo exists $top]} {
1267 raise $top
1268 return
1270 set newviewname($curview) $viewname($curview)
1271 set newviewperm($curview) $viewperm($curview)
1272 set newviewargs($curview) [shellarglist $viewargs($curview)]
1273 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1276 proc vieweditor {top n title} {
1277 global newviewname newviewperm viewfiles
1278 global uifont
1280 toplevel $top
1281 wm title $top $title
1282 label $top.nl -text "Name" -font $uifont
1283 entry $top.name -width 20 -textvariable newviewname($n)
1284 grid $top.nl $top.name -sticky w -pady 5
1285 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1286 grid $top.perm - -pady 5 -sticky w
1287 message $top.al -aspect 1000 -font $uifont \
1288 -text "Commits to include (arguments to git-rev-list):"
1289 grid $top.al - -sticky w -pady 5
1290 entry $top.args -width 50 -textvariable newviewargs($n) \
1291 -background white
1292 grid $top.args - -sticky ew -padx 5
1293 message $top.l -aspect 1000 -font $uifont \
1294 -text "Enter files and directories to include, one per line:"
1295 grid $top.l - -sticky w
1296 text $top.t -width 40 -height 10 -background white
1297 if {[info exists viewfiles($n)]} {
1298 foreach f $viewfiles($n) {
1299 $top.t insert end $f
1300 $top.t insert end "\n"
1302 $top.t delete {end - 1c} end
1303 $top.t mark set insert 0.0
1305 grid $top.t - -sticky ew -padx 5
1306 frame $top.buts
1307 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1308 button $top.buts.can -text "Cancel" -command [list destroy $top]
1309 grid $top.buts.ok $top.buts.can
1310 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1311 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1312 grid $top.buts - -pady 10 -sticky ew
1313 focus $top.t
1316 proc doviewmenu {m first cmd op args} {
1317 set nmenu [$m index end]
1318 for {set i $first} {$i <= $nmenu} {incr i} {
1319 if {[$m entrycget $i -command] eq $cmd} {
1320 eval $m $op $i $args
1321 break
1326 proc allviewmenus {n op args} {
1327 doviewmenu .bar.view 7 [list showview $n] $op $args
1328 doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1331 proc newviewok {top n} {
1332 global nextviewnum newviewperm newviewname newishighlight
1333 global viewname viewfiles viewperm selectedview curview
1334 global viewargs newviewargs
1336 if {[catch {
1337 set newargs [shellsplit $newviewargs($n)]
1338 } err]} {
1339 error_popup "Error in commit selection arguments: $err"
1340 wm raise $top
1341 focus $top
1342 return
1344 set files {}
1345 foreach f [split [$top.t get 0.0 end] "\n"] {
1346 set ft [string trim $f]
1347 if {$ft ne {}} {
1348 lappend files $ft
1351 if {![info exists viewfiles($n)]} {
1352 # creating a new view
1353 incr nextviewnum
1354 set viewname($n) $newviewname($n)
1355 set viewperm($n) $newviewperm($n)
1356 set viewfiles($n) $files
1357 set viewargs($n) $newargs
1358 addviewmenu $n
1359 if {!$newishighlight} {
1360 after idle showview $n
1361 } else {
1362 after idle addhighlight $n
1364 } else {
1365 # editing an existing view
1366 set viewperm($n) $newviewperm($n)
1367 if {$newviewname($n) ne $viewname($n)} {
1368 set viewname($n) $newviewname($n)
1369 allviewmenus $n entryconf -label $viewname($n)
1371 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1372 set viewfiles($n) $files
1373 set viewargs($n) $newargs
1374 if {$curview == $n} {
1375 after idle updatecommits
1379 catch {destroy $top}
1382 proc delview {} {
1383 global curview viewdata viewperm
1385 if {$curview == 0} return
1386 allviewmenus $curview delete
1387 set viewdata($curview) {}
1388 set viewperm($curview) 0
1389 showview 0
1392 proc addviewmenu {n} {
1393 global viewname
1395 .bar.view add radiobutton -label $viewname($n) \
1396 -command [list showview $n] -variable selectedview -value $n
1397 .bar.view.hl add radiobutton -label $viewname($n) \
1398 -command [list addhighlight $n] -variable selectedhlview -value $n
1401 proc flatten {var} {
1402 global $var
1404 set ret {}
1405 foreach i [array names $var] {
1406 lappend ret $i [set $var\($i\)]
1408 return $ret
1411 proc unflatten {var l} {
1412 global $var
1414 catch {unset $var}
1415 foreach {i v} $l {
1416 set $var\($i\) $v
1420 proc showview {n} {
1421 global curview viewdata viewfiles
1422 global displayorder parentlist childlist rowidlist rowoffsets
1423 global colormap rowtextx commitrow nextcolor canvxmax
1424 global numcommits rowrangelist commitlisted idrowranges
1425 global selectedline currentid canv canvy0
1426 global matchinglines treediffs
1427 global pending_select phase
1428 global commitidx rowlaidout rowoptim linesegends
1429 global commfd nextupdate
1430 global selectedview hlview selectedhlview
1431 global vparentlist vchildlist vdisporder vcmitlisted
1433 if {$n == $curview} return
1434 set selid {}
1435 if {[info exists selectedline]} {
1436 set selid $currentid
1437 set y [yc $selectedline]
1438 set ymax [lindex [$canv cget -scrollregion] 3]
1439 set span [$canv yview]
1440 set ytop [expr {[lindex $span 0] * $ymax}]
1441 set ybot [expr {[lindex $span 1] * $ymax}]
1442 if {$ytop < $y && $y < $ybot} {
1443 set yscreen [expr {$y - $ytop}]
1444 } else {
1445 set yscreen [expr {($ybot - $ytop) / 2}]
1448 unselectline
1449 normalline
1450 stopfindproc
1451 if {$curview >= 0} {
1452 set vparentlist($curview) $parentlist
1453 set vchildlist($curview) $childlist
1454 set vdisporder($curview) $displayorder
1455 set vcmitlisted($curview) $commitlisted
1456 if {$phase ne {}} {
1457 set viewdata($curview) \
1458 [list $phase $rowidlist $rowoffsets $rowrangelist \
1459 [flatten idrowranges] [flatten idinlist] \
1460 $rowlaidout $rowoptim $numcommits $linesegends]
1461 } elseif {![info exists viewdata($curview)]
1462 || [lindex $viewdata($curview) 0] ne {}} {
1463 set viewdata($curview) \
1464 [list {} $rowidlist $rowoffsets $rowrangelist]
1467 catch {unset matchinglines}
1468 catch {unset treediffs}
1469 clear_display
1471 set curview $n
1472 set selectedview $n
1473 set selectedhlview -1
1474 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1475 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1476 catch {unset hlview}
1477 .bar.view.hl entryconf 1 -state disabled
1479 if {![info exists viewdata($n)]} {
1480 set pending_select $selid
1481 getcommits
1482 return
1485 set v $viewdata($n)
1486 set phase [lindex $v 0]
1487 set displayorder $vdisporder($n)
1488 set parentlist $vparentlist($n)
1489 set childlist $vchildlist($n)
1490 set commitlisted $vcmitlisted($n)
1491 set rowidlist [lindex $v 1]
1492 set rowoffsets [lindex $v 2]
1493 set rowrangelist [lindex $v 3]
1494 if {$phase eq {}} {
1495 set numcommits [llength $displayorder]
1496 catch {unset idrowranges}
1497 } else {
1498 unflatten idrowranges [lindex $v 4]
1499 unflatten idinlist [lindex $v 5]
1500 set rowlaidout [lindex $v 6]
1501 set rowoptim [lindex $v 7]
1502 set numcommits [lindex $v 8]
1503 set linesegends [lindex $v 9]
1506 catch {unset colormap}
1507 catch {unset rowtextx}
1508 set nextcolor 0
1509 set canvxmax [$canv cget -width]
1510 set curview $n
1511 set row 0
1512 setcanvscroll
1513 set yf 0
1514 set row 0
1515 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1516 set row $commitrow($n,$selid)
1517 # try to get the selected row in the same position on the screen
1518 set ymax [lindex [$canv cget -scrollregion] 3]
1519 set ytop [expr {[yc $row] - $yscreen}]
1520 if {$ytop < 0} {
1521 set ytop 0
1523 set yf [expr {$ytop * 1.0 / $ymax}]
1525 allcanvs yview moveto $yf
1526 drawvisible
1527 selectline $row 0
1528 if {$phase ne {}} {
1529 if {$phase eq "getcommits"} {
1530 show_status "Reading commits..."
1532 if {[info exists commfd($n)]} {
1533 layoutmore
1534 } else {
1535 finishcommits
1537 } elseif {$numcommits == 0} {
1538 show_status "No commits selected"
1542 proc addhighlight {n} {
1543 global hlview curview viewdata highlighted highlightedrows
1544 global selectedhlview
1546 if {[info exists hlview]} {
1547 delhighlight
1549 set hlview $n
1550 set selectedhlview $n
1551 .bar.view.hl entryconf 1 -state normal
1552 set highlighted($n) 0
1553 set highlightedrows {}
1554 if {$n != $curview && ![info exists viewdata($n)]} {
1555 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1556 set vparentlist($n) {}
1557 set vchildlist($n) {}
1558 set vdisporder($n) {}
1559 set vcmitlisted($n) {}
1560 start_rev_list $n
1561 } else {
1562 highlightmore
1566 proc delhighlight {} {
1567 global hlview highlightedrows canv linehtag mainfont
1568 global selectedhlview selectedline
1570 if {![info exists hlview]} return
1571 unset hlview
1572 set selectedhlview {}
1573 .bar.view.hl entryconf 1 -state disabled
1574 foreach l $highlightedrows {
1575 $canv itemconf $linehtag($l) -font $mainfont
1576 if {$l == $selectedline} {
1577 $canv delete secsel
1578 set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1579 -outline {{}} -tags secsel \
1580 -fill [$canv cget -selectbackground]]
1581 $canv lower $t
1586 proc highlightmore {} {
1587 global hlview highlighted commitidx highlightedrows linehtag mainfont
1588 global displayorder vdisporder curview canv commitrow selectedline
1590 set font [concat $mainfont bold]
1591 set max $commitidx($hlview)
1592 if {$hlview == $curview} {
1593 set disp $displayorder
1594 } else {
1595 set disp $vdisporder($hlview)
1597 for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1598 set id [lindex $disp $i]
1599 if {[info exists commitrow($curview,$id)]} {
1600 set row $commitrow($curview,$id)
1601 if {[info exists linehtag($row)]} {
1602 $canv itemconf $linehtag($row) -font $font
1603 lappend highlightedrows $row
1604 if {$row == $selectedline} {
1605 $canv delete secsel
1606 set t [eval $canv create rect \
1607 [$canv bbox $linehtag($row)] \
1608 -outline {{}} -tags secsel \
1609 -fill [$canv cget -selectbackground]]
1610 $canv lower $t
1615 set highlighted($hlview) $max
1618 # Graph layout functions
1620 proc shortids {ids} {
1621 set res {}
1622 foreach id $ids {
1623 if {[llength $id] > 1} {
1624 lappend res [shortids $id]
1625 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1626 lappend res [string range $id 0 7]
1627 } else {
1628 lappend res $id
1631 return $res
1634 proc incrange {l x o} {
1635 set n [llength $l]
1636 while {$x < $n} {
1637 set e [lindex $l $x]
1638 if {$e ne {}} {
1639 lset l $x [expr {$e + $o}]
1641 incr x
1643 return $l
1646 proc ntimes {n o} {
1647 set ret {}
1648 for {} {$n > 0} {incr n -1} {
1649 lappend ret $o
1651 return $ret
1654 proc usedinrange {id l1 l2} {
1655 global children commitrow childlist curview
1657 if {[info exists commitrow($curview,$id)]} {
1658 set r $commitrow($curview,$id)
1659 if {$l1 <= $r && $r <= $l2} {
1660 return [expr {$r - $l1 + 1}]
1662 set kids [lindex $childlist $r]
1663 } else {
1664 set kids $children($curview,$id)
1666 foreach c $kids {
1667 set r $commitrow($curview,$c)
1668 if {$l1 <= $r && $r <= $l2} {
1669 return [expr {$r - $l1 + 1}]
1672 return 0
1675 proc sanity {row {full 0}} {
1676 global rowidlist rowoffsets
1678 set col -1
1679 set ids [lindex $rowidlist $row]
1680 foreach id $ids {
1681 incr col
1682 if {$id eq {}} continue
1683 if {$col < [llength $ids] - 1 &&
1684 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1685 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1687 set o [lindex $rowoffsets $row $col]
1688 set y $row
1689 set x $col
1690 while {$o ne {}} {
1691 incr y -1
1692 incr x $o
1693 if {[lindex $rowidlist $y $x] != $id} {
1694 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1695 puts " id=[shortids $id] check started at row $row"
1696 for {set i $row} {$i >= $y} {incr i -1} {
1697 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1699 break
1701 if {!$full} break
1702 set o [lindex $rowoffsets $y $x]
1707 proc makeuparrow {oid x y z} {
1708 global rowidlist rowoffsets uparrowlen idrowranges
1710 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1711 incr y -1
1712 incr x $z
1713 set off0 [lindex $rowoffsets $y]
1714 for {set x0 $x} {1} {incr x0} {
1715 if {$x0 >= [llength $off0]} {
1716 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1717 break
1719 set z [lindex $off0 $x0]
1720 if {$z ne {}} {
1721 incr x0 $z
1722 break
1725 set z [expr {$x0 - $x}]
1726 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1727 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1729 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1730 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1731 lappend idrowranges($oid) $y
1734 proc initlayout {} {
1735 global rowidlist rowoffsets displayorder commitlisted
1736 global rowlaidout rowoptim
1737 global idinlist rowchk rowrangelist idrowranges
1738 global numcommits canvxmax canv
1739 global nextcolor
1740 global parentlist childlist children
1741 global colormap rowtextx
1742 global linesegends
1744 set numcommits 0
1745 set displayorder {}
1746 set commitlisted {}
1747 set parentlist {}
1748 set childlist {}
1749 set rowrangelist {}
1750 set nextcolor 0
1751 set rowidlist {{}}
1752 set rowoffsets {{}}
1753 catch {unset idinlist}
1754 catch {unset rowchk}
1755 set rowlaidout 0
1756 set rowoptim 0
1757 set canvxmax [$canv cget -width]
1758 catch {unset colormap}
1759 catch {unset rowtextx}
1760 catch {unset idrowranges}
1761 set linesegends {}
1764 proc setcanvscroll {} {
1765 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1767 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1768 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1769 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1770 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1773 proc visiblerows {} {
1774 global canv numcommits linespc
1776 set ymax [lindex [$canv cget -scrollregion] 3]
1777 if {$ymax eq {} || $ymax == 0} return
1778 set f [$canv yview]
1779 set y0 [expr {int([lindex $f 0] * $ymax)}]
1780 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1781 if {$r0 < 0} {
1782 set r0 0
1784 set y1 [expr {int([lindex $f 1] * $ymax)}]
1785 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1786 if {$r1 >= $numcommits} {
1787 set r1 [expr {$numcommits - 1}]
1789 return [list $r0 $r1]
1792 proc layoutmore {} {
1793 global rowlaidout rowoptim commitidx numcommits optim_delay
1794 global uparrowlen curview
1796 set row $rowlaidout
1797 set rowlaidout [layoutrows $row $commitidx($curview) 0]
1798 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1799 if {$orow > $rowoptim} {
1800 optimize_rows $rowoptim 0 $orow
1801 set rowoptim $orow
1803 set canshow [expr {$rowoptim - $optim_delay}]
1804 if {$canshow > $numcommits} {
1805 showstuff $canshow
1809 proc showstuff {canshow} {
1810 global numcommits commitrow pending_select selectedline
1811 global linesegends idrowranges idrangedrawn curview
1813 if {$numcommits == 0} {
1814 global phase
1815 set phase "incrdraw"
1816 allcanvs delete all
1818 set row $numcommits
1819 set numcommits $canshow
1820 setcanvscroll
1821 set rows [visiblerows]
1822 set r0 [lindex $rows 0]
1823 set r1 [lindex $rows 1]
1824 set selrow -1
1825 for {set r $row} {$r < $canshow} {incr r} {
1826 foreach id [lindex $linesegends [expr {$r+1}]] {
1827 set i -1
1828 foreach {s e} [rowranges $id] {
1829 incr i
1830 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1831 && ![info exists idrangedrawn($id,$i)]} {
1832 drawlineseg $id $i
1833 set idrangedrawn($id,$i) 1
1838 if {$canshow > $r1} {
1839 set canshow $r1
1841 while {$row < $canshow} {
1842 drawcmitrow $row
1843 incr row
1845 if {[info exists pending_select] &&
1846 [info exists commitrow($curview,$pending_select)] &&
1847 $commitrow($curview,$pending_select) < $numcommits} {
1848 selectline $commitrow($curview,$pending_select) 1
1850 if {![info exists selectedline] && ![info exists pending_select]} {
1851 selectline 0 1
1855 proc layoutrows {row endrow last} {
1856 global rowidlist rowoffsets displayorder
1857 global uparrowlen downarrowlen maxwidth mingaplen
1858 global childlist parentlist
1859 global idrowranges linesegends
1860 global commitidx curview
1861 global idinlist rowchk rowrangelist
1863 set idlist [lindex $rowidlist $row]
1864 set offs [lindex $rowoffsets $row]
1865 while {$row < $endrow} {
1866 set id [lindex $displayorder $row]
1867 set oldolds {}
1868 set newolds {}
1869 foreach p [lindex $parentlist $row] {
1870 if {![info exists idinlist($p)]} {
1871 lappend newolds $p
1872 } elseif {!$idinlist($p)} {
1873 lappend oldolds $p
1876 set lse {}
1877 set nev [expr {[llength $idlist] + [llength $newolds]
1878 + [llength $oldolds] - $maxwidth + 1}]
1879 if {$nev > 0} {
1880 if {!$last &&
1881 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1882 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1883 set i [lindex $idlist $x]
1884 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1885 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1886 [expr {$row + $uparrowlen + $mingaplen}]]
1887 if {$r == 0} {
1888 set idlist [lreplace $idlist $x $x]
1889 set offs [lreplace $offs $x $x]
1890 set offs [incrange $offs $x 1]
1891 set idinlist($i) 0
1892 set rm1 [expr {$row - 1}]
1893 lappend lse $i
1894 lappend idrowranges($i) $rm1
1895 if {[incr nev -1] <= 0} break
1896 continue
1898 set rowchk($id) [expr {$row + $r}]
1901 lset rowidlist $row $idlist
1902 lset rowoffsets $row $offs
1904 lappend linesegends $lse
1905 set col [lsearch -exact $idlist $id]
1906 if {$col < 0} {
1907 set col [llength $idlist]
1908 lappend idlist $id
1909 lset rowidlist $row $idlist
1910 set z {}
1911 if {[lindex $childlist $row] ne {}} {
1912 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1913 unset idinlist($id)
1915 lappend offs $z
1916 lset rowoffsets $row $offs
1917 if {$z ne {}} {
1918 makeuparrow $id $col $row $z
1920 } else {
1921 unset idinlist($id)
1923 set ranges {}
1924 if {[info exists idrowranges($id)]} {
1925 set ranges $idrowranges($id)
1926 lappend ranges $row
1927 unset idrowranges($id)
1929 lappend rowrangelist $ranges
1930 incr row
1931 set offs [ntimes [llength $idlist] 0]
1932 set l [llength $newolds]
1933 set idlist [eval lreplace \$idlist $col $col $newolds]
1934 set o 0
1935 if {$l != 1} {
1936 set offs [lrange $offs 0 [expr {$col - 1}]]
1937 foreach x $newolds {
1938 lappend offs {}
1939 incr o -1
1941 incr o
1942 set tmp [expr {[llength $idlist] - [llength $offs]}]
1943 if {$tmp > 0} {
1944 set offs [concat $offs [ntimes $tmp $o]]
1946 } else {
1947 lset offs $col {}
1949 foreach i $newolds {
1950 set idinlist($i) 1
1951 set idrowranges($i) $row
1953 incr col $l
1954 foreach oid $oldolds {
1955 set idinlist($oid) 1
1956 set idlist [linsert $idlist $col $oid]
1957 set offs [linsert $offs $col $o]
1958 makeuparrow $oid $col $row $o
1959 incr col
1961 lappend rowidlist $idlist
1962 lappend rowoffsets $offs
1964 return $row
1967 proc addextraid {id row} {
1968 global displayorder commitrow commitinfo
1969 global commitidx commitlisted
1970 global parentlist childlist children curview
1972 incr commitidx($curview)
1973 lappend displayorder $id
1974 lappend commitlisted 0
1975 lappend parentlist {}
1976 set commitrow($curview,$id) $row
1977 readcommit $id
1978 if {![info exists commitinfo($id)]} {
1979 set commitinfo($id) {"No commit information available"}
1981 if {![info exists children($curview,$id)]} {
1982 set children($curview,$id) {}
1984 lappend childlist $children($curview,$id)
1987 proc layouttail {} {
1988 global rowidlist rowoffsets idinlist commitidx curview
1989 global idrowranges rowrangelist
1991 set row $commitidx($curview)
1992 set idlist [lindex $rowidlist $row]
1993 while {$idlist ne {}} {
1994 set col [expr {[llength $idlist] - 1}]
1995 set id [lindex $idlist $col]
1996 addextraid $id $row
1997 unset idinlist($id)
1998 lappend idrowranges($id) $row
1999 lappend rowrangelist $idrowranges($id)
2000 unset idrowranges($id)
2001 incr row
2002 set offs [ntimes $col 0]
2003 set idlist [lreplace $idlist $col $col]
2004 lappend rowidlist $idlist
2005 lappend rowoffsets $offs
2008 foreach id [array names idinlist] {
2009 addextraid $id $row
2010 lset rowidlist $row [list $id]
2011 lset rowoffsets $row 0
2012 makeuparrow $id 0 $row 0
2013 lappend idrowranges($id) $row
2014 lappend rowrangelist $idrowranges($id)
2015 unset idrowranges($id)
2016 incr row
2017 lappend rowidlist {}
2018 lappend rowoffsets {}
2022 proc insert_pad {row col npad} {
2023 global rowidlist rowoffsets
2025 set pad [ntimes $npad {}]
2026 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2027 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2028 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2031 proc optimize_rows {row col endrow} {
2032 global rowidlist rowoffsets idrowranges displayorder
2034 for {} {$row < $endrow} {incr row} {
2035 set idlist [lindex $rowidlist $row]
2036 set offs [lindex $rowoffsets $row]
2037 set haspad 0
2038 for {} {$col < [llength $offs]} {incr col} {
2039 if {[lindex $idlist $col] eq {}} {
2040 set haspad 1
2041 continue
2043 set z [lindex $offs $col]
2044 if {$z eq {}} continue
2045 set isarrow 0
2046 set x0 [expr {$col + $z}]
2047 set y0 [expr {$row - 1}]
2048 set z0 [lindex $rowoffsets $y0 $x0]
2049 if {$z0 eq {}} {
2050 set id [lindex $idlist $col]
2051 set ranges [rowranges $id]
2052 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2053 set isarrow 1
2056 if {$z < -1 || ($z < 0 && $isarrow)} {
2057 set npad [expr {-1 - $z + $isarrow}]
2058 set offs [incrange $offs $col $npad]
2059 insert_pad $y0 $x0 $npad
2060 if {$y0 > 0} {
2061 optimize_rows $y0 $x0 $row
2063 set z [lindex $offs $col]
2064 set x0 [expr {$col + $z}]
2065 set z0 [lindex $rowoffsets $y0 $x0]
2066 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2067 set npad [expr {$z - 1 + $isarrow}]
2068 set y1 [expr {$row + 1}]
2069 set offs2 [lindex $rowoffsets $y1]
2070 set x1 -1
2071 foreach z $offs2 {
2072 incr x1
2073 if {$z eq {} || $x1 + $z < $col} continue
2074 if {$x1 + $z > $col} {
2075 incr npad
2077 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2078 break
2080 set pad [ntimes $npad {}]
2081 set idlist [eval linsert \$idlist $col $pad]
2082 set tmp [eval linsert \$offs $col $pad]
2083 incr col $npad
2084 set offs [incrange $tmp $col [expr {-$npad}]]
2085 set z [lindex $offs $col]
2086 set haspad 1
2088 if {$z0 eq {} && !$isarrow} {
2089 # this line links to its first child on row $row-2
2090 set rm2 [expr {$row - 2}]
2091 set id [lindex $displayorder $rm2]
2092 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2093 if {$xc >= 0} {
2094 set z0 [expr {$xc - $x0}]
2097 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2098 insert_pad $y0 $x0 1
2099 set offs [incrange $offs $col 1]
2100 optimize_rows $y0 [expr {$x0 + 1}] $row
2103 if {!$haspad} {
2104 set o {}
2105 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2106 set o [lindex $offs $col]
2107 if {$o eq {}} {
2108 # check if this is the link to the first child
2109 set id [lindex $idlist $col]
2110 set ranges [rowranges $id]
2111 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2112 # it is, work out offset to child
2113 set y0 [expr {$row - 1}]
2114 set id [lindex $displayorder $y0]
2115 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2116 if {$x0 >= 0} {
2117 set o [expr {$x0 - $col}]
2121 if {$o eq {} || $o <= 0} break
2123 if {$o ne {} && [incr col] < [llength $idlist]} {
2124 set y1 [expr {$row + 1}]
2125 set offs2 [lindex $rowoffsets $y1]
2126 set x1 -1
2127 foreach z $offs2 {
2128 incr x1
2129 if {$z eq {} || $x1 + $z < $col} continue
2130 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2131 break
2133 set idlist [linsert $idlist $col {}]
2134 set tmp [linsert $offs $col {}]
2135 incr col
2136 set offs [incrange $tmp $col -1]
2139 lset rowidlist $row $idlist
2140 lset rowoffsets $row $offs
2141 set col 0
2145 proc xc {row col} {
2146 global canvx0 linespc
2147 return [expr {$canvx0 + $col * $linespc}]
2150 proc yc {row} {
2151 global canvy0 linespc
2152 return [expr {$canvy0 + $row * $linespc}]
2155 proc linewidth {id} {
2156 global thickerline lthickness
2158 set wid $lthickness
2159 if {[info exists thickerline] && $id eq $thickerline} {
2160 set wid [expr {2 * $lthickness}]
2162 return $wid
2165 proc rowranges {id} {
2166 global phase idrowranges commitrow rowlaidout rowrangelist curview
2168 set ranges {}
2169 if {$phase eq {} ||
2170 ([info exists commitrow($curview,$id)]
2171 && $commitrow($curview,$id) < $rowlaidout)} {
2172 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2173 } elseif {[info exists idrowranges($id)]} {
2174 set ranges $idrowranges($id)
2176 return $ranges
2179 proc drawlineseg {id i} {
2180 global rowoffsets rowidlist
2181 global displayorder
2182 global canv colormap linespc
2183 global numcommits commitrow curview
2185 set ranges [rowranges $id]
2186 set downarrow 1
2187 if {[info exists commitrow($curview,$id)]
2188 && $commitrow($curview,$id) < $numcommits} {
2189 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2190 } else {
2191 set downarrow 1
2193 set startrow [lindex $ranges [expr {2 * $i}]]
2194 set row [lindex $ranges [expr {2 * $i + 1}]]
2195 if {$startrow == $row} return
2196 assigncolor $id
2197 set coords {}
2198 set col [lsearch -exact [lindex $rowidlist $row] $id]
2199 if {$col < 0} {
2200 puts "oops: drawline: id $id not on row $row"
2201 return
2203 set lasto {}
2204 set ns 0
2205 while {1} {
2206 set o [lindex $rowoffsets $row $col]
2207 if {$o eq {}} break
2208 if {$o ne $lasto} {
2209 # changing direction
2210 set x [xc $row $col]
2211 set y [yc $row]
2212 lappend coords $x $y
2213 set lasto $o
2215 incr col $o
2216 incr row -1
2218 set x [xc $row $col]
2219 set y [yc $row]
2220 lappend coords $x $y
2221 if {$i == 0} {
2222 # draw the link to the first child as part of this line
2223 incr row -1
2224 set child [lindex $displayorder $row]
2225 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2226 if {$ccol >= 0} {
2227 set x [xc $row $ccol]
2228 set y [yc $row]
2229 if {$ccol < $col - 1} {
2230 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2231 } elseif {$ccol > $col + 1} {
2232 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2234 lappend coords $x $y
2237 if {[llength $coords] < 4} return
2238 if {$downarrow} {
2239 # This line has an arrow at the lower end: check if the arrow is
2240 # on a diagonal segment, and if so, work around the Tk 8.4
2241 # refusal to draw arrows on diagonal lines.
2242 set x0 [lindex $coords 0]
2243 set x1 [lindex $coords 2]
2244 if {$x0 != $x1} {
2245 set y0 [lindex $coords 1]
2246 set y1 [lindex $coords 3]
2247 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2248 # we have a nearby vertical segment, just trim off the diag bit
2249 set coords [lrange $coords 2 end]
2250 } else {
2251 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2252 set xi [expr {$x0 - $slope * $linespc / 2}]
2253 set yi [expr {$y0 - $linespc / 2}]
2254 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2258 set arrow [expr {2 * ($i > 0) + $downarrow}]
2259 set arrow [lindex {none first last both} $arrow]
2260 set t [$canv create line $coords -width [linewidth $id] \
2261 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2262 $canv lower $t
2263 bindline $t $id
2266 proc drawparentlinks {id row col olds} {
2267 global rowidlist canv colormap
2269 set row2 [expr {$row + 1}]
2270 set x [xc $row $col]
2271 set y [yc $row]
2272 set y2 [yc $row2]
2273 set ids [lindex $rowidlist $row2]
2274 # rmx = right-most X coord used
2275 set rmx 0
2276 foreach p $olds {
2277 set i [lsearch -exact $ids $p]
2278 if {$i < 0} {
2279 puts "oops, parent $p of $id not in list"
2280 continue
2282 set x2 [xc $row2 $i]
2283 if {$x2 > $rmx} {
2284 set rmx $x2
2286 set ranges [rowranges $p]
2287 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2288 && $row2 < [lindex $ranges 1]} {
2289 # drawlineseg will do this one for us
2290 continue
2292 assigncolor $p
2293 # should handle duplicated parents here...
2294 set coords [list $x $y]
2295 if {$i < $col - 1} {
2296 lappend coords [xc $row [expr {$i + 1}]] $y
2297 } elseif {$i > $col + 1} {
2298 lappend coords [xc $row [expr {$i - 1}]] $y
2300 lappend coords $x2 $y2
2301 set t [$canv create line $coords -width [linewidth $p] \
2302 -fill $colormap($p) -tags lines.$p]
2303 $canv lower $t
2304 bindline $t $p
2306 return $rmx
2309 proc drawlines {id} {
2310 global colormap canv
2311 global idrangedrawn
2312 global children iddrawn commitrow rowidlist curview
2314 $canv delete lines.$id
2315 set nr [expr {[llength [rowranges $id]] / 2}]
2316 for {set i 0} {$i < $nr} {incr i} {
2317 if {[info exists idrangedrawn($id,$i)]} {
2318 drawlineseg $id $i
2321 foreach child $children($curview,$id) {
2322 if {[info exists iddrawn($child)]} {
2323 set row $commitrow($curview,$child)
2324 set col [lsearch -exact [lindex $rowidlist $row] $child]
2325 if {$col >= 0} {
2326 drawparentlinks $child $row $col [list $id]
2332 proc drawcmittext {id row col rmx} {
2333 global linespc canv canv2 canv3 canvy0
2334 global commitlisted commitinfo rowidlist
2335 global rowtextx idpos idtags idheads idotherrefs
2336 global linehtag linentag linedtag
2337 global mainfont canvxmax
2338 global hlview commitrow highlightedrows
2340 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2341 set x [xc $row $col]
2342 set y [yc $row]
2343 set orad [expr {$linespc / 3}]
2344 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2345 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2346 -fill $ofill -outline black -width 1]
2347 $canv raise $t
2348 $canv bind $t <1> {selcanvline {} %x %y}
2349 set xt [xc $row [llength [lindex $rowidlist $row]]]
2350 if {$xt < $rmx} {
2351 set xt $rmx
2353 set rowtextx($row) $xt
2354 set idpos($id) [list $x $xt $y]
2355 if {[info exists idtags($id)] || [info exists idheads($id)]
2356 || [info exists idotherrefs($id)]} {
2357 set xt [drawtags $id $x $xt $y]
2359 set headline [lindex $commitinfo($id) 0]
2360 set name [lindex $commitinfo($id) 1]
2361 set date [lindex $commitinfo($id) 2]
2362 set date [formatdate $date]
2363 set font $mainfont
2364 if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2365 lappend font bold
2366 lappend highlightedrows $row
2368 set linehtag($row) [$canv create text $xt $y -anchor w \
2369 -text $headline -font $font]
2370 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2371 set linentag($row) [$canv2 create text 3 $y -anchor w \
2372 -text $name -font $mainfont]
2373 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2374 -text $date -font $mainfont]
2375 set xr [expr {$xt + [font measure $mainfont $headline]}]
2376 if {$xr > $canvxmax} {
2377 set canvxmax $xr
2378 setcanvscroll
2382 proc drawcmitrow {row} {
2383 global displayorder rowidlist
2384 global idrangedrawn iddrawn
2385 global commitinfo parentlist numcommits
2387 if {$row >= $numcommits} return
2388 foreach id [lindex $rowidlist $row] {
2389 if {$id eq {}} continue
2390 set i -1
2391 foreach {s e} [rowranges $id] {
2392 incr i
2393 if {$row < $s} continue
2394 if {$e eq {}} break
2395 if {$row <= $e} {
2396 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2397 drawlineseg $id $i
2398 set idrangedrawn($id,$i) 1
2400 break
2405 set id [lindex $displayorder $row]
2406 if {[info exists iddrawn($id)]} return
2407 set col [lsearch -exact [lindex $rowidlist $row] $id]
2408 if {$col < 0} {
2409 puts "oops, row $row id $id not in list"
2410 return
2412 if {![info exists commitinfo($id)]} {
2413 getcommit $id
2415 assigncolor $id
2416 set olds [lindex $parentlist $row]
2417 if {$olds ne {}} {
2418 set rmx [drawparentlinks $id $row $col $olds]
2419 } else {
2420 set rmx 0
2422 drawcmittext $id $row $col $rmx
2423 set iddrawn($id) 1
2426 proc drawfrac {f0 f1} {
2427 global numcommits canv
2428 global linespc
2430 set ymax [lindex [$canv cget -scrollregion] 3]
2431 if {$ymax eq {} || $ymax == 0} return
2432 set y0 [expr {int($f0 * $ymax)}]
2433 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2434 if {$row < 0} {
2435 set row 0
2437 set y1 [expr {int($f1 * $ymax)}]
2438 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2439 if {$endrow >= $numcommits} {
2440 set endrow [expr {$numcommits - 1}]
2442 for {} {$row <= $endrow} {incr row} {
2443 drawcmitrow $row
2447 proc drawvisible {} {
2448 global canv
2449 eval drawfrac [$canv yview]
2452 proc clear_display {} {
2453 global iddrawn idrangedrawn
2455 allcanvs delete all
2456 catch {unset iddrawn}
2457 catch {unset idrangedrawn}
2460 proc findcrossings {id} {
2461 global rowidlist parentlist numcommits rowoffsets displayorder
2463 set cross {}
2464 set ccross {}
2465 foreach {s e} [rowranges $id] {
2466 if {$e >= $numcommits} {
2467 set e [expr {$numcommits - 1}]
2469 if {$e <= $s} continue
2470 set x [lsearch -exact [lindex $rowidlist $e] $id]
2471 if {$x < 0} {
2472 puts "findcrossings: oops, no [shortids $id] in row $e"
2473 continue
2475 for {set row $e} {[incr row -1] >= $s} {} {
2476 set olds [lindex $parentlist $row]
2477 set kid [lindex $displayorder $row]
2478 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2479 if {$kidx < 0} continue
2480 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2481 foreach p $olds {
2482 set px [lsearch -exact $nextrow $p]
2483 if {$px < 0} continue
2484 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2485 if {[lsearch -exact $ccross $p] >= 0} continue
2486 if {$x == $px + ($kidx < $px? -1: 1)} {
2487 lappend ccross $p
2488 } elseif {[lsearch -exact $cross $p] < 0} {
2489 lappend cross $p
2493 set inc [lindex $rowoffsets $row $x]
2494 if {$inc eq {}} break
2495 incr x $inc
2498 return [concat $ccross {{}} $cross]
2501 proc assigncolor {id} {
2502 global colormap colors nextcolor
2503 global commitrow parentlist children children curview
2505 if {[info exists colormap($id)]} return
2506 set ncolors [llength $colors]
2507 if {[info exists children($curview,$id)]} {
2508 set kids $children($curview,$id)
2509 } else {
2510 set kids {}
2512 if {[llength $kids] == 1} {
2513 set child [lindex $kids 0]
2514 if {[info exists colormap($child)]
2515 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2516 set colormap($id) $colormap($child)
2517 return
2520 set badcolors {}
2521 set origbad {}
2522 foreach x [findcrossings $id] {
2523 if {$x eq {}} {
2524 # delimiter between corner crossings and other crossings
2525 if {[llength $badcolors] >= $ncolors - 1} break
2526 set origbad $badcolors
2528 if {[info exists colormap($x)]
2529 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2530 lappend badcolors $colormap($x)
2533 if {[llength $badcolors] >= $ncolors} {
2534 set badcolors $origbad
2536 set origbad $badcolors
2537 if {[llength $badcolors] < $ncolors - 1} {
2538 foreach child $kids {
2539 if {[info exists colormap($child)]
2540 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2541 lappend badcolors $colormap($child)
2543 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2544 if {[info exists colormap($p)]
2545 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2546 lappend badcolors $colormap($p)
2550 if {[llength $badcolors] >= $ncolors} {
2551 set badcolors $origbad
2554 for {set i 0} {$i <= $ncolors} {incr i} {
2555 set c [lindex $colors $nextcolor]
2556 if {[incr nextcolor] >= $ncolors} {
2557 set nextcolor 0
2559 if {[lsearch -exact $badcolors $c]} break
2561 set colormap($id) $c
2564 proc bindline {t id} {
2565 global canv
2567 $canv bind $t <Enter> "lineenter %x %y $id"
2568 $canv bind $t <Motion> "linemotion %x %y $id"
2569 $canv bind $t <Leave> "lineleave $id"
2570 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2573 proc drawtags {id x xt y1} {
2574 global idtags idheads idotherrefs
2575 global linespc lthickness
2576 global canv mainfont commitrow rowtextx curview
2578 set marks {}
2579 set ntags 0
2580 set nheads 0
2581 if {[info exists idtags($id)]} {
2582 set marks $idtags($id)
2583 set ntags [llength $marks]
2585 if {[info exists idheads($id)]} {
2586 set marks [concat $marks $idheads($id)]
2587 set nheads [llength $idheads($id)]
2589 if {[info exists idotherrefs($id)]} {
2590 set marks [concat $marks $idotherrefs($id)]
2592 if {$marks eq {}} {
2593 return $xt
2596 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2597 set yt [expr {$y1 - 0.5 * $linespc}]
2598 set yb [expr {$yt + $linespc - 1}]
2599 set xvals {}
2600 set wvals {}
2601 foreach tag $marks {
2602 set wid [font measure $mainfont $tag]
2603 lappend xvals $xt
2604 lappend wvals $wid
2605 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2607 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2608 -width $lthickness -fill black -tags tag.$id]
2609 $canv lower $t
2610 foreach tag $marks x $xvals wid $wvals {
2611 set xl [expr {$x + $delta}]
2612 set xr [expr {$x + $delta + $wid + $lthickness}]
2613 if {[incr ntags -1] >= 0} {
2614 # draw a tag
2615 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2616 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2617 -width 1 -outline black -fill yellow -tags tag.$id]
2618 $canv bind $t <1> [list showtag $tag 1]
2619 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2620 } else {
2621 # draw a head or other ref
2622 if {[incr nheads -1] >= 0} {
2623 set col green
2624 } else {
2625 set col "#ddddff"
2627 set xl [expr {$xl - $delta/2}]
2628 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2629 -width 1 -outline black -fill $col -tags tag.$id
2630 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2631 set rwid [font measure $mainfont $remoteprefix]
2632 set xi [expr {$x + 1}]
2633 set yti [expr {$yt + 1}]
2634 set xri [expr {$x + $rwid}]
2635 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2636 -width 0 -fill "#ffddaa" -tags tag.$id
2639 set t [$canv create text $xl $y1 -anchor w -text $tag \
2640 -font $mainfont -tags tag.$id]
2641 if {$ntags >= 0} {
2642 $canv bind $t <1> [list showtag $tag 1]
2645 return $xt
2648 proc xcoord {i level ln} {
2649 global canvx0 xspc1 xspc2
2651 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2652 if {$i > 0 && $i == $level} {
2653 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2654 } elseif {$i > $level} {
2655 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2657 return $x
2660 proc show_status {msg} {
2661 global canv mainfont
2663 clear_display
2664 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2667 proc finishcommits {} {
2668 global commitidx phase curview
2669 global canv mainfont ctext maincursor textcursor
2670 global findinprogress pending_select
2672 if {$commitidx($curview) > 0} {
2673 drawrest
2674 } else {
2675 show_status "No commits selected"
2677 set phase {}
2678 catch {unset pending_select}
2681 # Don't change the text pane cursor if it is currently the hand cursor,
2682 # showing that we are over a sha1 ID link.
2683 proc settextcursor {c} {
2684 global ctext curtextcursor
2686 if {[$ctext cget -cursor] == $curtextcursor} {
2687 $ctext config -cursor $c
2689 set curtextcursor $c
2692 proc nowbusy {what} {
2693 global isbusy
2695 if {[array names isbusy] eq {}} {
2696 . config -cursor watch
2697 settextcursor watch
2699 set isbusy($what) 1
2702 proc notbusy {what} {
2703 global isbusy maincursor textcursor
2705 catch {unset isbusy($what)}
2706 if {[array names isbusy] eq {}} {
2707 . config -cursor $maincursor
2708 settextcursor $textcursor
2712 proc drawrest {} {
2713 global numcommits
2714 global startmsecs
2715 global canvy0 numcommits linespc
2716 global rowlaidout commitidx curview
2717 global pending_select
2719 set row $rowlaidout
2720 layoutrows $rowlaidout $commitidx($curview) 1
2721 layouttail
2722 optimize_rows $row 0 $commitidx($curview)
2723 showstuff $commitidx($curview)
2724 if {[info exists pending_select]} {
2725 selectline 0 1
2728 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2729 #puts "overall $drawmsecs ms for $numcommits commits"
2732 proc findmatches {f} {
2733 global findtype foundstring foundstrlen
2734 if {$findtype == "Regexp"} {
2735 set matches [regexp -indices -all -inline $foundstring $f]
2736 } else {
2737 if {$findtype == "IgnCase"} {
2738 set str [string tolower $f]
2739 } else {
2740 set str $f
2742 set matches {}
2743 set i 0
2744 while {[set j [string first $foundstring $str $i]] >= 0} {
2745 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2746 set i [expr {$j + $foundstrlen}]
2749 return $matches
2752 proc dofind {} {
2753 global findtype findloc findstring markedmatches commitinfo
2754 global numcommits displayorder linehtag linentag linedtag
2755 global mainfont canv canv2 canv3 selectedline
2756 global matchinglines foundstring foundstrlen matchstring
2757 global commitdata
2759 stopfindproc
2760 unmarkmatches
2761 focus .
2762 set matchinglines {}
2763 if {$findloc == "Pickaxe"} {
2764 findpatches
2765 return
2767 if {$findtype == "IgnCase"} {
2768 set foundstring [string tolower $findstring]
2769 } else {
2770 set foundstring $findstring
2772 set foundstrlen [string length $findstring]
2773 if {$foundstrlen == 0} return
2774 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2775 set matchstring "*$matchstring*"
2776 if {$findloc == "Files"} {
2777 findfiles
2778 return
2780 if {![info exists selectedline]} {
2781 set oldsel -1
2782 } else {
2783 set oldsel $selectedline
2785 set didsel 0
2786 set fldtypes {Headline Author Date Committer CDate Comment}
2787 set l -1
2788 foreach id $displayorder {
2789 set d $commitdata($id)
2790 incr l
2791 if {$findtype == "Regexp"} {
2792 set doesmatch [regexp $foundstring $d]
2793 } elseif {$findtype == "IgnCase"} {
2794 set doesmatch [string match -nocase $matchstring $d]
2795 } else {
2796 set doesmatch [string match $matchstring $d]
2798 if {!$doesmatch} continue
2799 if {![info exists commitinfo($id)]} {
2800 getcommit $id
2802 set info $commitinfo($id)
2803 set doesmatch 0
2804 foreach f $info ty $fldtypes {
2805 if {$findloc != "All fields" && $findloc != $ty} {
2806 continue
2808 set matches [findmatches $f]
2809 if {$matches == {}} continue
2810 set doesmatch 1
2811 if {$ty == "Headline"} {
2812 drawcmitrow $l
2813 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2814 } elseif {$ty == "Author"} {
2815 drawcmitrow $l
2816 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2817 } elseif {$ty == "Date"} {
2818 drawcmitrow $l
2819 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2822 if {$doesmatch} {
2823 lappend matchinglines $l
2824 if {!$didsel && $l > $oldsel} {
2825 findselectline $l
2826 set didsel 1
2830 if {$matchinglines == {}} {
2831 bell
2832 } elseif {!$didsel} {
2833 findselectline [lindex $matchinglines 0]
2837 proc findselectline {l} {
2838 global findloc commentend ctext
2839 selectline $l 1
2840 if {$findloc == "All fields" || $findloc == "Comments"} {
2841 # highlight the matches in the comments
2842 set f [$ctext get 1.0 $commentend]
2843 set matches [findmatches $f]
2844 foreach match $matches {
2845 set start [lindex $match 0]
2846 set end [expr {[lindex $match 1] + 1}]
2847 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2852 proc findnext {restart} {
2853 global matchinglines selectedline
2854 if {![info exists matchinglines]} {
2855 if {$restart} {
2856 dofind
2858 return
2860 if {![info exists selectedline]} return
2861 foreach l $matchinglines {
2862 if {$l > $selectedline} {
2863 findselectline $l
2864 return
2867 bell
2870 proc findprev {} {
2871 global matchinglines selectedline
2872 if {![info exists matchinglines]} {
2873 dofind
2874 return
2876 if {![info exists selectedline]} return
2877 set prev {}
2878 foreach l $matchinglines {
2879 if {$l >= $selectedline} break
2880 set prev $l
2882 if {$prev != {}} {
2883 findselectline $prev
2884 } else {
2885 bell
2889 proc findlocchange {name ix op} {
2890 global findloc findtype findtypemenu
2891 if {$findloc == "Pickaxe"} {
2892 set findtype Exact
2893 set state disabled
2894 } else {
2895 set state normal
2897 $findtypemenu entryconf 1 -state $state
2898 $findtypemenu entryconf 2 -state $state
2901 proc stopfindproc {{done 0}} {
2902 global findprocpid findprocfile findids
2903 global ctext findoldcursor phase maincursor textcursor
2904 global findinprogress
2906 catch {unset findids}
2907 if {[info exists findprocpid]} {
2908 if {!$done} {
2909 catch {exec kill $findprocpid}
2911 catch {close $findprocfile}
2912 unset findprocpid
2914 catch {unset findinprogress}
2915 notbusy find
2918 proc findpatches {} {
2919 global findstring selectedline numcommits
2920 global findprocpid findprocfile
2921 global finddidsel ctext displayorder findinprogress
2922 global findinsertpos
2924 if {$numcommits == 0} return
2926 # make a list of all the ids to search, starting at the one
2927 # after the selected line (if any)
2928 if {[info exists selectedline]} {
2929 set l $selectedline
2930 } else {
2931 set l -1
2933 set inputids {}
2934 for {set i 0} {$i < $numcommits} {incr i} {
2935 if {[incr l] >= $numcommits} {
2936 set l 0
2938 append inputids [lindex $displayorder $l] "\n"
2941 if {[catch {
2942 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2943 << $inputids] r]
2944 } err]} {
2945 error_popup "Error starting search process: $err"
2946 return
2949 set findinsertpos end
2950 set findprocfile $f
2951 set findprocpid [pid $f]
2952 fconfigure $f -blocking 0
2953 fileevent $f readable readfindproc
2954 set finddidsel 0
2955 nowbusy find
2956 set findinprogress 1
2959 proc readfindproc {} {
2960 global findprocfile finddidsel
2961 global commitrow matchinglines findinsertpos curview
2963 set n [gets $findprocfile line]
2964 if {$n < 0} {
2965 if {[eof $findprocfile]} {
2966 stopfindproc 1
2967 if {!$finddidsel} {
2968 bell
2971 return
2973 if {![regexp {^[0-9a-f]{40}} $line id]} {
2974 error_popup "Can't parse git-diff-tree output: $line"
2975 stopfindproc
2976 return
2978 if {![info exists commitrow($curview,$id)]} {
2979 puts stderr "spurious id: $id"
2980 return
2982 set l $commitrow($curview,$id)
2983 insertmatch $l $id
2986 proc insertmatch {l id} {
2987 global matchinglines findinsertpos finddidsel
2989 if {$findinsertpos == "end"} {
2990 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2991 set matchinglines [linsert $matchinglines 0 $l]
2992 set findinsertpos 1
2993 } else {
2994 lappend matchinglines $l
2996 } else {
2997 set matchinglines [linsert $matchinglines $findinsertpos $l]
2998 incr findinsertpos
3000 markheadline $l $id
3001 if {!$finddidsel} {
3002 findselectline $l
3003 set finddidsel 1
3007 proc findfiles {} {
3008 global selectedline numcommits displayorder ctext
3009 global ffileline finddidsel parentlist
3010 global findinprogress findstartline findinsertpos
3011 global treediffs fdiffid fdiffsneeded fdiffpos
3012 global findmergefiles
3014 if {$numcommits == 0} return
3016 if {[info exists selectedline]} {
3017 set l [expr {$selectedline + 1}]
3018 } else {
3019 set l 0
3021 set ffileline $l
3022 set findstartline $l
3023 set diffsneeded {}
3024 set fdiffsneeded {}
3025 while 1 {
3026 set id [lindex $displayorder $l]
3027 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3028 if {![info exists treediffs($id)]} {
3029 append diffsneeded "$id\n"
3030 lappend fdiffsneeded $id
3033 if {[incr l] >= $numcommits} {
3034 set l 0
3036 if {$l == $findstartline} break
3039 # start off a git-diff-tree process if needed
3040 if {$diffsneeded ne {}} {
3041 if {[catch {
3042 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3043 } err ]} {
3044 error_popup "Error starting search process: $err"
3045 return
3047 catch {unset fdiffid}
3048 set fdiffpos 0
3049 fconfigure $df -blocking 0
3050 fileevent $df readable [list readfilediffs $df]
3053 set finddidsel 0
3054 set findinsertpos end
3055 set id [lindex $displayorder $l]
3056 nowbusy find
3057 set findinprogress 1
3058 findcont
3059 update
3062 proc readfilediffs {df} {
3063 global findid fdiffid fdiffs
3065 set n [gets $df line]
3066 if {$n < 0} {
3067 if {[eof $df]} {
3068 donefilediff
3069 if {[catch {close $df} err]} {
3070 stopfindproc
3071 bell
3072 error_popup "Error in git-diff-tree: $err"
3073 } elseif {[info exists findid]} {
3074 set id $findid
3075 stopfindproc
3076 bell
3077 error_popup "Couldn't find diffs for $id"
3080 return
3082 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3083 # start of a new string of diffs
3084 donefilediff
3085 set fdiffid $id
3086 set fdiffs {}
3087 } elseif {[string match ":*" $line]} {
3088 lappend fdiffs [lindex $line 5]
3092 proc donefilediff {} {
3093 global fdiffid fdiffs treediffs findid
3094 global fdiffsneeded fdiffpos
3096 if {[info exists fdiffid]} {
3097 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3098 && $fdiffpos < [llength $fdiffsneeded]} {
3099 # git-diff-tree doesn't output anything for a commit
3100 # which doesn't change anything
3101 set nullid [lindex $fdiffsneeded $fdiffpos]
3102 set treediffs($nullid) {}
3103 if {[info exists findid] && $nullid eq $findid} {
3104 unset findid
3105 findcont
3107 incr fdiffpos
3109 incr fdiffpos
3111 if {![info exists treediffs($fdiffid)]} {
3112 set treediffs($fdiffid) $fdiffs
3114 if {[info exists findid] && $fdiffid eq $findid} {
3115 unset findid
3116 findcont
3121 proc findcont {} {
3122 global findid treediffs parentlist
3123 global ffileline findstartline finddidsel
3124 global displayorder numcommits matchinglines findinprogress
3125 global findmergefiles
3127 set l $ffileline
3128 while {1} {
3129 set id [lindex $displayorder $l]
3130 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3131 if {![info exists treediffs($id)]} {
3132 set findid $id
3133 set ffileline $l
3134 return
3136 set doesmatch 0
3137 foreach f $treediffs($id) {
3138 set x [findmatches $f]
3139 if {$x != {}} {
3140 set doesmatch 1
3141 break
3144 if {$doesmatch} {
3145 insertmatch $l $id
3148 if {[incr l] >= $numcommits} {
3149 set l 0
3151 if {$l == $findstartline} break
3153 stopfindproc
3154 if {!$finddidsel} {
3155 bell
3159 # mark a commit as matching by putting a yellow background
3160 # behind the headline
3161 proc markheadline {l id} {
3162 global canv mainfont linehtag
3164 drawcmitrow $l
3165 set bbox [$canv bbox $linehtag($l)]
3166 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3167 $canv lower $t
3170 # mark the bits of a headline, author or date that match a find string
3171 proc markmatches {canv l str tag matches font} {
3172 set bbox [$canv bbox $tag]
3173 set x0 [lindex $bbox 0]
3174 set y0 [lindex $bbox 1]
3175 set y1 [lindex $bbox 3]
3176 foreach match $matches {
3177 set start [lindex $match 0]
3178 set end [lindex $match 1]
3179 if {$start > $end} continue
3180 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3181 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3182 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3183 [expr {$x0+$xlen+2}] $y1 \
3184 -outline {} -tags matches -fill yellow]
3185 $canv lower $t
3189 proc unmarkmatches {} {
3190 global matchinglines findids
3191 allcanvs delete matches
3192 catch {unset matchinglines}
3193 catch {unset findids}
3196 proc selcanvline {w x y} {
3197 global canv canvy0 ctext linespc
3198 global rowtextx
3199 set ymax [lindex [$canv cget -scrollregion] 3]
3200 if {$ymax == {}} return
3201 set yfrac [lindex [$canv yview] 0]
3202 set y [expr {$y + $yfrac * $ymax}]
3203 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3204 if {$l < 0} {
3205 set l 0
3207 if {$w eq $canv} {
3208 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3210 unmarkmatches
3211 selectline $l 1
3214 proc commit_descriptor {p} {
3215 global commitinfo
3216 set l "..."
3217 if {[info exists commitinfo($p)]} {
3218 set l [lindex $commitinfo($p) 0]
3220 return "$p ($l)"
3223 # append some text to the ctext widget, and make any SHA1 ID
3224 # that we know about be a clickable link.
3225 proc appendwithlinks {text} {
3226 global ctext commitrow linknum curview
3228 set start [$ctext index "end - 1c"]
3229 $ctext insert end $text
3230 $ctext insert end "\n"
3231 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3232 foreach l $links {
3233 set s [lindex $l 0]
3234 set e [lindex $l 1]
3235 set linkid [string range $text $s $e]
3236 if {![info exists commitrow($curview,$linkid)]} continue
3237 incr e
3238 $ctext tag add link "$start + $s c" "$start + $e c"
3239 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3240 $ctext tag bind link$linknum <1> \
3241 [list selectline $commitrow($curview,$linkid) 1]
3242 incr linknum
3244 $ctext tag conf link -foreground blue -underline 1
3245 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3246 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3249 proc viewnextline {dir} {
3250 global canv linespc
3252 $canv delete hover
3253 set ymax [lindex [$canv cget -scrollregion] 3]
3254 set wnow [$canv yview]
3255 set wtop [expr {[lindex $wnow 0] * $ymax}]
3256 set newtop [expr {$wtop + $dir * $linespc}]
3257 if {$newtop < 0} {
3258 set newtop 0
3259 } elseif {$newtop > $ymax} {
3260 set newtop $ymax
3262 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3265 proc selectline {l isnew} {
3266 global canv canv2 canv3 ctext commitinfo selectedline
3267 global displayorder linehtag linentag linedtag
3268 global canvy0 linespc parentlist childlist
3269 global currentid sha1entry
3270 global commentend idtags linknum
3271 global mergemax numcommits pending_select
3272 global cmitmode
3274 catch {unset pending_select}
3275 $canv delete hover
3276 normalline
3277 if {$l < 0 || $l >= $numcommits} return
3278 set y [expr {$canvy0 + $l * $linespc}]
3279 set ymax [lindex [$canv cget -scrollregion] 3]
3280 set ytop [expr {$y - $linespc - 1}]
3281 set ybot [expr {$y + $linespc + 1}]
3282 set wnow [$canv yview]
3283 set wtop [expr {[lindex $wnow 0] * $ymax}]
3284 set wbot [expr {[lindex $wnow 1] * $ymax}]
3285 set wh [expr {$wbot - $wtop}]
3286 set newtop $wtop
3287 if {$ytop < $wtop} {
3288 if {$ybot < $wtop} {
3289 set newtop [expr {$y - $wh / 2.0}]
3290 } else {
3291 set newtop $ytop
3292 if {$newtop > $wtop - $linespc} {
3293 set newtop [expr {$wtop - $linespc}]
3296 } elseif {$ybot > $wbot} {
3297 if {$ytop > $wbot} {
3298 set newtop [expr {$y - $wh / 2.0}]
3299 } else {
3300 set newtop [expr {$ybot - $wh}]
3301 if {$newtop < $wtop + $linespc} {
3302 set newtop [expr {$wtop + $linespc}]
3306 if {$newtop != $wtop} {
3307 if {$newtop < 0} {
3308 set newtop 0
3310 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3311 drawvisible
3314 if {![info exists linehtag($l)]} return
3315 $canv delete secsel
3316 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3317 -tags secsel -fill [$canv cget -selectbackground]]
3318 $canv lower $t
3319 $canv2 delete secsel
3320 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3321 -tags secsel -fill [$canv2 cget -selectbackground]]
3322 $canv2 lower $t
3323 $canv3 delete secsel
3324 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3325 -tags secsel -fill [$canv3 cget -selectbackground]]
3326 $canv3 lower $t
3328 if {$isnew} {
3329 addtohistory [list selectline $l 0]
3332 set selectedline $l
3334 set id [lindex $displayorder $l]
3335 set currentid $id
3336 $sha1entry delete 0 end
3337 $sha1entry insert 0 $id
3338 $sha1entry selection from 0
3339 $sha1entry selection to end
3341 $ctext conf -state normal
3342 $ctext delete 0.0 end
3343 set linknum 0
3344 set info $commitinfo($id)
3345 set date [formatdate [lindex $info 2]]
3346 $ctext insert end "Author: [lindex $info 1] $date\n"
3347 set date [formatdate [lindex $info 4]]
3348 $ctext insert end "Committer: [lindex $info 3] $date\n"
3349 if {[info exists idtags($id)]} {
3350 $ctext insert end "Tags:"
3351 foreach tag $idtags($id) {
3352 $ctext insert end " $tag"
3354 $ctext insert end "\n"
3357 set comment {}
3358 set olds [lindex $parentlist $l]
3359 if {[llength $olds] > 1} {
3360 set np 0
3361 foreach p $olds {
3362 if {$np >= $mergemax} {
3363 set tag mmax
3364 } else {
3365 set tag m$np
3367 $ctext insert end "Parent: " $tag
3368 appendwithlinks [commit_descriptor $p]
3369 incr np
3371 } else {
3372 foreach p $olds {
3373 append comment "Parent: [commit_descriptor $p]\n"
3377 foreach c [lindex $childlist $l] {
3378 append comment "Child: [commit_descriptor $c]\n"
3380 append comment "\n"
3381 append comment [lindex $info 5]
3383 # make anything that looks like a SHA1 ID be a clickable link
3384 appendwithlinks $comment
3386 $ctext tag delete Comments
3387 $ctext tag remove found 1.0 end
3388 $ctext conf -state disabled
3389 set commentend [$ctext index "end - 1c"]
3391 init_flist "Comments"
3392 if {$cmitmode eq "tree"} {
3393 gettree $id
3394 } elseif {[llength $olds] <= 1} {
3395 startdiff $id
3396 } else {
3397 mergediff $id $l
3401 proc selfirstline {} {
3402 unmarkmatches
3403 selectline 0 1
3406 proc sellastline {} {
3407 global numcommits
3408 unmarkmatches
3409 set l [expr {$numcommits - 1}]
3410 selectline $l 1
3413 proc selnextline {dir} {
3414 global selectedline
3415 if {![info exists selectedline]} return
3416 set l [expr {$selectedline + $dir}]
3417 unmarkmatches
3418 selectline $l 1
3421 proc selnextpage {dir} {
3422 global canv linespc selectedline numcommits
3424 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3425 if {$lpp < 1} {
3426 set lpp 1
3428 allcanvs yview scroll [expr {$dir * $lpp}] units
3429 if {![info exists selectedline]} return
3430 set l [expr {$selectedline + $dir * $lpp}]
3431 if {$l < 0} {
3432 set l 0
3433 } elseif {$l >= $numcommits} {
3434 set l [expr $numcommits - 1]
3436 unmarkmatches
3437 selectline $l 1
3440 proc unselectline {} {
3441 global selectedline currentid
3443 catch {unset selectedline}
3444 catch {unset currentid}
3445 allcanvs delete secsel
3448 proc reselectline {} {
3449 global selectedline
3451 if {[info exists selectedline]} {
3452 selectline $selectedline 0
3456 proc addtohistory {cmd} {
3457 global history historyindex curview
3459 set elt [list $curview $cmd]
3460 if {$historyindex > 0
3461 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3462 return
3465 if {$historyindex < [llength $history]} {
3466 set history [lreplace $history $historyindex end $elt]
3467 } else {
3468 lappend history $elt
3470 incr historyindex
3471 if {$historyindex > 1} {
3472 .ctop.top.bar.leftbut conf -state normal
3473 } else {
3474 .ctop.top.bar.leftbut conf -state disabled
3476 .ctop.top.bar.rightbut conf -state disabled
3479 proc godo {elt} {
3480 global curview
3482 set view [lindex $elt 0]
3483 set cmd [lindex $elt 1]
3484 if {$curview != $view} {
3485 showview $view
3487 eval $cmd
3490 proc goback {} {
3491 global history historyindex
3493 if {$historyindex > 1} {
3494 incr historyindex -1
3495 godo [lindex $history [expr {$historyindex - 1}]]
3496 .ctop.top.bar.rightbut conf -state normal
3498 if {$historyindex <= 1} {
3499 .ctop.top.bar.leftbut conf -state disabled
3503 proc goforw {} {
3504 global history historyindex
3506 if {$historyindex < [llength $history]} {
3507 set cmd [lindex $history $historyindex]
3508 incr historyindex
3509 godo $cmd
3510 .ctop.top.bar.leftbut conf -state normal
3512 if {$historyindex >= [llength $history]} {
3513 .ctop.top.bar.rightbut conf -state disabled
3517 proc gettree {id} {
3518 global treefilelist treeidlist diffids diffmergeid treepending
3520 set diffids $id
3521 catch {unset diffmergeid}
3522 if {![info exists treefilelist($id)]} {
3523 if {![info exists treepending]} {
3524 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3525 return
3527 set treepending $id
3528 set treefilelist($id) {}
3529 set treeidlist($id) {}
3530 fconfigure $gtf -blocking 0
3531 fileevent $gtf readable [list gettreeline $gtf $id]
3533 } else {
3534 setfilelist $id
3538 proc gettreeline {gtf id} {
3539 global treefilelist treeidlist treepending cmitmode diffids
3541 while {[gets $gtf line] >= 0} {
3542 if {[lindex $line 1] ne "blob"} continue
3543 set sha1 [lindex $line 2]
3544 set fname [lindex $line 3]
3545 lappend treefilelist($id) $fname
3546 lappend treeidlist($id) $sha1
3548 if {![eof $gtf]} return
3549 close $gtf
3550 unset treepending
3551 if {$cmitmode ne "tree"} {
3552 if {![info exists diffmergeid]} {
3553 gettreediffs $diffids
3555 } elseif {$id ne $diffids} {
3556 gettree $diffids
3557 } else {
3558 setfilelist $id
3562 proc showfile {f} {
3563 global treefilelist treeidlist diffids
3564 global ctext commentend
3566 set i [lsearch -exact $treefilelist($diffids) $f]
3567 if {$i < 0} {
3568 puts "oops, $f not in list for id $diffids"
3569 return
3571 set blob [lindex $treeidlist($diffids) $i]
3572 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3573 puts "oops, error reading blob $blob: $err"
3574 return
3576 fconfigure $bf -blocking 0
3577 fileevent $bf readable [list getblobline $bf $diffids]
3578 $ctext config -state normal
3579 $ctext delete $commentend end
3580 $ctext insert end "\n"
3581 $ctext insert end "$f\n" filesep
3582 $ctext config -state disabled
3583 $ctext yview $commentend
3586 proc getblobline {bf id} {
3587 global diffids cmitmode ctext
3589 if {$id ne $diffids || $cmitmode ne "tree"} {
3590 catch {close $bf}
3591 return
3593 $ctext config -state normal
3594 while {[gets $bf line] >= 0} {
3595 $ctext insert end "$line\n"
3597 if {[eof $bf]} {
3598 # delete last newline
3599 $ctext delete "end - 2c" "end - 1c"
3600 close $bf
3602 $ctext config -state disabled
3605 proc mergediff {id l} {
3606 global diffmergeid diffopts mdifffd
3607 global diffids
3608 global parentlist
3610 set diffmergeid $id
3611 set diffids $id
3612 # this doesn't seem to actually affect anything...
3613 set env(GIT_DIFF_OPTS) $diffopts
3614 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3615 if {[catch {set mdf [open $cmd r]} err]} {
3616 error_popup "Error getting merge diffs: $err"
3617 return
3619 fconfigure $mdf -blocking 0
3620 set mdifffd($id) $mdf
3621 set np [llength [lindex $parentlist $l]]
3622 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3623 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3626 proc getmergediffline {mdf id np} {
3627 global diffmergeid ctext cflist nextupdate mergemax
3628 global difffilestart mdifffd
3630 set n [gets $mdf line]
3631 if {$n < 0} {
3632 if {[eof $mdf]} {
3633 close $mdf
3635 return
3637 if {![info exists diffmergeid] || $id != $diffmergeid
3638 || $mdf != $mdifffd($id)} {
3639 return
3641 $ctext conf -state normal
3642 if {[regexp {^diff --cc (.*)} $line match fname]} {
3643 # start of a new file
3644 $ctext insert end "\n"
3645 set here [$ctext index "end - 1c"]
3646 lappend difffilestart $here
3647 add_flist [list $fname]
3648 set l [expr {(78 - [string length $fname]) / 2}]
3649 set pad [string range "----------------------------------------" 1 $l]
3650 $ctext insert end "$pad $fname $pad\n" filesep
3651 } elseif {[regexp {^@@} $line]} {
3652 $ctext insert end "$line\n" hunksep
3653 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3654 # do nothing
3655 } else {
3656 # parse the prefix - one ' ', '-' or '+' for each parent
3657 set spaces {}
3658 set minuses {}
3659 set pluses {}
3660 set isbad 0
3661 for {set j 0} {$j < $np} {incr j} {
3662 set c [string range $line $j $j]
3663 if {$c == " "} {
3664 lappend spaces $j
3665 } elseif {$c == "-"} {
3666 lappend minuses $j
3667 } elseif {$c == "+"} {
3668 lappend pluses $j
3669 } else {
3670 set isbad 1
3671 break
3674 set tags {}
3675 set num {}
3676 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3677 # line doesn't appear in result, parents in $minuses have the line
3678 set num [lindex $minuses 0]
3679 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3680 # line appears in result, parents in $pluses don't have the line
3681 lappend tags mresult
3682 set num [lindex $spaces 0]
3684 if {$num ne {}} {
3685 if {$num >= $mergemax} {
3686 set num "max"
3688 lappend tags m$num
3690 $ctext insert end "$line\n" $tags
3692 $ctext conf -state disabled
3693 if {[clock clicks -milliseconds] >= $nextupdate} {
3694 incr nextupdate 100
3695 fileevent $mdf readable {}
3696 update
3697 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3701 proc startdiff {ids} {
3702 global treediffs diffids treepending diffmergeid
3704 set diffids $ids
3705 catch {unset diffmergeid}
3706 if {![info exists treediffs($ids)]} {
3707 if {![info exists treepending]} {
3708 gettreediffs $ids
3710 } else {
3711 addtocflist $ids
3715 proc addtocflist {ids} {
3716 global treediffs cflist
3717 add_flist $treediffs($ids)
3718 getblobdiffs $ids
3721 proc gettreediffs {ids} {
3722 global treediff treepending
3723 set treepending $ids
3724 set treediff {}
3725 if {[catch \
3726 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3727 ]} return
3728 fconfigure $gdtf -blocking 0
3729 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3732 proc gettreediffline {gdtf ids} {
3733 global treediff treediffs treepending diffids diffmergeid
3734 global cmitmode
3736 set n [gets $gdtf line]
3737 if {$n < 0} {
3738 if {![eof $gdtf]} return
3739 close $gdtf
3740 set treediffs($ids) $treediff
3741 unset treepending
3742 if {$cmitmode eq "tree"} {
3743 gettree $diffids
3744 } elseif {$ids != $diffids} {
3745 if {![info exists diffmergeid]} {
3746 gettreediffs $diffids
3748 } else {
3749 addtocflist $ids
3751 return
3753 set file [lindex $line 5]
3754 lappend treediff $file
3757 proc getblobdiffs {ids} {
3758 global diffopts blobdifffd diffids env curdifftag curtagstart
3759 global nextupdate diffinhdr treediffs
3761 set env(GIT_DIFF_OPTS) $diffopts
3762 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3763 if {[catch {set bdf [open $cmd r]} err]} {
3764 puts "error getting diffs: $err"
3765 return
3767 set diffinhdr 0
3768 fconfigure $bdf -blocking 0
3769 set blobdifffd($ids) $bdf
3770 set curdifftag Comments
3771 set curtagstart 0.0
3772 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3773 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3776 proc setinlist {var i val} {
3777 global $var
3779 while {[llength [set $var]] < $i} {
3780 lappend $var {}
3782 if {[llength [set $var]] == $i} {
3783 lappend $var $val
3784 } else {
3785 lset $var $i $val
3789 proc getblobdiffline {bdf ids} {
3790 global diffids blobdifffd ctext curdifftag curtagstart
3791 global diffnexthead diffnextnote difffilestart
3792 global nextupdate diffinhdr treediffs
3794 set n [gets $bdf line]
3795 if {$n < 0} {
3796 if {[eof $bdf]} {
3797 close $bdf
3798 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3799 $ctext tag add $curdifftag $curtagstart end
3802 return
3804 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3805 return
3807 $ctext conf -state normal
3808 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3809 # start of a new file
3810 $ctext insert end "\n"
3811 $ctext tag add $curdifftag $curtagstart end
3812 set here [$ctext index "end - 1c"]
3813 set curtagstart $here
3814 set header $newname
3815 set i [lsearch -exact $treediffs($ids) $fname]
3816 if {$i >= 0} {
3817 setinlist difffilestart $i $here
3819 if {$newname ne $fname} {
3820 set i [lsearch -exact $treediffs($ids) $newname]
3821 if {$i >= 0} {
3822 setinlist difffilestart $i $here
3825 set curdifftag "f:$fname"
3826 $ctext tag delete $curdifftag
3827 set l [expr {(78 - [string length $header]) / 2}]
3828 set pad [string range "----------------------------------------" 1 $l]
3829 $ctext insert end "$pad $header $pad\n" filesep
3830 set diffinhdr 1
3831 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3832 # do nothing
3833 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3834 set diffinhdr 0
3835 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3836 $line match f1l f1c f2l f2c rest]} {
3837 $ctext insert end "$line\n" hunksep
3838 set diffinhdr 0
3839 } else {
3840 set x [string range $line 0 0]
3841 if {$x == "-" || $x == "+"} {
3842 set tag [expr {$x == "+"}]
3843 $ctext insert end "$line\n" d$tag
3844 } elseif {$x == " "} {
3845 $ctext insert end "$line\n"
3846 } elseif {$diffinhdr || $x == "\\"} {
3847 # e.g. "\ No newline at end of file"
3848 $ctext insert end "$line\n" filesep
3849 } else {
3850 # Something else we don't recognize
3851 if {$curdifftag != "Comments"} {
3852 $ctext insert end "\n"
3853 $ctext tag add $curdifftag $curtagstart end
3854 set curtagstart [$ctext index "end - 1c"]
3855 set curdifftag Comments
3857 $ctext insert end "$line\n" filesep
3860 $ctext conf -state disabled
3861 if {[clock clicks -milliseconds] >= $nextupdate} {
3862 incr nextupdate 100
3863 fileevent $bdf readable {}
3864 update
3865 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3869 proc nextfile {} {
3870 global difffilestart ctext
3871 set here [$ctext index @0,0]
3872 foreach loc $difffilestart {
3873 if {[$ctext compare $loc > $here]} {
3874 $ctext yview $loc
3879 proc setcoords {} {
3880 global linespc charspc canvx0 canvy0 mainfont
3881 global xspc1 xspc2 lthickness
3883 set linespc [font metrics $mainfont -linespace]
3884 set charspc [font measure $mainfont "m"]
3885 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3886 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3887 set lthickness [expr {int($linespc / 9) + 1}]
3888 set xspc1(0) $linespc
3889 set xspc2 $linespc
3892 proc redisplay {} {
3893 global canv
3894 global selectedline
3896 set ymax [lindex [$canv cget -scrollregion] 3]
3897 if {$ymax eq {} || $ymax == 0} return
3898 set span [$canv yview]
3899 clear_display
3900 setcanvscroll
3901 allcanvs yview moveto [lindex $span 0]
3902 drawvisible
3903 if {[info exists selectedline]} {
3904 selectline $selectedline 0
3908 proc incrfont {inc} {
3909 global mainfont textfont ctext canv phase
3910 global stopped entries
3911 unmarkmatches
3912 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3913 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3914 setcoords
3915 $ctext conf -font $textfont
3916 $ctext tag conf filesep -font [concat $textfont bold]
3917 foreach e $entries {
3918 $e conf -font $mainfont
3920 if {$phase eq "getcommits"} {
3921 $canv itemconf textitems -font $mainfont
3923 redisplay
3926 proc clearsha1 {} {
3927 global sha1entry sha1string
3928 if {[string length $sha1string] == 40} {
3929 $sha1entry delete 0 end
3933 proc sha1change {n1 n2 op} {
3934 global sha1string currentid sha1but
3935 if {$sha1string == {}
3936 || ([info exists currentid] && $sha1string == $currentid)} {
3937 set state disabled
3938 } else {
3939 set state normal
3941 if {[$sha1but cget -state] == $state} return
3942 if {$state == "normal"} {
3943 $sha1but conf -state normal -relief raised -text "Goto: "
3944 } else {
3945 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3949 proc gotocommit {} {
3950 global sha1string currentid commitrow tagids headids
3951 global displayorder numcommits curview
3953 if {$sha1string == {}
3954 || ([info exists currentid] && $sha1string == $currentid)} return
3955 if {[info exists tagids($sha1string)]} {
3956 set id $tagids($sha1string)
3957 } elseif {[info exists headids($sha1string)]} {
3958 set id $headids($sha1string)
3959 } else {
3960 set id [string tolower $sha1string]
3961 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3962 set matches {}
3963 foreach i $displayorder {
3964 if {[string match $id* $i]} {
3965 lappend matches $i
3968 if {$matches ne {}} {
3969 if {[llength $matches] > 1} {
3970 error_popup "Short SHA1 id $id is ambiguous"
3971 return
3973 set id [lindex $matches 0]
3977 if {[info exists commitrow($curview,$id)]} {
3978 selectline $commitrow($curview,$id) 1
3979 return
3981 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3982 set type "SHA1 id"
3983 } else {
3984 set type "Tag/Head"
3986 error_popup "$type $sha1string is not known"
3989 proc lineenter {x y id} {
3990 global hoverx hovery hoverid hovertimer
3991 global commitinfo canv
3993 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3994 set hoverx $x
3995 set hovery $y
3996 set hoverid $id
3997 if {[info exists hovertimer]} {
3998 after cancel $hovertimer
4000 set hovertimer [after 500 linehover]
4001 $canv delete hover
4004 proc linemotion {x y id} {
4005 global hoverx hovery hoverid hovertimer
4007 if {[info exists hoverid] && $id == $hoverid} {
4008 set hoverx $x
4009 set hovery $y
4010 if {[info exists hovertimer]} {
4011 after cancel $hovertimer
4013 set hovertimer [after 500 linehover]
4017 proc lineleave {id} {
4018 global hoverid hovertimer canv
4020 if {[info exists hoverid] && $id == $hoverid} {
4021 $canv delete hover
4022 if {[info exists hovertimer]} {
4023 after cancel $hovertimer
4024 unset hovertimer
4026 unset hoverid
4030 proc linehover {} {
4031 global hoverx hovery hoverid hovertimer
4032 global canv linespc lthickness
4033 global commitinfo mainfont
4035 set text [lindex $commitinfo($hoverid) 0]
4036 set ymax [lindex [$canv cget -scrollregion] 3]
4037 if {$ymax == {}} return
4038 set yfrac [lindex [$canv yview] 0]
4039 set x [expr {$hoverx + 2 * $linespc}]
4040 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4041 set x0 [expr {$x - 2 * $lthickness}]
4042 set y0 [expr {$y - 2 * $lthickness}]
4043 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4044 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4045 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4046 -fill \#ffff80 -outline black -width 1 -tags hover]
4047 $canv raise $t
4048 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4049 $canv raise $t
4052 proc clickisonarrow {id y} {
4053 global lthickness
4055 set ranges [rowranges $id]
4056 set thresh [expr {2 * $lthickness + 6}]
4057 set n [expr {[llength $ranges] - 1}]
4058 for {set i 1} {$i < $n} {incr i} {
4059 set row [lindex $ranges $i]
4060 if {abs([yc $row] - $y) < $thresh} {
4061 return $i
4064 return {}
4067 proc arrowjump {id n y} {
4068 global canv
4070 # 1 <-> 2, 3 <-> 4, etc...
4071 set n [expr {(($n - 1) ^ 1) + 1}]
4072 set row [lindex [rowranges $id] $n]
4073 set yt [yc $row]
4074 set ymax [lindex [$canv cget -scrollregion] 3]
4075 if {$ymax eq {} || $ymax <= 0} return
4076 set view [$canv yview]
4077 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4078 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4079 if {$yfrac < 0} {
4080 set yfrac 0
4082 allcanvs yview moveto $yfrac
4085 proc lineclick {x y id isnew} {
4086 global ctext commitinfo children canv thickerline curview
4088 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4089 unmarkmatches
4090 unselectline
4091 normalline
4092 $canv delete hover
4093 # draw this line thicker than normal
4094 set thickerline $id
4095 drawlines $id
4096 if {$isnew} {
4097 set ymax [lindex [$canv cget -scrollregion] 3]
4098 if {$ymax eq {}} return
4099 set yfrac [lindex [$canv yview] 0]
4100 set y [expr {$y + $yfrac * $ymax}]
4102 set dirn [clickisonarrow $id $y]
4103 if {$dirn ne {}} {
4104 arrowjump $id $dirn $y
4105 return
4108 if {$isnew} {
4109 addtohistory [list lineclick $x $y $id 0]
4111 # fill the details pane with info about this line
4112 $ctext conf -state normal
4113 $ctext delete 0.0 end
4114 $ctext tag conf link -foreground blue -underline 1
4115 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4116 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4117 $ctext insert end "Parent:\t"
4118 $ctext insert end $id [list link link0]
4119 $ctext tag bind link0 <1> [list selbyid $id]
4120 set info $commitinfo($id)
4121 $ctext insert end "\n\t[lindex $info 0]\n"
4122 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4123 set date [formatdate [lindex $info 2]]
4124 $ctext insert end "\tDate:\t$date\n"
4125 set kids $children($curview,$id)
4126 if {$kids ne {}} {
4127 $ctext insert end "\nChildren:"
4128 set i 0
4129 foreach child $kids {
4130 incr i
4131 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4132 set info $commitinfo($child)
4133 $ctext insert end "\n\t"
4134 $ctext insert end $child [list link link$i]
4135 $ctext tag bind link$i <1> [list selbyid $child]
4136 $ctext insert end "\n\t[lindex $info 0]"
4137 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4138 set date [formatdate [lindex $info 2]]
4139 $ctext insert end "\n\tDate:\t$date\n"
4142 $ctext conf -state disabled
4143 init_flist {}
4146 proc normalline {} {
4147 global thickerline
4148 if {[info exists thickerline]} {
4149 set id $thickerline
4150 unset thickerline
4151 drawlines $id
4155 proc selbyid {id} {
4156 global commitrow curview
4157 if {[info exists commitrow($curview,$id)]} {
4158 selectline $commitrow($curview,$id) 1
4162 proc mstime {} {
4163 global startmstime
4164 if {![info exists startmstime]} {
4165 set startmstime [clock clicks -milliseconds]
4167 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4170 proc rowmenu {x y id} {
4171 global rowctxmenu commitrow selectedline rowmenuid curview
4173 if {![info exists selectedline]
4174 || $commitrow($curview,$id) eq $selectedline} {
4175 set state disabled
4176 } else {
4177 set state normal
4179 $rowctxmenu entryconfigure 0 -state $state
4180 $rowctxmenu entryconfigure 1 -state $state
4181 $rowctxmenu entryconfigure 2 -state $state
4182 set rowmenuid $id
4183 tk_popup $rowctxmenu $x $y
4186 proc diffvssel {dirn} {
4187 global rowmenuid selectedline displayorder
4189 if {![info exists selectedline]} return
4190 if {$dirn} {
4191 set oldid [lindex $displayorder $selectedline]
4192 set newid $rowmenuid
4193 } else {
4194 set oldid $rowmenuid
4195 set newid [lindex $displayorder $selectedline]
4197 addtohistory [list doseldiff $oldid $newid]
4198 doseldiff $oldid $newid
4201 proc doseldiff {oldid newid} {
4202 global ctext
4203 global commitinfo
4205 $ctext conf -state normal
4206 $ctext delete 0.0 end
4207 init_flist "Top"
4208 $ctext insert end "From "
4209 $ctext tag conf link -foreground blue -underline 1
4210 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4211 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4212 $ctext tag bind link0 <1> [list selbyid $oldid]
4213 $ctext insert end $oldid [list link link0]
4214 $ctext insert end "\n "
4215 $ctext insert end [lindex $commitinfo($oldid) 0]
4216 $ctext insert end "\n\nTo "
4217 $ctext tag bind link1 <1> [list selbyid $newid]
4218 $ctext insert end $newid [list link link1]
4219 $ctext insert end "\n "
4220 $ctext insert end [lindex $commitinfo($newid) 0]
4221 $ctext insert end "\n"
4222 $ctext conf -state disabled
4223 $ctext tag delete Comments
4224 $ctext tag remove found 1.0 end
4225 startdiff [list $oldid $newid]
4228 proc mkpatch {} {
4229 global rowmenuid currentid commitinfo patchtop patchnum
4231 if {![info exists currentid]} return
4232 set oldid $currentid
4233 set oldhead [lindex $commitinfo($oldid) 0]
4234 set newid $rowmenuid
4235 set newhead [lindex $commitinfo($newid) 0]
4236 set top .patch
4237 set patchtop $top
4238 catch {destroy $top}
4239 toplevel $top
4240 label $top.title -text "Generate patch"
4241 grid $top.title - -pady 10
4242 label $top.from -text "From:"
4243 entry $top.fromsha1 -width 40 -relief flat
4244 $top.fromsha1 insert 0 $oldid
4245 $top.fromsha1 conf -state readonly
4246 grid $top.from $top.fromsha1 -sticky w
4247 entry $top.fromhead -width 60 -relief flat
4248 $top.fromhead insert 0 $oldhead
4249 $top.fromhead conf -state readonly
4250 grid x $top.fromhead -sticky w
4251 label $top.to -text "To:"
4252 entry $top.tosha1 -width 40 -relief flat
4253 $top.tosha1 insert 0 $newid
4254 $top.tosha1 conf -state readonly
4255 grid $top.to $top.tosha1 -sticky w
4256 entry $top.tohead -width 60 -relief flat
4257 $top.tohead insert 0 $newhead
4258 $top.tohead conf -state readonly
4259 grid x $top.tohead -sticky w
4260 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4261 grid $top.rev x -pady 10
4262 label $top.flab -text "Output file:"
4263 entry $top.fname -width 60
4264 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4265 incr patchnum
4266 grid $top.flab $top.fname -sticky w
4267 frame $top.buts
4268 button $top.buts.gen -text "Generate" -command mkpatchgo
4269 button $top.buts.can -text "Cancel" -command mkpatchcan
4270 grid $top.buts.gen $top.buts.can
4271 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4272 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4273 grid $top.buts - -pady 10 -sticky ew
4274 focus $top.fname
4277 proc mkpatchrev {} {
4278 global patchtop
4280 set oldid [$patchtop.fromsha1 get]
4281 set oldhead [$patchtop.fromhead get]
4282 set newid [$patchtop.tosha1 get]
4283 set newhead [$patchtop.tohead get]
4284 foreach e [list fromsha1 fromhead tosha1 tohead] \
4285 v [list $newid $newhead $oldid $oldhead] {
4286 $patchtop.$e conf -state normal
4287 $patchtop.$e delete 0 end
4288 $patchtop.$e insert 0 $v
4289 $patchtop.$e conf -state readonly
4293 proc mkpatchgo {} {
4294 global patchtop
4296 set oldid [$patchtop.fromsha1 get]
4297 set newid [$patchtop.tosha1 get]
4298 set fname [$patchtop.fname get]
4299 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4300 error_popup "Error creating patch: $err"
4302 catch {destroy $patchtop}
4303 unset patchtop
4306 proc mkpatchcan {} {
4307 global patchtop
4309 catch {destroy $patchtop}
4310 unset patchtop
4313 proc mktag {} {
4314 global rowmenuid mktagtop commitinfo
4316 set top .maketag
4317 set mktagtop $top
4318 catch {destroy $top}
4319 toplevel $top
4320 label $top.title -text "Create tag"
4321 grid $top.title - -pady 10
4322 label $top.id -text "ID:"
4323 entry $top.sha1 -width 40 -relief flat
4324 $top.sha1 insert 0 $rowmenuid
4325 $top.sha1 conf -state readonly
4326 grid $top.id $top.sha1 -sticky w
4327 entry $top.head -width 60 -relief flat
4328 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4329 $top.head conf -state readonly
4330 grid x $top.head -sticky w
4331 label $top.tlab -text "Tag name:"
4332 entry $top.tag -width 60
4333 grid $top.tlab $top.tag -sticky w
4334 frame $top.buts
4335 button $top.buts.gen -text "Create" -command mktaggo
4336 button $top.buts.can -text "Cancel" -command mktagcan
4337 grid $top.buts.gen $top.buts.can
4338 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4339 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4340 grid $top.buts - -pady 10 -sticky ew
4341 focus $top.tag
4344 proc domktag {} {
4345 global mktagtop env tagids idtags
4347 set id [$mktagtop.sha1 get]
4348 set tag [$mktagtop.tag get]
4349 if {$tag == {}} {
4350 error_popup "No tag name specified"
4351 return
4353 if {[info exists tagids($tag)]} {
4354 error_popup "Tag \"$tag\" already exists"
4355 return
4357 if {[catch {
4358 set dir [gitdir]
4359 set fname [file join $dir "refs/tags" $tag]
4360 set f [open $fname w]
4361 puts $f $id
4362 close $f
4363 } err]} {
4364 error_popup "Error creating tag: $err"
4365 return
4368 set tagids($tag) $id
4369 lappend idtags($id) $tag
4370 redrawtags $id
4373 proc redrawtags {id} {
4374 global canv linehtag commitrow idpos selectedline curview
4376 if {![info exists commitrow($curview,$id)]} return
4377 drawcmitrow $commitrow($curview,$id)
4378 $canv delete tag.$id
4379 set xt [eval drawtags $id $idpos($id)]
4380 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4381 if {[info exists selectedline]
4382 && $selectedline == $commitrow($curview,$id)} {
4383 selectline $selectedline 0
4387 proc mktagcan {} {
4388 global mktagtop
4390 catch {destroy $mktagtop}
4391 unset mktagtop
4394 proc mktaggo {} {
4395 domktag
4396 mktagcan
4399 proc writecommit {} {
4400 global rowmenuid wrcomtop commitinfo wrcomcmd
4402 set top .writecommit
4403 set wrcomtop $top
4404 catch {destroy $top}
4405 toplevel $top
4406 label $top.title -text "Write commit to file"
4407 grid $top.title - -pady 10
4408 label $top.id -text "ID:"
4409 entry $top.sha1 -width 40 -relief flat
4410 $top.sha1 insert 0 $rowmenuid
4411 $top.sha1 conf -state readonly
4412 grid $top.id $top.sha1 -sticky w
4413 entry $top.head -width 60 -relief flat
4414 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4415 $top.head conf -state readonly
4416 grid x $top.head -sticky w
4417 label $top.clab -text "Command:"
4418 entry $top.cmd -width 60 -textvariable wrcomcmd
4419 grid $top.clab $top.cmd -sticky w -pady 10
4420 label $top.flab -text "Output file:"
4421 entry $top.fname -width 60
4422 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4423 grid $top.flab $top.fname -sticky w
4424 frame $top.buts
4425 button $top.buts.gen -text "Write" -command wrcomgo
4426 button $top.buts.can -text "Cancel" -command wrcomcan
4427 grid $top.buts.gen $top.buts.can
4428 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4429 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4430 grid $top.buts - -pady 10 -sticky ew
4431 focus $top.fname
4434 proc wrcomgo {} {
4435 global wrcomtop
4437 set id [$wrcomtop.sha1 get]
4438 set cmd "echo $id | [$wrcomtop.cmd get]"
4439 set fname [$wrcomtop.fname get]
4440 if {[catch {exec sh -c $cmd >$fname &} err]} {
4441 error_popup "Error writing commit: $err"
4443 catch {destroy $wrcomtop}
4444 unset wrcomtop
4447 proc wrcomcan {} {
4448 global wrcomtop
4450 catch {destroy $wrcomtop}
4451 unset wrcomtop
4454 proc listrefs {id} {
4455 global idtags idheads idotherrefs
4457 set x {}
4458 if {[info exists idtags($id)]} {
4459 set x $idtags($id)
4461 set y {}
4462 if {[info exists idheads($id)]} {
4463 set y $idheads($id)
4465 set z {}
4466 if {[info exists idotherrefs($id)]} {
4467 set z $idotherrefs($id)
4469 return [list $x $y $z]
4472 proc rereadrefs {} {
4473 global idtags idheads idotherrefs
4475 set refids [concat [array names idtags] \
4476 [array names idheads] [array names idotherrefs]]
4477 foreach id $refids {
4478 if {![info exists ref($id)]} {
4479 set ref($id) [listrefs $id]
4482 readrefs
4483 set refids [lsort -unique [concat $refids [array names idtags] \
4484 [array names idheads] [array names idotherrefs]]]
4485 foreach id $refids {
4486 set v [listrefs $id]
4487 if {![info exists ref($id)] || $ref($id) != $v} {
4488 redrawtags $id
4493 proc showtag {tag isnew} {
4494 global ctext tagcontents tagids linknum
4496 if {$isnew} {
4497 addtohistory [list showtag $tag 0]
4499 $ctext conf -state normal
4500 $ctext delete 0.0 end
4501 set linknum 0
4502 if {[info exists tagcontents($tag)]} {
4503 set text $tagcontents($tag)
4504 } else {
4505 set text "Tag: $tag\nId: $tagids($tag)"
4507 appendwithlinks $text
4508 $ctext conf -state disabled
4509 init_flist {}
4512 proc doquit {} {
4513 global stopped
4514 set stopped 100
4515 destroy .
4518 proc doprefs {} {
4519 global maxwidth maxgraphpct diffopts findmergefiles
4520 global oldprefs prefstop
4522 set top .gitkprefs
4523 set prefstop $top
4524 if {[winfo exists $top]} {
4525 raise $top
4526 return
4528 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4529 set oldprefs($v) [set $v]
4531 toplevel $top
4532 wm title $top "Gitk preferences"
4533 label $top.ldisp -text "Commit list display options"
4534 grid $top.ldisp - -sticky w -pady 10
4535 label $top.spacer -text " "
4536 label $top.maxwidthl -text "Maximum graph width (lines)" \
4537 -font optionfont
4538 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4539 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4540 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4541 -font optionfont
4542 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4543 grid x $top.maxpctl $top.maxpct -sticky w
4544 checkbutton $top.findm -variable findmergefiles
4545 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4546 -font optionfont
4547 grid $top.findm $top.findml - -sticky w
4548 label $top.ddisp -text "Diff display options"
4549 grid $top.ddisp - -sticky w -pady 10
4550 label $top.diffoptl -text "Options for diff program" \
4551 -font optionfont
4552 entry $top.diffopt -width 20 -textvariable diffopts
4553 grid x $top.diffoptl $top.diffopt -sticky w
4554 frame $top.buts
4555 button $top.buts.ok -text "OK" -command prefsok
4556 button $top.buts.can -text "Cancel" -command prefscan
4557 grid $top.buts.ok $top.buts.can
4558 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4559 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4560 grid $top.buts - - -pady 10 -sticky ew
4563 proc prefscan {} {
4564 global maxwidth maxgraphpct diffopts findmergefiles
4565 global oldprefs prefstop
4567 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4568 set $v $oldprefs($v)
4570 catch {destroy $prefstop}
4571 unset prefstop
4574 proc prefsok {} {
4575 global maxwidth maxgraphpct
4576 global oldprefs prefstop
4578 catch {destroy $prefstop}
4579 unset prefstop
4580 if {$maxwidth != $oldprefs(maxwidth)
4581 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4582 redisplay
4586 proc formatdate {d} {
4587 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4590 # This list of encoding names and aliases is distilled from
4591 # http://www.iana.org/assignments/character-sets.
4592 # Not all of them are supported by Tcl.
4593 set encoding_aliases {
4594 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4595 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4596 { ISO-10646-UTF-1 csISO10646UTF1 }
4597 { ISO_646.basic:1983 ref csISO646basic1983 }
4598 { INVARIANT csINVARIANT }
4599 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4600 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4601 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4602 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4603 { NATS-DANO iso-ir-9-1 csNATSDANO }
4604 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4605 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4606 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4607 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4608 { ISO-2022-KR csISO2022KR }
4609 { EUC-KR csEUCKR }
4610 { ISO-2022-JP csISO2022JP }
4611 { ISO-2022-JP-2 csISO2022JP2 }
4612 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4613 csISO13JISC6220jp }
4614 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4615 { IT iso-ir-15 ISO646-IT csISO15Italian }
4616 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4617 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4618 { greek7-old iso-ir-18 csISO18Greek7Old }
4619 { latin-greek iso-ir-19 csISO19LatinGreek }
4620 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4621 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4622 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4623 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4624 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4625 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4626 { INIS iso-ir-49 csISO49INIS }
4627 { INIS-8 iso-ir-50 csISO50INIS8 }
4628 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4629 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4630 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4631 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4632 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4633 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4634 csISO60Norwegian1 }
4635 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4636 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4637 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4638 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4639 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4640 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4641 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4642 { greek7 iso-ir-88 csISO88Greek7 }
4643 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4644 { iso-ir-90 csISO90 }
4645 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4646 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4647 csISO92JISC62991984b }
4648 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4649 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4650 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4651 csISO95JIS62291984handadd }
4652 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4653 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4654 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4655 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4656 CP819 csISOLatin1 }
4657 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4658 { T.61-7bit iso-ir-102 csISO102T617bit }
4659 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4660 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4661 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4662 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4663 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4664 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4665 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4666 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4667 arabic csISOLatinArabic }
4668 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4669 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4670 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4671 greek greek8 csISOLatinGreek }
4672 { T.101-G2 iso-ir-128 csISO128T101G2 }
4673 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4674 csISOLatinHebrew }
4675 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4676 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4677 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4678 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4679 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4680 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4681 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4682 csISOLatinCyrillic }
4683 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4684 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4685 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4686 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4687 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4688 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4689 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4690 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4691 { ISO_10367-box iso-ir-155 csISO10367Box }
4692 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4693 { latin-lap lap iso-ir-158 csISO158Lap }
4694 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4695 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4696 { us-dk csUSDK }
4697 { dk-us csDKUS }
4698 { JIS_X0201 X0201 csHalfWidthKatakana }
4699 { KSC5636 ISO646-KR csKSC5636 }
4700 { ISO-10646-UCS-2 csUnicode }
4701 { ISO-10646-UCS-4 csUCS4 }
4702 { DEC-MCS dec csDECMCS }
4703 { hp-roman8 roman8 r8 csHPRoman8 }
4704 { macintosh mac csMacintosh }
4705 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4706 csIBM037 }
4707 { IBM038 EBCDIC-INT cp038 csIBM038 }
4708 { IBM273 CP273 csIBM273 }
4709 { IBM274 EBCDIC-BE CP274 csIBM274 }
4710 { IBM275 EBCDIC-BR cp275 csIBM275 }
4711 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4712 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4713 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4714 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4715 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4716 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4717 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4718 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4719 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4720 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4721 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4722 { IBM437 cp437 437 csPC8CodePage437 }
4723 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4724 { IBM775 cp775 csPC775Baltic }
4725 { IBM850 cp850 850 csPC850Multilingual }
4726 { IBM851 cp851 851 csIBM851 }
4727 { IBM852 cp852 852 csPCp852 }
4728 { IBM855 cp855 855 csIBM855 }
4729 { IBM857 cp857 857 csIBM857 }
4730 { IBM860 cp860 860 csIBM860 }
4731 { IBM861 cp861 861 cp-is csIBM861 }
4732 { IBM862 cp862 862 csPC862LatinHebrew }
4733 { IBM863 cp863 863 csIBM863 }
4734 { IBM864 cp864 csIBM864 }
4735 { IBM865 cp865 865 csIBM865 }
4736 { IBM866 cp866 866 csIBM866 }
4737 { IBM868 CP868 cp-ar csIBM868 }
4738 { IBM869 cp869 869 cp-gr csIBM869 }
4739 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4740 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4741 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4742 { IBM891 cp891 csIBM891 }
4743 { IBM903 cp903 csIBM903 }
4744 { IBM904 cp904 904 csIBBM904 }
4745 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4746 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4747 { IBM1026 CP1026 csIBM1026 }
4748 { EBCDIC-AT-DE csIBMEBCDICATDE }
4749 { EBCDIC-AT-DE-A csEBCDICATDEA }
4750 { EBCDIC-CA-FR csEBCDICCAFR }
4751 { EBCDIC-DK-NO csEBCDICDKNO }
4752 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4753 { EBCDIC-FI-SE csEBCDICFISE }
4754 { EBCDIC-FI-SE-A csEBCDICFISEA }
4755 { EBCDIC-FR csEBCDICFR }
4756 { EBCDIC-IT csEBCDICIT }
4757 { EBCDIC-PT csEBCDICPT }
4758 { EBCDIC-ES csEBCDICES }
4759 { EBCDIC-ES-A csEBCDICESA }
4760 { EBCDIC-ES-S csEBCDICESS }
4761 { EBCDIC-UK csEBCDICUK }
4762 { EBCDIC-US csEBCDICUS }
4763 { UNKNOWN-8BIT csUnknown8BiT }
4764 { MNEMONIC csMnemonic }
4765 { MNEM csMnem }
4766 { VISCII csVISCII }
4767 { VIQR csVIQR }
4768 { KOI8-R csKOI8R }
4769 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4770 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4771 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4772 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4773 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4774 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4775 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4776 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4777 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4778 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4779 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4780 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4781 { IBM1047 IBM-1047 }
4782 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4783 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4784 { UNICODE-1-1 csUnicode11 }
4785 { CESU-8 csCESU-8 }
4786 { BOCU-1 csBOCU-1 }
4787 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4788 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4789 l8 }
4790 { ISO-8859-15 ISO_8859-15 Latin-9 }
4791 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4792 { GBK CP936 MS936 windows-936 }
4793 { JIS_Encoding csJISEncoding }
4794 { Shift_JIS MS_Kanji csShiftJIS }
4795 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4796 EUC-JP }
4797 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4798 { ISO-10646-UCS-Basic csUnicodeASCII }
4799 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4800 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4801 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4802 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4803 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4804 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4805 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4806 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4807 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4808 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4809 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4810 { Ventura-US csVenturaUS }
4811 { Ventura-International csVenturaInternational }
4812 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4813 { PC8-Turkish csPC8Turkish }
4814 { IBM-Symbols csIBMSymbols }
4815 { IBM-Thai csIBMThai }
4816 { HP-Legal csHPLegal }
4817 { HP-Pi-font csHPPiFont }
4818 { HP-Math8 csHPMath8 }
4819 { Adobe-Symbol-Encoding csHPPSMath }
4820 { HP-DeskTop csHPDesktop }
4821 { Ventura-Math csVenturaMath }
4822 { Microsoft-Publishing csMicrosoftPublishing }
4823 { Windows-31J csWindows31J }
4824 { GB2312 csGB2312 }
4825 { Big5 csBig5 }
4828 proc tcl_encoding {enc} {
4829 global encoding_aliases
4830 set names [encoding names]
4831 set lcnames [string tolower $names]
4832 set enc [string tolower $enc]
4833 set i [lsearch -exact $lcnames $enc]
4834 if {$i < 0} {
4835 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4836 if {[regsub {^iso[-_]} $enc iso encx]} {
4837 set i [lsearch -exact $lcnames $encx]
4840 if {$i < 0} {
4841 foreach l $encoding_aliases {
4842 set ll [string tolower $l]
4843 if {[lsearch -exact $ll $enc] < 0} continue
4844 # look through the aliases for one that tcl knows about
4845 foreach e $ll {
4846 set i [lsearch -exact $lcnames $e]
4847 if {$i < 0} {
4848 if {[regsub {^iso[-_]} $e iso ex]} {
4849 set i [lsearch -exact $lcnames $ex]
4852 if {$i >= 0} break
4854 break
4857 if {$i >= 0} {
4858 return [lindex $names $i]
4860 return {}
4863 # defaults...
4864 set datemode 0
4865 set diffopts "-U 5 -p"
4866 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4868 set gitencoding {}
4869 catch {
4870 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4872 if {$gitencoding == ""} {
4873 set gitencoding "utf-8"
4875 set tclencoding [tcl_encoding $gitencoding]
4876 if {$tclencoding == {}} {
4877 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4880 set mainfont {Helvetica 9}
4881 set textfont {Courier 9}
4882 set uifont {Helvetica 9 bold}
4883 set findmergefiles 0
4884 set maxgraphpct 50
4885 set maxwidth 16
4886 set revlistorder 0
4887 set fastdate 0
4888 set uparrowlen 7
4889 set downarrowlen 7
4890 set mingaplen 30
4891 set flistmode "flat"
4892 set cmitmode "patch"
4894 set colors {green red blue magenta darkgrey brown orange}
4896 catch {source ~/.gitk}
4898 font create optionfont -family sans-serif -size -12
4900 set revtreeargs {}
4901 foreach arg $argv {
4902 switch -regexp -- $arg {
4903 "^$" { }
4904 "^-d" { set datemode 1 }
4905 default {
4906 lappend revtreeargs $arg
4911 # check that we can find a .git directory somewhere...
4912 set gitdir [gitdir]
4913 if {![file isdirectory $gitdir]} {
4914 show_error . "Cannot find the git directory \"$gitdir\"."
4915 exit 1
4918 set cmdline_files {}
4919 set i [lsearch -exact $revtreeargs "--"]
4920 if {$i >= 0} {
4921 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
4922 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
4923 } elseif {$revtreeargs ne {}} {
4924 if {[catch {
4925 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4926 set cmdline_files [split $f "\n"]
4927 set n [llength $cmdline_files]
4928 set revtreeargs [lrange $revtreeargs 0 end-$n]
4929 } err]} {
4930 # unfortunately we get both stdout and stderr in $err,
4931 # so look for "fatal:".
4932 set i [string first "fatal:" $err]
4933 if {$i > 0} {
4934 set err [string range [expr {$i + 6}] end]
4936 show_error . "Bad arguments to gitk:\n$err"
4937 exit 1
4941 set history {}
4942 set historyindex 0
4944 set optim_delay 16
4946 set nextviewnum 1
4947 set curview 0
4948 set selectedview 0
4949 set selectedhlview {}
4950 set viewfiles(0) {}
4951 set viewperm(0) 0
4952 set viewargs(0) {}
4954 set cmdlineok 0
4955 set stopped 0
4956 set stuffsaved 0
4957 set patchnum 0
4958 setcoords
4959 makewindow
4960 readrefs
4962 if {$cmdline_files ne {} || $revtreeargs ne {}} {
4963 # create a view for the files/dirs specified on the command line
4964 set curview 1
4965 set selectedview 1
4966 set nextviewnum 2
4967 set viewname(1) "Command line"
4968 set viewfiles(1) $cmdline_files
4969 set viewargs(1) $revtreeargs
4970 set viewperm(1) 0
4971 addviewmenu 1
4972 .bar.view entryconf 2 -state normal
4973 .bar.view entryconf 3 -state normal
4976 if {[info exists permviews]} {
4977 foreach v $permviews {
4978 set n $nextviewnum
4979 incr nextviewnum
4980 set viewname($n) [lindex $v 0]
4981 set viewfiles($n) [lindex $v 1]
4982 set viewargs($n) [lindex $v 2]
4983 set viewperm($n) 1
4984 addviewmenu $n
4987 getcommits