gitk: Highlight paths of interest in tree view as well
[git/dscho.git] / gitk
blob2e0450437f0aa8dc2b04f1a878d588a5069e24e1
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 vhighlightmore
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 selectedline thickerline
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 selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
241 readrefs
242 showview $n
245 proc parsecommit {id contents listed} {
246 global commitinfo cdate
248 set inhdr 1
249 set comment {}
250 set headline {}
251 set auname {}
252 set audate {}
253 set comname {}
254 set comdate {}
255 set hdrend [string first "\n\n" $contents]
256 if {$hdrend < 0} {
257 # should never happen...
258 set hdrend [string length $contents]
260 set header [string range $contents 0 [expr {$hdrend - 1}]]
261 set comment [string range $contents [expr {$hdrend + 2}] end]
262 foreach line [split $header "\n"] {
263 set tag [lindex $line 0]
264 if {$tag == "author"} {
265 set audate [lindex $line end-1]
266 set auname [lrange $line 1 end-2]
267 } elseif {$tag == "committer"} {
268 set comdate [lindex $line end-1]
269 set comname [lrange $line 1 end-2]
272 set headline {}
273 # take the first line of the comment as the headline
274 set i [string first "\n" $comment]
275 if {$i >= 0} {
276 set headline [string trim [string range $comment 0 $i]]
277 } else {
278 set headline $comment
280 if {!$listed} {
281 # git-rev-list indents the comment by 4 spaces;
282 # if we got this via git-cat-file, add the indentation
283 set newcomment {}
284 foreach line [split $comment "\n"] {
285 append newcomment " "
286 append newcomment $line
287 append newcomment "\n"
289 set comment $newcomment
291 if {$comdate != {}} {
292 set cdate($id) $comdate
294 set commitinfo($id) [list $headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit {id} {
299 global commitdata commitinfo
301 if {[info exists commitdata($id)]} {
302 parsecommit $id $commitdata($id) 1
303 } else {
304 readcommit $id
305 if {![info exists commitinfo($id)]} {
306 set commitinfo($id) {"No commit information available"}
309 return 1
312 proc readrefs {} {
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
317 catch {unset $v}
319 set refd [open [list | git ls-remote [gitdir]] r]
320 while {0 <= [set n [gets $refd line]]} {
321 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
322 match id path]} {
323 continue
325 if {[regexp {^remotes/.*/HEAD$} $path match]} {
326 continue
328 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
329 set type others
330 set name $path
332 if {[regexp {^remotes/} $path match]} {
333 set type heads
335 if {$type == "tags"} {
336 set tagids($name) $id
337 lappend idtags($id) $name
338 set obj {}
339 set type {}
340 set tag {}
341 catch {
342 set commit [exec git-rev-parse "$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids($name) $commit
345 lappend idtags($commit) $name
348 catch {
349 set tagcontents($name) [exec git-cat-file tag "$id"]
351 } elseif { $type == "heads" } {
352 set headids($name) $id
353 lappend idheads($id) $name
354 } else {
355 set otherrefids($name) $id
356 lappend idotherrefs($id) $name
359 close $refd
362 proc show_error {w msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $w"
366 pack $w.ok -side bottom -fill x
367 bind $w <Visibility> "grab $w; focus $w"
368 bind $w <Key-Return> "destroy $w"
369 tkwait window $w
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $msg
379 proc makewindow {} {
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax
386 global highlight_files highlight_names
388 menu .bar
389 .bar add cascade -label "File" -menu .bar.file
390 .bar configure -font $uifont
391 menu .bar.file
392 .bar.file add command -label "Update" -command updatecommits
393 .bar.file add command -label "Reread references" -command rereadrefs
394 .bar.file add command -label "Quit" -command doquit
395 .bar.file configure -font $uifont
396 menu .bar.edit
397 .bar add cascade -label "Edit" -menu .bar.edit
398 .bar.edit add command -label "Preferences" -command doprefs
399 .bar.edit configure -font $uifont
401 menu .bar.view -font $uifont
402 .bar add cascade -label "View" -menu .bar.view
403 .bar.view add command -label "New view..." -command {newview 0}
404 .bar.view add command -label "Edit view..." -command editview \
405 -state disabled
406 .bar.view add command -label "Delete view" -command delview -state disabled
407 .bar.view add separator
408 .bar.view add radiobutton -label "All files" -command {showview 0} \
409 -variable selectedview -value 0
411 menu .bar.help
412 .bar add cascade -label "Help" -menu .bar.help
413 .bar.help add command -label "About gitk" -command about
414 .bar.help add command -label "Key bindings" -command keys
415 .bar.help configure -font $uifont
416 . configure -menu .bar
418 if {![info exists geometry(canv1)]} {
419 set geometry(canv1) [expr {45 * $charspc}]
420 set geometry(canv2) [expr {30 * $charspc}]
421 set geometry(canv3) [expr {15 * $charspc}]
422 set geometry(canvh) [expr {25 * $linespc + 4}]
423 set geometry(ctextw) 80
424 set geometry(ctexth) 30
425 set geometry(cflistw) 30
427 panedwindow .ctop -orient vertical
428 if {[info exists geometry(width)]} {
429 .ctop conf -width $geometry(width) -height $geometry(height)
430 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
431 set geometry(ctexth) [expr {($texth - 8) /
432 [font metrics $textfont -linespace]}]
434 frame .ctop.top
435 frame .ctop.top.bar
436 frame .ctop.top.lbar
437 pack .ctop.top.lbar -side bottom -fill x
438 pack .ctop.top.bar -side bottom -fill x
439 set cscroll .ctop.top.csb
440 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
441 pack $cscroll -side right -fill y
442 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
443 pack .ctop.top.clist -side top -fill both -expand 1
444 .ctop add .ctop.top
445 set canv .ctop.top.clist.canv
446 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
447 -bg white -bd 0 \
448 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
449 .ctop.top.clist add $canv
450 set canv2 .ctop.top.clist.canv2
451 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
452 -bg white -bd 0 -yscrollincr $linespc
453 .ctop.top.clist add $canv2
454 set canv3 .ctop.top.clist.canv3
455 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
456 -bg white -bd 0 -yscrollincr $linespc
457 .ctop.top.clist add $canv3
458 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
460 set sha1entry .ctop.top.bar.sha1
461 set entries $sha1entry
462 set sha1but .ctop.top.bar.sha1label
463 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
464 -command gotocommit -width 8 -font $uifont
465 $sha1but conf -disabledforeground [$sha1but cget -foreground]
466 pack .ctop.top.bar.sha1label -side left
467 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
468 trace add variable sha1string write sha1change
469 pack $sha1entry -side left -pady 2
471 image create bitmap bm-left -data {
472 #define left_width 16
473 #define left_height 16
474 static unsigned char left_bits[] = {
475 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
476 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
477 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
479 image create bitmap bm-right -data {
480 #define right_width 16
481 #define right_height 16
482 static unsigned char right_bits[] = {
483 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
484 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
485 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
487 button .ctop.top.bar.leftbut -image bm-left -command goback \
488 -state disabled -width 26
489 pack .ctop.top.bar.leftbut -side left -fill y
490 button .ctop.top.bar.rightbut -image bm-right -command goforw \
491 -state disabled -width 26
492 pack .ctop.top.bar.rightbut -side left -fill y
494 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
495 pack .ctop.top.bar.findbut -side left
496 set findstring {}
497 set fstring .ctop.top.bar.findstring
498 lappend entries $fstring
499 entry $fstring -width 30 -font $textfont -textvariable findstring
500 pack $fstring -side left -expand 1 -fill x
501 set findtype Exact
502 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
503 findtype Exact IgnCase Regexp]
504 .ctop.top.bar.findtype configure -font $uifont
505 .ctop.top.bar.findtype.menu configure -font $uifont
506 set findloc "All fields"
507 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
508 Comments Author Committer Files Pickaxe
509 .ctop.top.bar.findloc configure -font $uifont
510 .ctop.top.bar.findloc.menu configure -font $uifont
512 pack .ctop.top.bar.findloc -side right
513 pack .ctop.top.bar.findtype -side right
514 # for making sure type==Exact whenever loc==Pickaxe
515 trace add variable findloc write findlocchange
517 label .ctop.top.lbar.flabel -text "Highlight: Commits touching paths:" \
518 -font $uifont
519 pack .ctop.top.lbar.flabel -side left -fill y
520 entry .ctop.top.lbar.fent -width 25 -font $textfont \
521 -textvariable highlight_files
522 trace add variable highlight_files write hfiles_change
523 lappend entries .ctop.top.lbar.fent
524 pack .ctop.top.lbar.fent -side left -fill x -expand 1
525 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
526 pack .ctop.top.lbar.vlabel -side left -fill y
527 global viewhlmenu selectedhlview
528 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
529 $viewhlmenu entryconf 0 -command delvhighlight
530 $viewhlmenu conf -font $uifont
531 .ctop.top.lbar.vhl conf -font $uifont
532 pack .ctop.top.lbar.vhl -side left -fill y
533 label .ctop.top.lbar.alabel -text " OR author/committer:" \
534 -font $uifont
535 pack .ctop.top.lbar.alabel -side left -fill y
536 entry .ctop.top.lbar.aent -width 20 -font $textfont \
537 -textvariable highlight_names
538 trace add variable highlight_names write hnames_change
539 lappend entries .ctop.top.lbar.aent
540 pack .ctop.top.lbar.aent -side right -fill x -expand 1
542 panedwindow .ctop.cdet -orient horizontal
543 .ctop add .ctop.cdet
544 frame .ctop.cdet.left
545 set ctext .ctop.cdet.left.ctext
546 text $ctext -bg white -state disabled -font $textfont \
547 -width $geometry(ctextw) -height $geometry(ctexth) \
548 -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
549 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
550 pack .ctop.cdet.left.sb -side right -fill y
551 pack $ctext -side left -fill both -expand 1
552 .ctop.cdet add .ctop.cdet.left
554 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
555 $ctext tag conf hunksep -fore blue
556 $ctext tag conf d0 -fore red
557 $ctext tag conf d1 -fore "#00a000"
558 $ctext tag conf m0 -fore red
559 $ctext tag conf m1 -fore blue
560 $ctext tag conf m2 -fore green
561 $ctext tag conf m3 -fore purple
562 $ctext tag conf m4 -fore brown
563 $ctext tag conf m5 -fore "#009090"
564 $ctext tag conf m6 -fore magenta
565 $ctext tag conf m7 -fore "#808000"
566 $ctext tag conf m8 -fore "#009000"
567 $ctext tag conf m9 -fore "#ff0080"
568 $ctext tag conf m10 -fore cyan
569 $ctext tag conf m11 -fore "#b07070"
570 $ctext tag conf m12 -fore "#70b0f0"
571 $ctext tag conf m13 -fore "#70f0b0"
572 $ctext tag conf m14 -fore "#f0b070"
573 $ctext tag conf m15 -fore "#ff70b0"
574 $ctext tag conf mmax -fore darkgrey
575 set mergemax 16
576 $ctext tag conf mresult -font [concat $textfont bold]
577 $ctext tag conf msep -font [concat $textfont bold]
578 $ctext tag conf found -back yellow
580 frame .ctop.cdet.right
581 frame .ctop.cdet.right.mode
582 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
583 -command reselectline -variable cmitmode -value "patch"
584 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
585 -command reselectline -variable cmitmode -value "tree"
586 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
587 pack .ctop.cdet.right.mode -side top -fill x
588 set cflist .ctop.cdet.right.cfiles
589 set indent [font measure $mainfont "nn"]
590 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
591 -tabs [list $indent [expr {2 * $indent}]] \
592 -yscrollcommand ".ctop.cdet.right.sb set" \
593 -cursor [. cget -cursor] \
594 -spacing1 1 -spacing3 1
595 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
596 pack .ctop.cdet.right.sb -side right -fill y
597 pack $cflist -side left -fill both -expand 1
598 $cflist tag configure highlight \
599 -background [$cflist cget -selectbackground]
600 $cflist tag configure bold -font [concat $mainfont bold]
601 .ctop.cdet add .ctop.cdet.right
602 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
604 pack .ctop -side top -fill both -expand 1
606 bindall <1> {selcanvline %W %x %y}
607 #bindall <B1-Motion> {selcanvline %W %x %y}
608 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
609 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
610 bindall <2> "canvscan mark %W %x %y"
611 bindall <B2-Motion> "canvscan dragto %W %x %y"
612 bindkey <Home> selfirstline
613 bindkey <End> sellastline
614 bind . <Key-Up> "selnextline -1"
615 bind . <Key-Down> "selnextline 1"
616 bindkey <Key-Right> "goforw"
617 bindkey <Key-Left> "goback"
618 bind . <Key-Prior> "selnextpage -1"
619 bind . <Key-Next> "selnextpage 1"
620 bind . <Control-Home> "allcanvs yview moveto 0.0"
621 bind . <Control-End> "allcanvs yview moveto 1.0"
622 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
623 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
624 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
625 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
626 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
627 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
628 bindkey <Key-space> "$ctext yview scroll 1 pages"
629 bindkey p "selnextline -1"
630 bindkey n "selnextline 1"
631 bindkey z "goback"
632 bindkey x "goforw"
633 bindkey i "selnextline -1"
634 bindkey k "selnextline 1"
635 bindkey j "goback"
636 bindkey l "goforw"
637 bindkey b "$ctext yview scroll -1 pages"
638 bindkey d "$ctext yview scroll 18 units"
639 bindkey u "$ctext yview scroll -18 units"
640 bindkey / {findnext 1}
641 bindkey <Key-Return> {findnext 0}
642 bindkey ? findprev
643 bindkey f nextfile
644 bind . <Control-q> doquit
645 bind . <Control-f> dofind
646 bind . <Control-g> {findnext 0}
647 bind . <Control-r> findprev
648 bind . <Control-equal> {incrfont 1}
649 bind . <Control-KP_Add> {incrfont 1}
650 bind . <Control-minus> {incrfont -1}
651 bind . <Control-KP_Subtract> {incrfont -1}
652 bind . <Destroy> {savestuff %W}
653 bind . <Button-1> "click %W"
654 bind $fstring <Key-Return> dofind
655 bind $sha1entry <Key-Return> gotocommit
656 bind $sha1entry <<PasteSelection>> clearsha1
657 bind $cflist <1> {sel_flist %W %x %y; break}
658 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
659 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
661 set maincursor [. cget -cursor]
662 set textcursor [$ctext cget -cursor]
663 set curtextcursor $textcursor
665 set rowctxmenu .rowctxmenu
666 menu $rowctxmenu -tearoff 0
667 $rowctxmenu add command -label "Diff this -> selected" \
668 -command {diffvssel 0}
669 $rowctxmenu add command -label "Diff selected -> this" \
670 -command {diffvssel 1}
671 $rowctxmenu add command -label "Make patch" -command mkpatch
672 $rowctxmenu add command -label "Create tag" -command mktag
673 $rowctxmenu add command -label "Write commit to file" -command writecommit
676 # mouse-2 makes all windows scan vertically, but only the one
677 # the cursor is in scans horizontally
678 proc canvscan {op w x y} {
679 global canv canv2 canv3
680 foreach c [list $canv $canv2 $canv3] {
681 if {$c == $w} {
682 $c scan $op $x $y
683 } else {
684 $c scan $op 0 $y
689 proc scrollcanv {cscroll f0 f1} {
690 $cscroll set $f0 $f1
691 drawfrac $f0 $f1
692 flushhighlights
695 # when we make a key binding for the toplevel, make sure
696 # it doesn't get triggered when that key is pressed in the
697 # find string entry widget.
698 proc bindkey {ev script} {
699 global entries
700 bind . $ev $script
701 set escript [bind Entry $ev]
702 if {$escript == {}} {
703 set escript [bind Entry <Key>]
705 foreach e $entries {
706 bind $e $ev "$escript; break"
710 # set the focus back to the toplevel for any click outside
711 # the entry widgets
712 proc click {w} {
713 global entries
714 foreach e $entries {
715 if {$w == $e} return
717 focus .
720 proc savestuff {w} {
721 global canv canv2 canv3 ctext cflist mainfont textfont uifont
722 global stuffsaved findmergefiles maxgraphpct
723 global maxwidth
724 global viewname viewfiles viewargs viewperm nextviewnum
725 global cmitmode
727 if {$stuffsaved} return
728 if {![winfo viewable .]} return
729 catch {
730 set f [open "~/.gitk-new" w]
731 puts $f [list set mainfont $mainfont]
732 puts $f [list set textfont $textfont]
733 puts $f [list set uifont $uifont]
734 puts $f [list set findmergefiles $findmergefiles]
735 puts $f [list set maxgraphpct $maxgraphpct]
736 puts $f [list set maxwidth $maxwidth]
737 puts $f [list set cmitmode $cmitmode]
738 puts $f "set geometry(width) [winfo width .ctop]"
739 puts $f "set geometry(height) [winfo height .ctop]"
740 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
741 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
742 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
743 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
744 set wid [expr {([winfo width $ctext] - 8) \
745 / [font measure $textfont "0"]}]
746 puts $f "set geometry(ctextw) $wid"
747 set wid [expr {([winfo width $cflist] - 11) \
748 / [font measure [$cflist cget -font] "0"]}]
749 puts $f "set geometry(cflistw) $wid"
750 puts -nonewline $f "set permviews {"
751 for {set v 0} {$v < $nextviewnum} {incr v} {
752 if {$viewperm($v)} {
753 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
756 puts $f "}"
757 close $f
758 file rename -force "~/.gitk-new" "~/.gitk"
760 set stuffsaved 1
763 proc resizeclistpanes {win w} {
764 global oldwidth
765 if {[info exists oldwidth($win)]} {
766 set s0 [$win sash coord 0]
767 set s1 [$win sash coord 1]
768 if {$w < 60} {
769 set sash0 [expr {int($w/2 - 2)}]
770 set sash1 [expr {int($w*5/6 - 2)}]
771 } else {
772 set factor [expr {1.0 * $w / $oldwidth($win)}]
773 set sash0 [expr {int($factor * [lindex $s0 0])}]
774 set sash1 [expr {int($factor * [lindex $s1 0])}]
775 if {$sash0 < 30} {
776 set sash0 30
778 if {$sash1 < $sash0 + 20} {
779 set sash1 [expr {$sash0 + 20}]
781 if {$sash1 > $w - 10} {
782 set sash1 [expr {$w - 10}]
783 if {$sash0 > $sash1 - 20} {
784 set sash0 [expr {$sash1 - 20}]
788 $win sash place 0 $sash0 [lindex $s0 1]
789 $win sash place 1 $sash1 [lindex $s1 1]
791 set oldwidth($win) $w
794 proc resizecdetpanes {win w} {
795 global oldwidth
796 if {[info exists oldwidth($win)]} {
797 set s0 [$win sash coord 0]
798 if {$w < 60} {
799 set sash0 [expr {int($w*3/4 - 2)}]
800 } else {
801 set factor [expr {1.0 * $w / $oldwidth($win)}]
802 set sash0 [expr {int($factor * [lindex $s0 0])}]
803 if {$sash0 < 45} {
804 set sash0 45
806 if {$sash0 > $w - 15} {
807 set sash0 [expr {$w - 15}]
810 $win sash place 0 $sash0 [lindex $s0 1]
812 set oldwidth($win) $w
815 proc allcanvs args {
816 global canv canv2 canv3
817 eval $canv $args
818 eval $canv2 $args
819 eval $canv3 $args
822 proc bindall {event action} {
823 global canv canv2 canv3
824 bind $canv $event $action
825 bind $canv2 $event $action
826 bind $canv3 $event $action
829 proc about {} {
830 set w .about
831 if {[winfo exists $w]} {
832 raise $w
833 return
835 toplevel $w
836 wm title $w "About gitk"
837 message $w.m -text {
838 Gitk - a commit viewer for git
840 Copyright © 2005-2006 Paul Mackerras
842 Use and redistribute under the terms of the GNU General Public License} \
843 -justify center -aspect 400
844 pack $w.m -side top -fill x -padx 20 -pady 20
845 button $w.ok -text Close -command "destroy $w"
846 pack $w.ok -side bottom
849 proc keys {} {
850 set w .keys
851 if {[winfo exists $w]} {
852 raise $w
853 return
855 toplevel $w
856 wm title $w "Gitk key bindings"
857 message $w.m -text {
858 Gitk key bindings:
860 <Ctrl-Q> Quit
861 <Home> Move to first commit
862 <End> Move to last commit
863 <Up>, p, i Move up one commit
864 <Down>, n, k Move down one commit
865 <Left>, z, j Go back in history list
866 <Right>, x, l Go forward in history list
867 <PageUp> Move up one page in commit list
868 <PageDown> Move down one page in commit list
869 <Ctrl-Home> Scroll to top of commit list
870 <Ctrl-End> Scroll to bottom of commit list
871 <Ctrl-Up> Scroll commit list up one line
872 <Ctrl-Down> Scroll commit list down one line
873 <Ctrl-PageUp> Scroll commit list up one page
874 <Ctrl-PageDown> Scroll commit list down one page
875 <Delete>, b Scroll diff view up one page
876 <Backspace> Scroll diff view up one page
877 <Space> Scroll diff view down one page
878 u Scroll diff view up 18 lines
879 d Scroll diff view down 18 lines
880 <Ctrl-F> Find
881 <Ctrl-G> Move to next find hit
882 <Ctrl-R> Move to previous find hit
883 <Return> Move to next find hit
884 / Move to next find hit, or redo find
885 ? Move to previous find hit
886 f Scroll diff view to next file
887 <Ctrl-KP+> Increase font size
888 <Ctrl-plus> Increase font size
889 <Ctrl-KP-> Decrease font size
890 <Ctrl-minus> Decrease font size
892 -justify left -bg white -border 2 -relief sunken
893 pack $w.m -side top -fill both
894 button $w.ok -text Close -command "destroy $w"
895 pack $w.ok -side bottom
898 # Procedures for manipulating the file list window at the
899 # bottom right of the overall window.
901 proc treeview {w l openlevs} {
902 global treecontents treediropen treeheight treeparent treeindex
904 set ix 0
905 set treeindex() 0
906 set lev 0
907 set prefix {}
908 set prefixend -1
909 set prefendstack {}
910 set htstack {}
911 set ht 0
912 set treecontents() {}
913 $w conf -state normal
914 foreach f $l {
915 while {[string range $f 0 $prefixend] ne $prefix} {
916 if {$lev <= $openlevs} {
917 $w mark set e:$treeindex($prefix) "end -1c"
918 $w mark gravity e:$treeindex($prefix) left
920 set treeheight($prefix) $ht
921 incr ht [lindex $htstack end]
922 set htstack [lreplace $htstack end end]
923 set prefixend [lindex $prefendstack end]
924 set prefendstack [lreplace $prefendstack end end]
925 set prefix [string range $prefix 0 $prefixend]
926 incr lev -1
928 set tail [string range $f [expr {$prefixend+1}] end]
929 while {[set slash [string first "/" $tail]] >= 0} {
930 lappend htstack $ht
931 set ht 0
932 lappend prefendstack $prefixend
933 incr prefixend [expr {$slash + 1}]
934 set d [string range $tail 0 $slash]
935 lappend treecontents($prefix) $d
936 set oldprefix $prefix
937 append prefix $d
938 set treecontents($prefix) {}
939 set treeindex($prefix) [incr ix]
940 set treeparent($prefix) $oldprefix
941 set tail [string range $tail [expr {$slash+1}] end]
942 if {$lev <= $openlevs} {
943 set ht 1
944 set treediropen($prefix) [expr {$lev < $openlevs}]
945 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
946 $w mark set d:$ix "end -1c"
947 $w mark gravity d:$ix left
948 set str "\n"
949 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
950 $w insert end $str
951 $w image create end -align center -image $bm -padx 1 \
952 -name a:$ix
953 $w insert end $d [highlight_tag $prefix]
954 $w mark set s:$ix "end -1c"
955 $w mark gravity s:$ix left
957 incr lev
959 if {$tail ne {}} {
960 if {$lev <= $openlevs} {
961 incr ht
962 set str "\n"
963 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
964 $w insert end $str
965 $w insert end $tail [highlight_tag $f]
967 lappend treecontents($prefix) $tail
970 while {$htstack ne {}} {
971 set treeheight($prefix) $ht
972 incr ht [lindex $htstack end]
973 set htstack [lreplace $htstack end end]
975 $w conf -state disabled
978 proc linetoelt {l} {
979 global treeheight treecontents
981 set y 2
982 set prefix {}
983 while {1} {
984 foreach e $treecontents($prefix) {
985 if {$y == $l} {
986 return "$prefix$e"
988 set n 1
989 if {[string index $e end] eq "/"} {
990 set n $treeheight($prefix$e)
991 if {$y + $n > $l} {
992 append prefix $e
993 incr y
994 break
997 incr y $n
1002 proc highlight_tree {y prefix} {
1003 global treeheight treecontents cflist
1005 foreach e $treecontents($prefix) {
1006 set path $prefix$e
1007 if {[highlight_tag $path] ne {}} {
1008 $cflist tag add bold $y.0 "$y.0 lineend"
1010 incr y
1011 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1012 set y [highlight_tree $y $path]
1015 return $y
1018 proc treeclosedir {w dir} {
1019 global treediropen treeheight treeparent treeindex
1021 set ix $treeindex($dir)
1022 $w conf -state normal
1023 $w delete s:$ix e:$ix
1024 set treediropen($dir) 0
1025 $w image configure a:$ix -image tri-rt
1026 $w conf -state disabled
1027 set n [expr {1 - $treeheight($dir)}]
1028 while {$dir ne {}} {
1029 incr treeheight($dir) $n
1030 set dir $treeparent($dir)
1034 proc treeopendir {w dir} {
1035 global treediropen treeheight treeparent treecontents treeindex
1037 set ix $treeindex($dir)
1038 $w conf -state normal
1039 $w image configure a:$ix -image tri-dn
1040 $w mark set e:$ix s:$ix
1041 $w mark gravity e:$ix right
1042 set lev 0
1043 set str "\n"
1044 set n [llength $treecontents($dir)]
1045 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1046 incr lev
1047 append str "\t"
1048 incr treeheight($x) $n
1050 foreach e $treecontents($dir) {
1051 set de $dir$e
1052 if {[string index $e end] eq "/"} {
1053 set iy $treeindex($de)
1054 $w mark set d:$iy e:$ix
1055 $w mark gravity d:$iy left
1056 $w insert e:$ix $str
1057 set treediropen($de) 0
1058 $w image create e:$ix -align center -image tri-rt -padx 1 \
1059 -name a:$iy
1060 $w insert e:$ix $e [highlight_tag $de]
1061 $w mark set s:$iy e:$ix
1062 $w mark gravity s:$iy left
1063 set treeheight($de) 1
1064 } else {
1065 $w insert e:$ix $str
1066 $w insert e:$ix $e [highlight_tag $de]
1069 $w mark gravity e:$ix left
1070 $w conf -state disabled
1071 set treediropen($dir) 1
1072 set top [lindex [split [$w index @0,0] .] 0]
1073 set ht [$w cget -height]
1074 set l [lindex [split [$w index s:$ix] .] 0]
1075 if {$l < $top} {
1076 $w yview $l.0
1077 } elseif {$l + $n + 1 > $top + $ht} {
1078 set top [expr {$l + $n + 2 - $ht}]
1079 if {$l < $top} {
1080 set top $l
1082 $w yview $top.0
1086 proc treeclick {w x y} {
1087 global treediropen cmitmode ctext cflist cflist_top
1089 if {$cmitmode ne "tree"} return
1090 if {![info exists cflist_top]} return
1091 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1092 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1093 $cflist tag add highlight $l.0 "$l.0 lineend"
1094 set cflist_top $l
1095 if {$l == 1} {
1096 $ctext yview 1.0
1097 return
1099 set e [linetoelt $l]
1100 if {[string index $e end] ne "/"} {
1101 showfile $e
1102 } elseif {$treediropen($e)} {
1103 treeclosedir $w $e
1104 } else {
1105 treeopendir $w $e
1109 proc setfilelist {id} {
1110 global treefilelist cflist
1112 treeview $cflist $treefilelist($id) 0
1115 image create bitmap tri-rt -background black -foreground blue -data {
1116 #define tri-rt_width 13
1117 #define tri-rt_height 13
1118 static unsigned char tri-rt_bits[] = {
1119 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1120 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1121 0x00, 0x00};
1122 } -maskdata {
1123 #define tri-rt-mask_width 13
1124 #define tri-rt-mask_height 13
1125 static unsigned char tri-rt-mask_bits[] = {
1126 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1127 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1128 0x08, 0x00};
1130 image create bitmap tri-dn -background black -foreground blue -data {
1131 #define tri-dn_width 13
1132 #define tri-dn_height 13
1133 static unsigned char tri-dn_bits[] = {
1134 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1135 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1136 0x00, 0x00};
1137 } -maskdata {
1138 #define tri-dn-mask_width 13
1139 #define tri-dn-mask_height 13
1140 static unsigned char tri-dn-mask_bits[] = {
1141 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1142 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1143 0x00, 0x00};
1146 proc init_flist {first} {
1147 global cflist cflist_top selectedline difffilestart
1149 $cflist conf -state normal
1150 $cflist delete 0.0 end
1151 if {$first ne {}} {
1152 $cflist insert end $first
1153 set cflist_top 1
1154 $cflist tag add highlight 1.0 "1.0 lineend"
1155 } else {
1156 catch {unset cflist_top}
1158 $cflist conf -state disabled
1159 set difffilestart {}
1162 proc highlight_tag {f} {
1163 global highlight_paths
1165 foreach p $highlight_paths {
1166 if {[string match $p $f]} {
1167 return "bold"
1170 return {}
1173 proc highlight_filelist {} {
1174 global cmitmode cflist
1176 $cflist conf -state normal
1177 if {$cmitmode ne "tree"} {
1178 set end [lindex [split [$cflist index end] .] 0]
1179 for {set l 2} {$l < $end} {incr l} {
1180 set line [$cflist get $l.0 "$l.0 lineend"]
1181 if {[highlight_tag $line] ne {}} {
1182 $cflist tag add bold $l.0 "$l.0 lineend"
1185 } else {
1186 highlight_tree 2 {}
1188 $cflist conf -state disabled
1191 proc unhighlight_filelist {} {
1192 global cflist
1194 $cflist conf -state normal
1195 $cflist tag remove bold 1.0 end
1196 $cflist conf -state disabled
1199 proc add_flist {fl} {
1200 global cflist
1202 $cflist conf -state normal
1203 foreach f $fl {
1204 $cflist insert end "\n"
1205 $cflist insert end $f [highlight_tag $f]
1207 $cflist conf -state disabled
1210 proc sel_flist {w x y} {
1211 global ctext difffilestart cflist cflist_top cmitmode
1213 if {$cmitmode eq "tree"} return
1214 if {![info exists cflist_top]} return
1215 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1216 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1217 $cflist tag add highlight $l.0 "$l.0 lineend"
1218 set cflist_top $l
1219 if {$l == 1} {
1220 $ctext yview 1.0
1221 } else {
1222 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1226 # Functions for adding and removing shell-type quoting
1228 proc shellquote {str} {
1229 if {![string match "*\['\"\\ \t]*" $str]} {
1230 return $str
1232 if {![string match "*\['\"\\]*" $str]} {
1233 return "\"$str\""
1235 if {![string match "*'*" $str]} {
1236 return "'$str'"
1238 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1241 proc shellarglist {l} {
1242 set str {}
1243 foreach a $l {
1244 if {$str ne {}} {
1245 append str " "
1247 append str [shellquote $a]
1249 return $str
1252 proc shelldequote {str} {
1253 set ret {}
1254 set used -1
1255 while {1} {
1256 incr used
1257 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1258 append ret [string range $str $used end]
1259 set used [string length $str]
1260 break
1262 set first [lindex $first 0]
1263 set ch [string index $str $first]
1264 if {$first > $used} {
1265 append ret [string range $str $used [expr {$first - 1}]]
1266 set used $first
1268 if {$ch eq " " || $ch eq "\t"} break
1269 incr used
1270 if {$ch eq "'"} {
1271 set first [string first "'" $str $used]
1272 if {$first < 0} {
1273 error "unmatched single-quote"
1275 append ret [string range $str $used [expr {$first - 1}]]
1276 set used $first
1277 continue
1279 if {$ch eq "\\"} {
1280 if {$used >= [string length $str]} {
1281 error "trailing backslash"
1283 append ret [string index $str $used]
1284 continue
1286 # here ch == "\""
1287 while {1} {
1288 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1289 error "unmatched double-quote"
1291 set first [lindex $first 0]
1292 set ch [string index $str $first]
1293 if {$first > $used} {
1294 append ret [string range $str $used [expr {$first - 1}]]
1295 set used $first
1297 if {$ch eq "\""} break
1298 incr used
1299 append ret [string index $str $used]
1300 incr used
1303 return [list $used $ret]
1306 proc shellsplit {str} {
1307 set l {}
1308 while {1} {
1309 set str [string trimleft $str]
1310 if {$str eq {}} break
1311 set dq [shelldequote $str]
1312 set n [lindex $dq 0]
1313 set word [lindex $dq 1]
1314 set str [string range $str $n end]
1315 lappend l $word
1317 return $l
1320 # Code to implement multiple views
1322 proc newview {ishighlight} {
1323 global nextviewnum newviewname newviewperm uifont newishighlight
1324 global newviewargs revtreeargs
1326 set newishighlight $ishighlight
1327 set top .gitkview
1328 if {[winfo exists $top]} {
1329 raise $top
1330 return
1332 set newviewname($nextviewnum) "View $nextviewnum"
1333 set newviewperm($nextviewnum) 0
1334 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1335 vieweditor $top $nextviewnum "Gitk view definition"
1338 proc editview {} {
1339 global curview
1340 global viewname viewperm newviewname newviewperm
1341 global viewargs newviewargs
1343 set top .gitkvedit-$curview
1344 if {[winfo exists $top]} {
1345 raise $top
1346 return
1348 set newviewname($curview) $viewname($curview)
1349 set newviewperm($curview) $viewperm($curview)
1350 set newviewargs($curview) [shellarglist $viewargs($curview)]
1351 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1354 proc vieweditor {top n title} {
1355 global newviewname newviewperm viewfiles
1356 global uifont
1358 toplevel $top
1359 wm title $top $title
1360 label $top.nl -text "Name" -font $uifont
1361 entry $top.name -width 20 -textvariable newviewname($n)
1362 grid $top.nl $top.name -sticky w -pady 5
1363 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1364 grid $top.perm - -pady 5 -sticky w
1365 message $top.al -aspect 1000 -font $uifont \
1366 -text "Commits to include (arguments to git-rev-list):"
1367 grid $top.al - -sticky w -pady 5
1368 entry $top.args -width 50 -textvariable newviewargs($n) \
1369 -background white
1370 grid $top.args - -sticky ew -padx 5
1371 message $top.l -aspect 1000 -font $uifont \
1372 -text "Enter files and directories to include, one per line:"
1373 grid $top.l - -sticky w
1374 text $top.t -width 40 -height 10 -background white
1375 if {[info exists viewfiles($n)]} {
1376 foreach f $viewfiles($n) {
1377 $top.t insert end $f
1378 $top.t insert end "\n"
1380 $top.t delete {end - 1c} end
1381 $top.t mark set insert 0.0
1383 grid $top.t - -sticky ew -padx 5
1384 frame $top.buts
1385 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1386 button $top.buts.can -text "Cancel" -command [list destroy $top]
1387 grid $top.buts.ok $top.buts.can
1388 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1389 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1390 grid $top.buts - -pady 10 -sticky ew
1391 focus $top.t
1394 proc doviewmenu {m first cmd op argv} {
1395 set nmenu [$m index end]
1396 for {set i $first} {$i <= $nmenu} {incr i} {
1397 if {[$m entrycget $i -command] eq $cmd} {
1398 eval $m $op $i $argv
1399 break
1404 proc allviewmenus {n op args} {
1405 global viewhlmenu
1407 doviewmenu .bar.view 7 [list showview $n] $op $args
1408 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1411 proc newviewok {top n} {
1412 global nextviewnum newviewperm newviewname newishighlight
1413 global viewname viewfiles viewperm selectedview curview
1414 global viewargs newviewargs viewhlmenu
1416 if {[catch {
1417 set newargs [shellsplit $newviewargs($n)]
1418 } err]} {
1419 error_popup "Error in commit selection arguments: $err"
1420 wm raise $top
1421 focus $top
1422 return
1424 set files {}
1425 foreach f [split [$top.t get 0.0 end] "\n"] {
1426 set ft [string trim $f]
1427 if {$ft ne {}} {
1428 lappend files $ft
1431 if {![info exists viewfiles($n)]} {
1432 # creating a new view
1433 incr nextviewnum
1434 set viewname($n) $newviewname($n)
1435 set viewperm($n) $newviewperm($n)
1436 set viewfiles($n) $files
1437 set viewargs($n) $newargs
1438 addviewmenu $n
1439 if {!$newishighlight} {
1440 after idle showview $n
1441 } else {
1442 after idle addvhighlight $n
1444 } else {
1445 # editing an existing view
1446 set viewperm($n) $newviewperm($n)
1447 if {$newviewname($n) ne $viewname($n)} {
1448 set viewname($n) $newviewname($n)
1449 doviewmenu .bar.view 7 [list showview $n] \
1450 entryconf [list -label $viewname($n)]
1451 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1452 entryconf [list -label $viewname($n) -value $viewname($n)]
1454 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1455 set viewfiles($n) $files
1456 set viewargs($n) $newargs
1457 if {$curview == $n} {
1458 after idle updatecommits
1462 catch {destroy $top}
1465 proc delview {} {
1466 global curview viewdata viewperm hlview selectedhlview
1468 if {$curview == 0} return
1469 if {[info exists hlview] && $hlview == $curview} {
1470 set selectedhlview None
1471 unset hlview
1473 allviewmenus $curview delete
1474 set viewdata($curview) {}
1475 set viewperm($curview) 0
1476 showview 0
1479 proc addviewmenu {n} {
1480 global viewname viewhlmenu
1482 .bar.view add radiobutton -label $viewname($n) \
1483 -command [list showview $n] -variable selectedview -value $n
1484 $viewhlmenu add radiobutton -label $viewname($n) \
1485 -command [list addvhighlight $n] -variable selectedhlview
1488 proc flatten {var} {
1489 global $var
1491 set ret {}
1492 foreach i [array names $var] {
1493 lappend ret $i [set $var\($i\)]
1495 return $ret
1498 proc unflatten {var l} {
1499 global $var
1501 catch {unset $var}
1502 foreach {i v} $l {
1503 set $var\($i\) $v
1507 proc showview {n} {
1508 global curview viewdata viewfiles
1509 global displayorder parentlist childlist rowidlist rowoffsets
1510 global colormap rowtextx commitrow nextcolor canvxmax
1511 global numcommits rowrangelist commitlisted idrowranges
1512 global selectedline currentid canv canvy0
1513 global matchinglines treediffs
1514 global pending_select phase
1515 global commitidx rowlaidout rowoptim linesegends
1516 global commfd nextupdate
1517 global selectedview
1518 global vparentlist vchildlist vdisporder vcmitlisted
1519 global hlview selectedhlview
1521 if {$n == $curview} return
1522 set selid {}
1523 if {[info exists selectedline]} {
1524 set selid $currentid
1525 set y [yc $selectedline]
1526 set ymax [lindex [$canv cget -scrollregion] 3]
1527 set span [$canv yview]
1528 set ytop [expr {[lindex $span 0] * $ymax}]
1529 set ybot [expr {[lindex $span 1] * $ymax}]
1530 if {$ytop < $y && $y < $ybot} {
1531 set yscreen [expr {$y - $ytop}]
1532 } else {
1533 set yscreen [expr {($ybot - $ytop) / 2}]
1536 unselectline
1537 normalline
1538 stopfindproc
1539 if {$curview >= 0} {
1540 set vparentlist($curview) $parentlist
1541 set vchildlist($curview) $childlist
1542 set vdisporder($curview) $displayorder
1543 set vcmitlisted($curview) $commitlisted
1544 if {$phase ne {}} {
1545 set viewdata($curview) \
1546 [list $phase $rowidlist $rowoffsets $rowrangelist \
1547 [flatten idrowranges] [flatten idinlist] \
1548 $rowlaidout $rowoptim $numcommits $linesegends]
1549 } elseif {![info exists viewdata($curview)]
1550 || [lindex $viewdata($curview) 0] ne {}} {
1551 set viewdata($curview) \
1552 [list {} $rowidlist $rowoffsets $rowrangelist]
1555 catch {unset matchinglines}
1556 catch {unset treediffs}
1557 clear_display
1558 if {[info exists hlview] && $hlview == $n} {
1559 unset hlview
1560 set selectedhlview None
1563 set curview $n
1564 set selectedview $n
1565 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1566 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1568 if {![info exists viewdata($n)]} {
1569 set pending_select $selid
1570 getcommits
1571 return
1574 set v $viewdata($n)
1575 set phase [lindex $v 0]
1576 set displayorder $vdisporder($n)
1577 set parentlist $vparentlist($n)
1578 set childlist $vchildlist($n)
1579 set commitlisted $vcmitlisted($n)
1580 set rowidlist [lindex $v 1]
1581 set rowoffsets [lindex $v 2]
1582 set rowrangelist [lindex $v 3]
1583 if {$phase eq {}} {
1584 set numcommits [llength $displayorder]
1585 catch {unset idrowranges}
1586 } else {
1587 unflatten idrowranges [lindex $v 4]
1588 unflatten idinlist [lindex $v 5]
1589 set rowlaidout [lindex $v 6]
1590 set rowoptim [lindex $v 7]
1591 set numcommits [lindex $v 8]
1592 set linesegends [lindex $v 9]
1595 catch {unset colormap}
1596 catch {unset rowtextx}
1597 set nextcolor 0
1598 set canvxmax [$canv cget -width]
1599 set curview $n
1600 set row 0
1601 setcanvscroll
1602 set yf 0
1603 set row 0
1604 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1605 set row $commitrow($n,$selid)
1606 # try to get the selected row in the same position on the screen
1607 set ymax [lindex [$canv cget -scrollregion] 3]
1608 set ytop [expr {[yc $row] - $yscreen}]
1609 if {$ytop < 0} {
1610 set ytop 0
1612 set yf [expr {$ytop * 1.0 / $ymax}]
1614 allcanvs yview moveto $yf
1615 drawvisible
1616 selectline $row 0
1617 if {$phase ne {}} {
1618 if {$phase eq "getcommits"} {
1619 show_status "Reading commits..."
1621 if {[info exists commfd($n)]} {
1622 layoutmore
1623 } else {
1624 finishcommits
1626 } elseif {$numcommits == 0} {
1627 show_status "No commits selected"
1631 # Stuff relating to the highlighting facility
1633 proc ishighlighted {row} {
1634 global vhighlights fhighlights nhighlights
1636 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1637 return $nhighlights($row)
1639 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1640 return $vhighlights($row)
1642 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1643 return $fhighlights($row)
1645 return 0
1648 proc bolden {row font} {
1649 global canv linehtag selectedline
1651 $canv itemconf $linehtag($row) -font $font
1652 if {$row == $selectedline} {
1653 $canv delete secsel
1654 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1655 -outline {{}} -tags secsel \
1656 -fill [$canv cget -selectbackground]]
1657 $canv lower $t
1661 proc bolden_name {row font} {
1662 global canv2 linentag selectedline
1664 $canv2 itemconf $linentag($row) -font $font
1665 if {$row == $selectedline} {
1666 $canv2 delete secsel
1667 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1668 -outline {{}} -tags secsel \
1669 -fill [$canv2 cget -selectbackground]]
1670 $canv2 lower $t
1674 proc unbolden {rows} {
1675 global mainfont
1677 foreach row $rows {
1678 if {![ishighlighted $row]} {
1679 bolden $row $mainfont
1684 proc addvhighlight {n} {
1685 global hlview curview viewdata vhl_done vhighlights commitidx
1687 if {[info exists hlview]} {
1688 delvhighlight
1690 set hlview $n
1691 if {$n != $curview && ![info exists viewdata($n)]} {
1692 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1693 set vparentlist($n) {}
1694 set vchildlist($n) {}
1695 set vdisporder($n) {}
1696 set vcmitlisted($n) {}
1697 start_rev_list $n
1699 set vhl_done $commitidx($hlview)
1700 if {$vhl_done > 0} {
1701 drawvisible
1705 proc delvhighlight {} {
1706 global hlview vhighlights
1707 global selectedline
1709 if {![info exists hlview]} return
1710 unset hlview
1711 set rows [array names vhighlights]
1712 if {$rows ne {}} {
1713 unset vhighlights
1714 unbolden $rows
1718 proc vhighlightmore {} {
1719 global hlview vhl_done commitidx vhighlights
1720 global displayorder vdisporder curview mainfont
1722 set font [concat $mainfont bold]
1723 set max $commitidx($hlview)
1724 if {$hlview == $curview} {
1725 set disp $displayorder
1726 } else {
1727 set disp $vdisporder($hlview)
1729 set vr [visiblerows]
1730 set r0 [lindex $vr 0]
1731 set r1 [lindex $vr 1]
1732 for {set i $vhl_done} {$i < $max} {incr i} {
1733 set id [lindex $disp $i]
1734 if {[info exists commitrow($curview,$id)]} {
1735 set row $commitrow($curview,$id)
1736 if {$r0 <= $row && $row <= $r1} {
1737 if {![highlighted $row]} {
1738 bolden $row $font
1740 set vhighlights($row) 1
1744 set vhl_done $max
1747 proc askvhighlight {row id} {
1748 global hlview vhighlights commitrow iddrawn mainfont
1750 if {[info exists commitrow($hlview,$id)]} {
1751 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1752 bolden $row [concat $mainfont bold]
1754 set vhighlights($row) 1
1755 } else {
1756 set vhighlights($row) 0
1760 proc hfiles_change {name ix op} {
1761 global highlight_files filehighlight fhighlights fh_serial
1762 global mainfont highlight_paths
1764 if {[info exists filehighlight]} {
1765 # delete previous highlights
1766 catch {close $filehighlight}
1767 unset filehighlight
1768 set rows [array names fhighlights]
1769 if {$rows ne {}} {
1770 unset fhighlights
1771 unbolden $rows
1773 unhighlight_filelist
1775 set highlight_paths {}
1776 after cancel do_file_hl $fh_serial
1777 incr fh_serial
1778 if {$highlight_files ne {}} {
1779 after 300 do_file_hl $fh_serial
1783 proc makepatterns {l} {
1784 set ret {}
1785 foreach e $l {
1786 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1787 if {[string index $ee end] eq "/"} {
1788 lappend ret "$ee*"
1789 } else {
1790 lappend ret $ee
1791 lappend ret "$ee/*"
1794 return $ret
1797 proc do_file_hl {serial} {
1798 global highlight_files filehighlight highlight_paths
1800 if {[catch {set paths [shellsplit $highlight_files]}]} return
1801 set highlight_paths [makepatterns $paths]
1802 highlight_filelist
1803 set cmd [concat | git-diff-tree -r -s --stdin -- $paths]
1804 set filehighlight [open $cmd r+]
1805 fconfigure $filehighlight -blocking 0
1806 fileevent $filehighlight readable readfhighlight
1807 drawvisible
1808 flushhighlights
1811 proc flushhighlights {} {
1812 global filehighlight
1814 if {[info exists filehighlight]} {
1815 puts $filehighlight ""
1816 flush $filehighlight
1820 proc askfilehighlight {row id} {
1821 global filehighlight fhighlights
1823 set fhighlights($row) 0
1824 puts $filehighlight $id
1827 proc readfhighlight {} {
1828 global filehighlight fhighlights commitrow curview mainfont iddrawn
1830 set n [gets $filehighlight line]
1831 if {$n < 0} {
1832 if {[eof $filehighlight]} {
1833 # strange...
1834 puts "oops, git-diff-tree died"
1835 catch {close $filehighlight}
1836 unset filehighlight
1838 return
1840 set line [string trim $line]
1841 if {$line eq {}} return
1842 if {![info exists commitrow($curview,$line)]} return
1843 set row $commitrow($curview,$line)
1844 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1845 bolden $row [concat $mainfont bold]
1847 set fhighlights($row) 1
1850 proc hnames_change {name ix op} {
1851 global highlight_names nhighlights nhl_names mainfont
1853 # delete previous highlights, if any
1854 set rows [array names nhighlights]
1855 if {$rows ne {}} {
1856 foreach row $rows {
1857 if {$nhighlights($row) >= 2} {
1858 bolden_name $row $mainfont
1861 unset nhighlights
1862 unbolden $rows
1864 if {[catch {set nhl_names [shellsplit $highlight_names]}]} {
1865 set nhl_names {}
1866 return
1868 drawvisible
1871 proc asknamehighlight {row id} {
1872 global nhl_names nhighlights commitinfo iddrawn mainfont
1874 if {![info exists commitinfo($id)]} {
1875 getcommit $id
1877 set isbold 0
1878 set author [lindex $commitinfo($id) 1]
1879 set committer [lindex $commitinfo($id) 3]
1880 foreach name $nhl_names {
1881 set pattern "*$name*"
1882 if {[string match -nocase $pattern $author]} {
1883 set isbold 2
1884 break
1886 if {!$isbold && [string match -nocase $pattern $committer]} {
1887 set isbold 1
1890 if {[info exists iddrawn($id)]} {
1891 if {$isbold && ![ishighlighted $row]} {
1892 bolden $row [concat $mainfont bold]
1894 if {$isbold >= 2} {
1895 bolden_name $row [concat $mainfont bold]
1898 set nhighlights($row) $isbold
1901 # Graph layout functions
1903 proc shortids {ids} {
1904 set res {}
1905 foreach id $ids {
1906 if {[llength $id] > 1} {
1907 lappend res [shortids $id]
1908 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1909 lappend res [string range $id 0 7]
1910 } else {
1911 lappend res $id
1914 return $res
1917 proc incrange {l x o} {
1918 set n [llength $l]
1919 while {$x < $n} {
1920 set e [lindex $l $x]
1921 if {$e ne {}} {
1922 lset l $x [expr {$e + $o}]
1924 incr x
1926 return $l
1929 proc ntimes {n o} {
1930 set ret {}
1931 for {} {$n > 0} {incr n -1} {
1932 lappend ret $o
1934 return $ret
1937 proc usedinrange {id l1 l2} {
1938 global children commitrow childlist curview
1940 if {[info exists commitrow($curview,$id)]} {
1941 set r $commitrow($curview,$id)
1942 if {$l1 <= $r && $r <= $l2} {
1943 return [expr {$r - $l1 + 1}]
1945 set kids [lindex $childlist $r]
1946 } else {
1947 set kids $children($curview,$id)
1949 foreach c $kids {
1950 set r $commitrow($curview,$c)
1951 if {$l1 <= $r && $r <= $l2} {
1952 return [expr {$r - $l1 + 1}]
1955 return 0
1958 proc sanity {row {full 0}} {
1959 global rowidlist rowoffsets
1961 set col -1
1962 set ids [lindex $rowidlist $row]
1963 foreach id $ids {
1964 incr col
1965 if {$id eq {}} continue
1966 if {$col < [llength $ids] - 1 &&
1967 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1968 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1970 set o [lindex $rowoffsets $row $col]
1971 set y $row
1972 set x $col
1973 while {$o ne {}} {
1974 incr y -1
1975 incr x $o
1976 if {[lindex $rowidlist $y $x] != $id} {
1977 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1978 puts " id=[shortids $id] check started at row $row"
1979 for {set i $row} {$i >= $y} {incr i -1} {
1980 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1982 break
1984 if {!$full} break
1985 set o [lindex $rowoffsets $y $x]
1990 proc makeuparrow {oid x y z} {
1991 global rowidlist rowoffsets uparrowlen idrowranges
1993 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1994 incr y -1
1995 incr x $z
1996 set off0 [lindex $rowoffsets $y]
1997 for {set x0 $x} {1} {incr x0} {
1998 if {$x0 >= [llength $off0]} {
1999 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2000 break
2002 set z [lindex $off0 $x0]
2003 if {$z ne {}} {
2004 incr x0 $z
2005 break
2008 set z [expr {$x0 - $x}]
2009 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2010 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2012 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2013 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2014 lappend idrowranges($oid) $y
2017 proc initlayout {} {
2018 global rowidlist rowoffsets displayorder commitlisted
2019 global rowlaidout rowoptim
2020 global idinlist rowchk rowrangelist idrowranges
2021 global numcommits canvxmax canv
2022 global nextcolor
2023 global parentlist childlist children
2024 global colormap rowtextx
2025 global linesegends
2027 set numcommits 0
2028 set displayorder {}
2029 set commitlisted {}
2030 set parentlist {}
2031 set childlist {}
2032 set rowrangelist {}
2033 set nextcolor 0
2034 set rowidlist {{}}
2035 set rowoffsets {{}}
2036 catch {unset idinlist}
2037 catch {unset rowchk}
2038 set rowlaidout 0
2039 set rowoptim 0
2040 set canvxmax [$canv cget -width]
2041 catch {unset colormap}
2042 catch {unset rowtextx}
2043 catch {unset idrowranges}
2044 set linesegends {}
2047 proc setcanvscroll {} {
2048 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2050 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2051 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2052 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2053 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2056 proc visiblerows {} {
2057 global canv numcommits linespc
2059 set ymax [lindex [$canv cget -scrollregion] 3]
2060 if {$ymax eq {} || $ymax == 0} return
2061 set f [$canv yview]
2062 set y0 [expr {int([lindex $f 0] * $ymax)}]
2063 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2064 if {$r0 < 0} {
2065 set r0 0
2067 set y1 [expr {int([lindex $f 1] * $ymax)}]
2068 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2069 if {$r1 >= $numcommits} {
2070 set r1 [expr {$numcommits - 1}]
2072 return [list $r0 $r1]
2075 proc layoutmore {} {
2076 global rowlaidout rowoptim commitidx numcommits optim_delay
2077 global uparrowlen curview
2079 set row $rowlaidout
2080 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2081 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2082 if {$orow > $rowoptim} {
2083 optimize_rows $rowoptim 0 $orow
2084 set rowoptim $orow
2086 set canshow [expr {$rowoptim - $optim_delay}]
2087 if {$canshow > $numcommits} {
2088 showstuff $canshow
2092 proc showstuff {canshow} {
2093 global numcommits commitrow pending_select selectedline
2094 global linesegends idrowranges idrangedrawn curview
2096 if {$numcommits == 0} {
2097 global phase
2098 set phase "incrdraw"
2099 allcanvs delete all
2101 set row $numcommits
2102 set numcommits $canshow
2103 setcanvscroll
2104 set rows [visiblerows]
2105 set r0 [lindex $rows 0]
2106 set r1 [lindex $rows 1]
2107 set selrow -1
2108 for {set r $row} {$r < $canshow} {incr r} {
2109 foreach id [lindex $linesegends [expr {$r+1}]] {
2110 set i -1
2111 foreach {s e} [rowranges $id] {
2112 incr i
2113 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2114 && ![info exists idrangedrawn($id,$i)]} {
2115 drawlineseg $id $i
2116 set idrangedrawn($id,$i) 1
2121 if {$canshow > $r1} {
2122 set canshow $r1
2124 while {$row < $canshow} {
2125 drawcmitrow $row
2126 incr row
2128 if {[info exists pending_select] &&
2129 [info exists commitrow($curview,$pending_select)] &&
2130 $commitrow($curview,$pending_select) < $numcommits} {
2131 selectline $commitrow($curview,$pending_select) 1
2133 if {![info exists selectedline] && ![info exists pending_select]} {
2134 selectline 0 1
2138 proc layoutrows {row endrow last} {
2139 global rowidlist rowoffsets displayorder
2140 global uparrowlen downarrowlen maxwidth mingaplen
2141 global childlist parentlist
2142 global idrowranges linesegends
2143 global commitidx curview
2144 global idinlist rowchk rowrangelist
2146 set idlist [lindex $rowidlist $row]
2147 set offs [lindex $rowoffsets $row]
2148 while {$row < $endrow} {
2149 set id [lindex $displayorder $row]
2150 set oldolds {}
2151 set newolds {}
2152 foreach p [lindex $parentlist $row] {
2153 if {![info exists idinlist($p)]} {
2154 lappend newolds $p
2155 } elseif {!$idinlist($p)} {
2156 lappend oldolds $p
2159 set lse {}
2160 set nev [expr {[llength $idlist] + [llength $newolds]
2161 + [llength $oldolds] - $maxwidth + 1}]
2162 if {$nev > 0} {
2163 if {!$last &&
2164 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2165 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2166 set i [lindex $idlist $x]
2167 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2168 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2169 [expr {$row + $uparrowlen + $mingaplen}]]
2170 if {$r == 0} {
2171 set idlist [lreplace $idlist $x $x]
2172 set offs [lreplace $offs $x $x]
2173 set offs [incrange $offs $x 1]
2174 set idinlist($i) 0
2175 set rm1 [expr {$row - 1}]
2176 lappend lse $i
2177 lappend idrowranges($i) $rm1
2178 if {[incr nev -1] <= 0} break
2179 continue
2181 set rowchk($id) [expr {$row + $r}]
2184 lset rowidlist $row $idlist
2185 lset rowoffsets $row $offs
2187 lappend linesegends $lse
2188 set col [lsearch -exact $idlist $id]
2189 if {$col < 0} {
2190 set col [llength $idlist]
2191 lappend idlist $id
2192 lset rowidlist $row $idlist
2193 set z {}
2194 if {[lindex $childlist $row] ne {}} {
2195 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2196 unset idinlist($id)
2198 lappend offs $z
2199 lset rowoffsets $row $offs
2200 if {$z ne {}} {
2201 makeuparrow $id $col $row $z
2203 } else {
2204 unset idinlist($id)
2206 set ranges {}
2207 if {[info exists idrowranges($id)]} {
2208 set ranges $idrowranges($id)
2209 lappend ranges $row
2210 unset idrowranges($id)
2212 lappend rowrangelist $ranges
2213 incr row
2214 set offs [ntimes [llength $idlist] 0]
2215 set l [llength $newolds]
2216 set idlist [eval lreplace \$idlist $col $col $newolds]
2217 set o 0
2218 if {$l != 1} {
2219 set offs [lrange $offs 0 [expr {$col - 1}]]
2220 foreach x $newolds {
2221 lappend offs {}
2222 incr o -1
2224 incr o
2225 set tmp [expr {[llength $idlist] - [llength $offs]}]
2226 if {$tmp > 0} {
2227 set offs [concat $offs [ntimes $tmp $o]]
2229 } else {
2230 lset offs $col {}
2232 foreach i $newolds {
2233 set idinlist($i) 1
2234 set idrowranges($i) $row
2236 incr col $l
2237 foreach oid $oldolds {
2238 set idinlist($oid) 1
2239 set idlist [linsert $idlist $col $oid]
2240 set offs [linsert $offs $col $o]
2241 makeuparrow $oid $col $row $o
2242 incr col
2244 lappend rowidlist $idlist
2245 lappend rowoffsets $offs
2247 return $row
2250 proc addextraid {id row} {
2251 global displayorder commitrow commitinfo
2252 global commitidx commitlisted
2253 global parentlist childlist children curview
2255 incr commitidx($curview)
2256 lappend displayorder $id
2257 lappend commitlisted 0
2258 lappend parentlist {}
2259 set commitrow($curview,$id) $row
2260 readcommit $id
2261 if {![info exists commitinfo($id)]} {
2262 set commitinfo($id) {"No commit information available"}
2264 if {![info exists children($curview,$id)]} {
2265 set children($curview,$id) {}
2267 lappend childlist $children($curview,$id)
2270 proc layouttail {} {
2271 global rowidlist rowoffsets idinlist commitidx curview
2272 global idrowranges rowrangelist
2274 set row $commitidx($curview)
2275 set idlist [lindex $rowidlist $row]
2276 while {$idlist ne {}} {
2277 set col [expr {[llength $idlist] - 1}]
2278 set id [lindex $idlist $col]
2279 addextraid $id $row
2280 unset idinlist($id)
2281 lappend idrowranges($id) $row
2282 lappend rowrangelist $idrowranges($id)
2283 unset idrowranges($id)
2284 incr row
2285 set offs [ntimes $col 0]
2286 set idlist [lreplace $idlist $col $col]
2287 lappend rowidlist $idlist
2288 lappend rowoffsets $offs
2291 foreach id [array names idinlist] {
2292 addextraid $id $row
2293 lset rowidlist $row [list $id]
2294 lset rowoffsets $row 0
2295 makeuparrow $id 0 $row 0
2296 lappend idrowranges($id) $row
2297 lappend rowrangelist $idrowranges($id)
2298 unset idrowranges($id)
2299 incr row
2300 lappend rowidlist {}
2301 lappend rowoffsets {}
2305 proc insert_pad {row col npad} {
2306 global rowidlist rowoffsets
2308 set pad [ntimes $npad {}]
2309 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2310 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2311 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2314 proc optimize_rows {row col endrow} {
2315 global rowidlist rowoffsets idrowranges displayorder
2317 for {} {$row < $endrow} {incr row} {
2318 set idlist [lindex $rowidlist $row]
2319 set offs [lindex $rowoffsets $row]
2320 set haspad 0
2321 for {} {$col < [llength $offs]} {incr col} {
2322 if {[lindex $idlist $col] eq {}} {
2323 set haspad 1
2324 continue
2326 set z [lindex $offs $col]
2327 if {$z eq {}} continue
2328 set isarrow 0
2329 set x0 [expr {$col + $z}]
2330 set y0 [expr {$row - 1}]
2331 set z0 [lindex $rowoffsets $y0 $x0]
2332 if {$z0 eq {}} {
2333 set id [lindex $idlist $col]
2334 set ranges [rowranges $id]
2335 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2336 set isarrow 1
2339 if {$z < -1 || ($z < 0 && $isarrow)} {
2340 set npad [expr {-1 - $z + $isarrow}]
2341 set offs [incrange $offs $col $npad]
2342 insert_pad $y0 $x0 $npad
2343 if {$y0 > 0} {
2344 optimize_rows $y0 $x0 $row
2346 set z [lindex $offs $col]
2347 set x0 [expr {$col + $z}]
2348 set z0 [lindex $rowoffsets $y0 $x0]
2349 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2350 set npad [expr {$z - 1 + $isarrow}]
2351 set y1 [expr {$row + 1}]
2352 set offs2 [lindex $rowoffsets $y1]
2353 set x1 -1
2354 foreach z $offs2 {
2355 incr x1
2356 if {$z eq {} || $x1 + $z < $col} continue
2357 if {$x1 + $z > $col} {
2358 incr npad
2360 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2361 break
2363 set pad [ntimes $npad {}]
2364 set idlist [eval linsert \$idlist $col $pad]
2365 set tmp [eval linsert \$offs $col $pad]
2366 incr col $npad
2367 set offs [incrange $tmp $col [expr {-$npad}]]
2368 set z [lindex $offs $col]
2369 set haspad 1
2371 if {$z0 eq {} && !$isarrow} {
2372 # this line links to its first child on row $row-2
2373 set rm2 [expr {$row - 2}]
2374 set id [lindex $displayorder $rm2]
2375 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2376 if {$xc >= 0} {
2377 set z0 [expr {$xc - $x0}]
2380 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2381 insert_pad $y0 $x0 1
2382 set offs [incrange $offs $col 1]
2383 optimize_rows $y0 [expr {$x0 + 1}] $row
2386 if {!$haspad} {
2387 set o {}
2388 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2389 set o [lindex $offs $col]
2390 if {$o eq {}} {
2391 # check if this is the link to the first child
2392 set id [lindex $idlist $col]
2393 set ranges [rowranges $id]
2394 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2395 # it is, work out offset to child
2396 set y0 [expr {$row - 1}]
2397 set id [lindex $displayorder $y0]
2398 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2399 if {$x0 >= 0} {
2400 set o [expr {$x0 - $col}]
2404 if {$o eq {} || $o <= 0} break
2406 if {$o ne {} && [incr col] < [llength $idlist]} {
2407 set y1 [expr {$row + 1}]
2408 set offs2 [lindex $rowoffsets $y1]
2409 set x1 -1
2410 foreach z $offs2 {
2411 incr x1
2412 if {$z eq {} || $x1 + $z < $col} continue
2413 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2414 break
2416 set idlist [linsert $idlist $col {}]
2417 set tmp [linsert $offs $col {}]
2418 incr col
2419 set offs [incrange $tmp $col -1]
2422 lset rowidlist $row $idlist
2423 lset rowoffsets $row $offs
2424 set col 0
2428 proc xc {row col} {
2429 global canvx0 linespc
2430 return [expr {$canvx0 + $col * $linespc}]
2433 proc yc {row} {
2434 global canvy0 linespc
2435 return [expr {$canvy0 + $row * $linespc}]
2438 proc linewidth {id} {
2439 global thickerline lthickness
2441 set wid $lthickness
2442 if {[info exists thickerline] && $id eq $thickerline} {
2443 set wid [expr {2 * $lthickness}]
2445 return $wid
2448 proc rowranges {id} {
2449 global phase idrowranges commitrow rowlaidout rowrangelist curview
2451 set ranges {}
2452 if {$phase eq {} ||
2453 ([info exists commitrow($curview,$id)]
2454 && $commitrow($curview,$id) < $rowlaidout)} {
2455 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2456 } elseif {[info exists idrowranges($id)]} {
2457 set ranges $idrowranges($id)
2459 return $ranges
2462 proc drawlineseg {id i} {
2463 global rowoffsets rowidlist
2464 global displayorder
2465 global canv colormap linespc
2466 global numcommits commitrow curview
2468 set ranges [rowranges $id]
2469 set downarrow 1
2470 if {[info exists commitrow($curview,$id)]
2471 && $commitrow($curview,$id) < $numcommits} {
2472 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2473 } else {
2474 set downarrow 1
2476 set startrow [lindex $ranges [expr {2 * $i}]]
2477 set row [lindex $ranges [expr {2 * $i + 1}]]
2478 if {$startrow == $row} return
2479 assigncolor $id
2480 set coords {}
2481 set col [lsearch -exact [lindex $rowidlist $row] $id]
2482 if {$col < 0} {
2483 puts "oops: drawline: id $id not on row $row"
2484 return
2486 set lasto {}
2487 set ns 0
2488 while {1} {
2489 set o [lindex $rowoffsets $row $col]
2490 if {$o eq {}} break
2491 if {$o ne $lasto} {
2492 # changing direction
2493 set x [xc $row $col]
2494 set y [yc $row]
2495 lappend coords $x $y
2496 set lasto $o
2498 incr col $o
2499 incr row -1
2501 set x [xc $row $col]
2502 set y [yc $row]
2503 lappend coords $x $y
2504 if {$i == 0} {
2505 # draw the link to the first child as part of this line
2506 incr row -1
2507 set child [lindex $displayorder $row]
2508 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2509 if {$ccol >= 0} {
2510 set x [xc $row $ccol]
2511 set y [yc $row]
2512 if {$ccol < $col - 1} {
2513 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2514 } elseif {$ccol > $col + 1} {
2515 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2517 lappend coords $x $y
2520 if {[llength $coords] < 4} return
2521 if {$downarrow} {
2522 # This line has an arrow at the lower end: check if the arrow is
2523 # on a diagonal segment, and if so, work around the Tk 8.4
2524 # refusal to draw arrows on diagonal lines.
2525 set x0 [lindex $coords 0]
2526 set x1 [lindex $coords 2]
2527 if {$x0 != $x1} {
2528 set y0 [lindex $coords 1]
2529 set y1 [lindex $coords 3]
2530 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2531 # we have a nearby vertical segment, just trim off the diag bit
2532 set coords [lrange $coords 2 end]
2533 } else {
2534 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2535 set xi [expr {$x0 - $slope * $linespc / 2}]
2536 set yi [expr {$y0 - $linespc / 2}]
2537 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2541 set arrow [expr {2 * ($i > 0) + $downarrow}]
2542 set arrow [lindex {none first last both} $arrow]
2543 set t [$canv create line $coords -width [linewidth $id] \
2544 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2545 $canv lower $t
2546 bindline $t $id
2549 proc drawparentlinks {id row col olds} {
2550 global rowidlist canv colormap
2552 set row2 [expr {$row + 1}]
2553 set x [xc $row $col]
2554 set y [yc $row]
2555 set y2 [yc $row2]
2556 set ids [lindex $rowidlist $row2]
2557 # rmx = right-most X coord used
2558 set rmx 0
2559 foreach p $olds {
2560 set i [lsearch -exact $ids $p]
2561 if {$i < 0} {
2562 puts "oops, parent $p of $id not in list"
2563 continue
2565 set x2 [xc $row2 $i]
2566 if {$x2 > $rmx} {
2567 set rmx $x2
2569 set ranges [rowranges $p]
2570 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2571 && $row2 < [lindex $ranges 1]} {
2572 # drawlineseg will do this one for us
2573 continue
2575 assigncolor $p
2576 # should handle duplicated parents here...
2577 set coords [list $x $y]
2578 if {$i < $col - 1} {
2579 lappend coords [xc $row [expr {$i + 1}]] $y
2580 } elseif {$i > $col + 1} {
2581 lappend coords [xc $row [expr {$i - 1}]] $y
2583 lappend coords $x2 $y2
2584 set t [$canv create line $coords -width [linewidth $p] \
2585 -fill $colormap($p) -tags lines.$p]
2586 $canv lower $t
2587 bindline $t $p
2589 return $rmx
2592 proc drawlines {id} {
2593 global colormap canv
2594 global idrangedrawn
2595 global children iddrawn commitrow rowidlist curview
2597 $canv delete lines.$id
2598 set nr [expr {[llength [rowranges $id]] / 2}]
2599 for {set i 0} {$i < $nr} {incr i} {
2600 if {[info exists idrangedrawn($id,$i)]} {
2601 drawlineseg $id $i
2604 foreach child $children($curview,$id) {
2605 if {[info exists iddrawn($child)]} {
2606 set row $commitrow($curview,$child)
2607 set col [lsearch -exact [lindex $rowidlist $row] $child]
2608 if {$col >= 0} {
2609 drawparentlinks $child $row $col [list $id]
2615 proc drawcmittext {id row col rmx} {
2616 global linespc canv canv2 canv3 canvy0
2617 global commitlisted commitinfo rowidlist
2618 global rowtextx idpos idtags idheads idotherrefs
2619 global linehtag linentag linedtag
2620 global mainfont canvxmax
2622 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2623 set x [xc $row $col]
2624 set y [yc $row]
2625 set orad [expr {$linespc / 3}]
2626 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2627 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2628 -fill $ofill -outline black -width 1]
2629 $canv raise $t
2630 $canv bind $t <1> {selcanvline {} %x %y}
2631 set xt [xc $row [llength [lindex $rowidlist $row]]]
2632 if {$xt < $rmx} {
2633 set xt $rmx
2635 set rowtextx($row) $xt
2636 set idpos($id) [list $x $xt $y]
2637 if {[info exists idtags($id)] || [info exists idheads($id)]
2638 || [info exists idotherrefs($id)]} {
2639 set xt [drawtags $id $x $xt $y]
2641 set headline [lindex $commitinfo($id) 0]
2642 set name [lindex $commitinfo($id) 1]
2643 set date [lindex $commitinfo($id) 2]
2644 set date [formatdate $date]
2645 set font $mainfont
2646 set nfont $mainfont
2647 set isbold [ishighlighted $row]
2648 if {$isbold > 0} {
2649 lappend font bold
2650 if {$isbold > 1} {
2651 lappend nfont bold
2654 set linehtag($row) [$canv create text $xt $y -anchor w \
2655 -text $headline -font $font]
2656 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2657 set linentag($row) [$canv2 create text 3 $y -anchor w \
2658 -text $name -font $nfont]
2659 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2660 -text $date -font $mainfont]
2661 set xr [expr {$xt + [font measure $mainfont $headline]}]
2662 if {$xr > $canvxmax} {
2663 set canvxmax $xr
2664 setcanvscroll
2668 proc drawcmitrow {row} {
2669 global displayorder rowidlist
2670 global idrangedrawn iddrawn
2671 global commitinfo parentlist numcommits
2672 global filehighlight fhighlights nhl_names nhighlights
2673 global hlview vhighlights
2675 if {$row >= $numcommits} return
2676 foreach id [lindex $rowidlist $row] {
2677 if {$id eq {}} continue
2678 set i -1
2679 foreach {s e} [rowranges $id] {
2680 incr i
2681 if {$row < $s} continue
2682 if {$e eq {}} break
2683 if {$row <= $e} {
2684 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2685 drawlineseg $id $i
2686 set idrangedrawn($id,$i) 1
2688 break
2693 set id [lindex $displayorder $row]
2694 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2695 askvhighlight $row $id
2697 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2698 askfilehighlight $row $id
2700 if {$nhl_names ne {} && ![info exists nhighlights($row)]} {
2701 asknamehighlight $row $id
2703 if {[info exists iddrawn($id)]} return
2704 set col [lsearch -exact [lindex $rowidlist $row] $id]
2705 if {$col < 0} {
2706 puts "oops, row $row id $id not in list"
2707 return
2709 if {![info exists commitinfo($id)]} {
2710 getcommit $id
2712 assigncolor $id
2713 set olds [lindex $parentlist $row]
2714 if {$olds ne {}} {
2715 set rmx [drawparentlinks $id $row $col $olds]
2716 } else {
2717 set rmx 0
2719 drawcmittext $id $row $col $rmx
2720 set iddrawn($id) 1
2723 proc drawfrac {f0 f1} {
2724 global numcommits canv
2725 global linespc
2727 set ymax [lindex [$canv cget -scrollregion] 3]
2728 if {$ymax eq {} || $ymax == 0} return
2729 set y0 [expr {int($f0 * $ymax)}]
2730 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2731 if {$row < 0} {
2732 set row 0
2734 set y1 [expr {int($f1 * $ymax)}]
2735 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2736 if {$endrow >= $numcommits} {
2737 set endrow [expr {$numcommits - 1}]
2739 for {} {$row <= $endrow} {incr row} {
2740 drawcmitrow $row
2744 proc drawvisible {} {
2745 global canv
2746 eval drawfrac [$canv yview]
2749 proc clear_display {} {
2750 global iddrawn idrangedrawn
2751 global vhighlights fhighlights nhighlights
2753 allcanvs delete all
2754 catch {unset iddrawn}
2755 catch {unset idrangedrawn}
2756 catch {unset vhighlights}
2757 catch {unset fhighlights}
2758 catch {unset nhighlights}
2761 proc findcrossings {id} {
2762 global rowidlist parentlist numcommits rowoffsets displayorder
2764 set cross {}
2765 set ccross {}
2766 foreach {s e} [rowranges $id] {
2767 if {$e >= $numcommits} {
2768 set e [expr {$numcommits - 1}]
2770 if {$e <= $s} continue
2771 set x [lsearch -exact [lindex $rowidlist $e] $id]
2772 if {$x < 0} {
2773 puts "findcrossings: oops, no [shortids $id] in row $e"
2774 continue
2776 for {set row $e} {[incr row -1] >= $s} {} {
2777 set olds [lindex $parentlist $row]
2778 set kid [lindex $displayorder $row]
2779 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2780 if {$kidx < 0} continue
2781 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2782 foreach p $olds {
2783 set px [lsearch -exact $nextrow $p]
2784 if {$px < 0} continue
2785 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2786 if {[lsearch -exact $ccross $p] >= 0} continue
2787 if {$x == $px + ($kidx < $px? -1: 1)} {
2788 lappend ccross $p
2789 } elseif {[lsearch -exact $cross $p] < 0} {
2790 lappend cross $p
2794 set inc [lindex $rowoffsets $row $x]
2795 if {$inc eq {}} break
2796 incr x $inc
2799 return [concat $ccross {{}} $cross]
2802 proc assigncolor {id} {
2803 global colormap colors nextcolor
2804 global commitrow parentlist children children curview
2806 if {[info exists colormap($id)]} return
2807 set ncolors [llength $colors]
2808 if {[info exists children($curview,$id)]} {
2809 set kids $children($curview,$id)
2810 } else {
2811 set kids {}
2813 if {[llength $kids] == 1} {
2814 set child [lindex $kids 0]
2815 if {[info exists colormap($child)]
2816 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2817 set colormap($id) $colormap($child)
2818 return
2821 set badcolors {}
2822 set origbad {}
2823 foreach x [findcrossings $id] {
2824 if {$x eq {}} {
2825 # delimiter between corner crossings and other crossings
2826 if {[llength $badcolors] >= $ncolors - 1} break
2827 set origbad $badcolors
2829 if {[info exists colormap($x)]
2830 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2831 lappend badcolors $colormap($x)
2834 if {[llength $badcolors] >= $ncolors} {
2835 set badcolors $origbad
2837 set origbad $badcolors
2838 if {[llength $badcolors] < $ncolors - 1} {
2839 foreach child $kids {
2840 if {[info exists colormap($child)]
2841 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2842 lappend badcolors $colormap($child)
2844 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2845 if {[info exists colormap($p)]
2846 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2847 lappend badcolors $colormap($p)
2851 if {[llength $badcolors] >= $ncolors} {
2852 set badcolors $origbad
2855 for {set i 0} {$i <= $ncolors} {incr i} {
2856 set c [lindex $colors $nextcolor]
2857 if {[incr nextcolor] >= $ncolors} {
2858 set nextcolor 0
2860 if {[lsearch -exact $badcolors $c]} break
2862 set colormap($id) $c
2865 proc bindline {t id} {
2866 global canv
2868 $canv bind $t <Enter> "lineenter %x %y $id"
2869 $canv bind $t <Motion> "linemotion %x %y $id"
2870 $canv bind $t <Leave> "lineleave $id"
2871 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2874 proc drawtags {id x xt y1} {
2875 global idtags idheads idotherrefs
2876 global linespc lthickness
2877 global canv mainfont commitrow rowtextx curview
2879 set marks {}
2880 set ntags 0
2881 set nheads 0
2882 if {[info exists idtags($id)]} {
2883 set marks $idtags($id)
2884 set ntags [llength $marks]
2886 if {[info exists idheads($id)]} {
2887 set marks [concat $marks $idheads($id)]
2888 set nheads [llength $idheads($id)]
2890 if {[info exists idotherrefs($id)]} {
2891 set marks [concat $marks $idotherrefs($id)]
2893 if {$marks eq {}} {
2894 return $xt
2897 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2898 set yt [expr {$y1 - 0.5 * $linespc}]
2899 set yb [expr {$yt + $linespc - 1}]
2900 set xvals {}
2901 set wvals {}
2902 foreach tag $marks {
2903 set wid [font measure $mainfont $tag]
2904 lappend xvals $xt
2905 lappend wvals $wid
2906 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2908 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2909 -width $lthickness -fill black -tags tag.$id]
2910 $canv lower $t
2911 foreach tag $marks x $xvals wid $wvals {
2912 set xl [expr {$x + $delta}]
2913 set xr [expr {$x + $delta + $wid + $lthickness}]
2914 if {[incr ntags -1] >= 0} {
2915 # draw a tag
2916 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2917 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2918 -width 1 -outline black -fill yellow -tags tag.$id]
2919 $canv bind $t <1> [list showtag $tag 1]
2920 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2921 } else {
2922 # draw a head or other ref
2923 if {[incr nheads -1] >= 0} {
2924 set col green
2925 } else {
2926 set col "#ddddff"
2928 set xl [expr {$xl - $delta/2}]
2929 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2930 -width 1 -outline black -fill $col -tags tag.$id
2931 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2932 set rwid [font measure $mainfont $remoteprefix]
2933 set xi [expr {$x + 1}]
2934 set yti [expr {$yt + 1}]
2935 set xri [expr {$x + $rwid}]
2936 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2937 -width 0 -fill "#ffddaa" -tags tag.$id
2940 set t [$canv create text $xl $y1 -anchor w -text $tag \
2941 -font $mainfont -tags tag.$id]
2942 if {$ntags >= 0} {
2943 $canv bind $t <1> [list showtag $tag 1]
2946 return $xt
2949 proc xcoord {i level ln} {
2950 global canvx0 xspc1 xspc2
2952 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2953 if {$i > 0 && $i == $level} {
2954 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2955 } elseif {$i > $level} {
2956 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2958 return $x
2961 proc show_status {msg} {
2962 global canv mainfont
2964 clear_display
2965 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2968 proc finishcommits {} {
2969 global commitidx phase curview
2970 global canv mainfont ctext maincursor textcursor
2971 global findinprogress pending_select
2973 if {$commitidx($curview) > 0} {
2974 drawrest
2975 } else {
2976 show_status "No commits selected"
2978 set phase {}
2979 catch {unset pending_select}
2982 # Don't change the text pane cursor if it is currently the hand cursor,
2983 # showing that we are over a sha1 ID link.
2984 proc settextcursor {c} {
2985 global ctext curtextcursor
2987 if {[$ctext cget -cursor] == $curtextcursor} {
2988 $ctext config -cursor $c
2990 set curtextcursor $c
2993 proc nowbusy {what} {
2994 global isbusy
2996 if {[array names isbusy] eq {}} {
2997 . config -cursor watch
2998 settextcursor watch
3000 set isbusy($what) 1
3003 proc notbusy {what} {
3004 global isbusy maincursor textcursor
3006 catch {unset isbusy($what)}
3007 if {[array names isbusy] eq {}} {
3008 . config -cursor $maincursor
3009 settextcursor $textcursor
3013 proc drawrest {} {
3014 global numcommits
3015 global startmsecs
3016 global canvy0 numcommits linespc
3017 global rowlaidout commitidx curview
3018 global pending_select
3020 set row $rowlaidout
3021 layoutrows $rowlaidout $commitidx($curview) 1
3022 layouttail
3023 optimize_rows $row 0 $commitidx($curview)
3024 showstuff $commitidx($curview)
3025 if {[info exists pending_select]} {
3026 selectline 0 1
3029 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3030 #puts "overall $drawmsecs ms for $numcommits commits"
3033 proc findmatches {f} {
3034 global findtype foundstring foundstrlen
3035 if {$findtype == "Regexp"} {
3036 set matches [regexp -indices -all -inline $foundstring $f]
3037 } else {
3038 if {$findtype == "IgnCase"} {
3039 set str [string tolower $f]
3040 } else {
3041 set str $f
3043 set matches {}
3044 set i 0
3045 while {[set j [string first $foundstring $str $i]] >= 0} {
3046 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3047 set i [expr {$j + $foundstrlen}]
3050 return $matches
3053 proc dofind {} {
3054 global findtype findloc findstring markedmatches commitinfo
3055 global numcommits displayorder linehtag linentag linedtag
3056 global mainfont canv canv2 canv3 selectedline
3057 global matchinglines foundstring foundstrlen matchstring
3058 global commitdata
3060 stopfindproc
3061 unmarkmatches
3062 focus .
3063 set matchinglines {}
3064 if {$findloc == "Pickaxe"} {
3065 findpatches
3066 return
3068 if {$findtype == "IgnCase"} {
3069 set foundstring [string tolower $findstring]
3070 } else {
3071 set foundstring $findstring
3073 set foundstrlen [string length $findstring]
3074 if {$foundstrlen == 0} return
3075 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3076 set matchstring "*$matchstring*"
3077 if {$findloc == "Files"} {
3078 findfiles
3079 return
3081 if {![info exists selectedline]} {
3082 set oldsel -1
3083 } else {
3084 set oldsel $selectedline
3086 set didsel 0
3087 set fldtypes {Headline Author Date Committer CDate Comment}
3088 set l -1
3089 foreach id $displayorder {
3090 set d $commitdata($id)
3091 incr l
3092 if {$findtype == "Regexp"} {
3093 set doesmatch [regexp $foundstring $d]
3094 } elseif {$findtype == "IgnCase"} {
3095 set doesmatch [string match -nocase $matchstring $d]
3096 } else {
3097 set doesmatch [string match $matchstring $d]
3099 if {!$doesmatch} continue
3100 if {![info exists commitinfo($id)]} {
3101 getcommit $id
3103 set info $commitinfo($id)
3104 set doesmatch 0
3105 foreach f $info ty $fldtypes {
3106 if {$findloc != "All fields" && $findloc != $ty} {
3107 continue
3109 set matches [findmatches $f]
3110 if {$matches == {}} continue
3111 set doesmatch 1
3112 if {$ty == "Headline"} {
3113 drawcmitrow $l
3114 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3115 } elseif {$ty == "Author"} {
3116 drawcmitrow $l
3117 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3118 } elseif {$ty == "Date"} {
3119 drawcmitrow $l
3120 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3123 if {$doesmatch} {
3124 lappend matchinglines $l
3125 if {!$didsel && $l > $oldsel} {
3126 findselectline $l
3127 set didsel 1
3131 if {$matchinglines == {}} {
3132 bell
3133 } elseif {!$didsel} {
3134 findselectline [lindex $matchinglines 0]
3138 proc findselectline {l} {
3139 global findloc commentend ctext
3140 selectline $l 1
3141 if {$findloc == "All fields" || $findloc == "Comments"} {
3142 # highlight the matches in the comments
3143 set f [$ctext get 1.0 $commentend]
3144 set matches [findmatches $f]
3145 foreach match $matches {
3146 set start [lindex $match 0]
3147 set end [expr {[lindex $match 1] + 1}]
3148 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3153 proc findnext {restart} {
3154 global matchinglines selectedline
3155 if {![info exists matchinglines]} {
3156 if {$restart} {
3157 dofind
3159 return
3161 if {![info exists selectedline]} return
3162 foreach l $matchinglines {
3163 if {$l > $selectedline} {
3164 findselectline $l
3165 return
3168 bell
3171 proc findprev {} {
3172 global matchinglines selectedline
3173 if {![info exists matchinglines]} {
3174 dofind
3175 return
3177 if {![info exists selectedline]} return
3178 set prev {}
3179 foreach l $matchinglines {
3180 if {$l >= $selectedline} break
3181 set prev $l
3183 if {$prev != {}} {
3184 findselectline $prev
3185 } else {
3186 bell
3190 proc findlocchange {name ix op} {
3191 global findloc findtype findtypemenu
3192 if {$findloc == "Pickaxe"} {
3193 set findtype Exact
3194 set state disabled
3195 } else {
3196 set state normal
3198 $findtypemenu entryconf 1 -state $state
3199 $findtypemenu entryconf 2 -state $state
3202 proc stopfindproc {{done 0}} {
3203 global findprocpid findprocfile findids
3204 global ctext findoldcursor phase maincursor textcursor
3205 global findinprogress
3207 catch {unset findids}
3208 if {[info exists findprocpid]} {
3209 if {!$done} {
3210 catch {exec kill $findprocpid}
3212 catch {close $findprocfile}
3213 unset findprocpid
3215 catch {unset findinprogress}
3216 notbusy find
3219 proc findpatches {} {
3220 global findstring selectedline numcommits
3221 global findprocpid findprocfile
3222 global finddidsel ctext displayorder findinprogress
3223 global findinsertpos
3225 if {$numcommits == 0} return
3227 # make a list of all the ids to search, starting at the one
3228 # after the selected line (if any)
3229 if {[info exists selectedline]} {
3230 set l $selectedline
3231 } else {
3232 set l -1
3234 set inputids {}
3235 for {set i 0} {$i < $numcommits} {incr i} {
3236 if {[incr l] >= $numcommits} {
3237 set l 0
3239 append inputids [lindex $displayorder $l] "\n"
3242 if {[catch {
3243 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
3244 << $inputids] r]
3245 } err]} {
3246 error_popup "Error starting search process: $err"
3247 return
3250 set findinsertpos end
3251 set findprocfile $f
3252 set findprocpid [pid $f]
3253 fconfigure $f -blocking 0
3254 fileevent $f readable readfindproc
3255 set finddidsel 0
3256 nowbusy find
3257 set findinprogress 1
3260 proc readfindproc {} {
3261 global findprocfile finddidsel
3262 global commitrow matchinglines findinsertpos curview
3264 set n [gets $findprocfile line]
3265 if {$n < 0} {
3266 if {[eof $findprocfile]} {
3267 stopfindproc 1
3268 if {!$finddidsel} {
3269 bell
3272 return
3274 if {![regexp {^[0-9a-f]{40}} $line id]} {
3275 error_popup "Can't parse git-diff-tree output: $line"
3276 stopfindproc
3277 return
3279 if {![info exists commitrow($curview,$id)]} {
3280 puts stderr "spurious id: $id"
3281 return
3283 set l $commitrow($curview,$id)
3284 insertmatch $l $id
3287 proc insertmatch {l id} {
3288 global matchinglines findinsertpos finddidsel
3290 if {$findinsertpos == "end"} {
3291 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
3292 set matchinglines [linsert $matchinglines 0 $l]
3293 set findinsertpos 1
3294 } else {
3295 lappend matchinglines $l
3297 } else {
3298 set matchinglines [linsert $matchinglines $findinsertpos $l]
3299 incr findinsertpos
3301 markheadline $l $id
3302 if {!$finddidsel} {
3303 findselectline $l
3304 set finddidsel 1
3308 proc findfiles {} {
3309 global selectedline numcommits displayorder ctext
3310 global ffileline finddidsel parentlist
3311 global findinprogress findstartline findinsertpos
3312 global treediffs fdiffid fdiffsneeded fdiffpos
3313 global findmergefiles
3315 if {$numcommits == 0} return
3317 if {[info exists selectedline]} {
3318 set l [expr {$selectedline + 1}]
3319 } else {
3320 set l 0
3322 set ffileline $l
3323 set findstartline $l
3324 set diffsneeded {}
3325 set fdiffsneeded {}
3326 while 1 {
3327 set id [lindex $displayorder $l]
3328 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3329 if {![info exists treediffs($id)]} {
3330 append diffsneeded "$id\n"
3331 lappend fdiffsneeded $id
3334 if {[incr l] >= $numcommits} {
3335 set l 0
3337 if {$l == $findstartline} break
3340 # start off a git-diff-tree process if needed
3341 if {$diffsneeded ne {}} {
3342 if {[catch {
3343 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3344 } err ]} {
3345 error_popup "Error starting search process: $err"
3346 return
3348 catch {unset fdiffid}
3349 set fdiffpos 0
3350 fconfigure $df -blocking 0
3351 fileevent $df readable [list readfilediffs $df]
3354 set finddidsel 0
3355 set findinsertpos end
3356 set id [lindex $displayorder $l]
3357 nowbusy find
3358 set findinprogress 1
3359 findcont
3360 update
3363 proc readfilediffs {df} {
3364 global findid fdiffid fdiffs
3366 set n [gets $df line]
3367 if {$n < 0} {
3368 if {[eof $df]} {
3369 donefilediff
3370 if {[catch {close $df} err]} {
3371 stopfindproc
3372 bell
3373 error_popup "Error in git-diff-tree: $err"
3374 } elseif {[info exists findid]} {
3375 set id $findid
3376 stopfindproc
3377 bell
3378 error_popup "Couldn't find diffs for $id"
3381 return
3383 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3384 # start of a new string of diffs
3385 donefilediff
3386 set fdiffid $id
3387 set fdiffs {}
3388 } elseif {[string match ":*" $line]} {
3389 lappend fdiffs [lindex $line 5]
3393 proc donefilediff {} {
3394 global fdiffid fdiffs treediffs findid
3395 global fdiffsneeded fdiffpos
3397 if {[info exists fdiffid]} {
3398 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3399 && $fdiffpos < [llength $fdiffsneeded]} {
3400 # git-diff-tree doesn't output anything for a commit
3401 # which doesn't change anything
3402 set nullid [lindex $fdiffsneeded $fdiffpos]
3403 set treediffs($nullid) {}
3404 if {[info exists findid] && $nullid eq $findid} {
3405 unset findid
3406 findcont
3408 incr fdiffpos
3410 incr fdiffpos
3412 if {![info exists treediffs($fdiffid)]} {
3413 set treediffs($fdiffid) $fdiffs
3415 if {[info exists findid] && $fdiffid eq $findid} {
3416 unset findid
3417 findcont
3422 proc findcont {} {
3423 global findid treediffs parentlist
3424 global ffileline findstartline finddidsel
3425 global displayorder numcommits matchinglines findinprogress
3426 global findmergefiles
3428 set l $ffileline
3429 while {1} {
3430 set id [lindex $displayorder $l]
3431 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3432 if {![info exists treediffs($id)]} {
3433 set findid $id
3434 set ffileline $l
3435 return
3437 set doesmatch 0
3438 foreach f $treediffs($id) {
3439 set x [findmatches $f]
3440 if {$x != {}} {
3441 set doesmatch 1
3442 break
3445 if {$doesmatch} {
3446 insertmatch $l $id
3449 if {[incr l] >= $numcommits} {
3450 set l 0
3452 if {$l == $findstartline} break
3454 stopfindproc
3455 if {!$finddidsel} {
3456 bell
3460 # mark a commit as matching by putting a yellow background
3461 # behind the headline
3462 proc markheadline {l id} {
3463 global canv mainfont linehtag
3465 drawcmitrow $l
3466 set bbox [$canv bbox $linehtag($l)]
3467 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3468 $canv lower $t
3471 # mark the bits of a headline, author or date that match a find string
3472 proc markmatches {canv l str tag matches font} {
3473 set bbox [$canv bbox $tag]
3474 set x0 [lindex $bbox 0]
3475 set y0 [lindex $bbox 1]
3476 set y1 [lindex $bbox 3]
3477 foreach match $matches {
3478 set start [lindex $match 0]
3479 set end [lindex $match 1]
3480 if {$start > $end} continue
3481 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3482 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3483 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3484 [expr {$x0+$xlen+2}] $y1 \
3485 -outline {} -tags matches -fill yellow]
3486 $canv lower $t
3490 proc unmarkmatches {} {
3491 global matchinglines findids
3492 allcanvs delete matches
3493 catch {unset matchinglines}
3494 catch {unset findids}
3497 proc selcanvline {w x y} {
3498 global canv canvy0 ctext linespc
3499 global rowtextx
3500 set ymax [lindex [$canv cget -scrollregion] 3]
3501 if {$ymax == {}} return
3502 set yfrac [lindex [$canv yview] 0]
3503 set y [expr {$y + $yfrac * $ymax}]
3504 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3505 if {$l < 0} {
3506 set l 0
3508 if {$w eq $canv} {
3509 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3511 unmarkmatches
3512 selectline $l 1
3515 proc commit_descriptor {p} {
3516 global commitinfo
3517 if {![info exists commitinfo($p)]} {
3518 getcommit $p
3520 set l "..."
3521 if {[llength $commitinfo($p)] > 1} {
3522 set l [lindex $commitinfo($p) 0]
3524 return "$p ($l)"
3527 # append some text to the ctext widget, and make any SHA1 ID
3528 # that we know about be a clickable link.
3529 proc appendwithlinks {text} {
3530 global ctext commitrow linknum curview
3532 set start [$ctext index "end - 1c"]
3533 $ctext insert end $text
3534 $ctext insert end "\n"
3535 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3536 foreach l $links {
3537 set s [lindex $l 0]
3538 set e [lindex $l 1]
3539 set linkid [string range $text $s $e]
3540 if {![info exists commitrow($curview,$linkid)]} continue
3541 incr e
3542 $ctext tag add link "$start + $s c" "$start + $e c"
3543 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3544 $ctext tag bind link$linknum <1> \
3545 [list selectline $commitrow($curview,$linkid) 1]
3546 incr linknum
3548 $ctext tag conf link -foreground blue -underline 1
3549 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3550 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3553 proc viewnextline {dir} {
3554 global canv linespc
3556 $canv delete hover
3557 set ymax [lindex [$canv cget -scrollregion] 3]
3558 set wnow [$canv yview]
3559 set wtop [expr {[lindex $wnow 0] * $ymax}]
3560 set newtop [expr {$wtop + $dir * $linespc}]
3561 if {$newtop < 0} {
3562 set newtop 0
3563 } elseif {$newtop > $ymax} {
3564 set newtop $ymax
3566 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3569 proc selectline {l isnew} {
3570 global canv canv2 canv3 ctext commitinfo selectedline
3571 global displayorder linehtag linentag linedtag
3572 global canvy0 linespc parentlist childlist
3573 global currentid sha1entry
3574 global commentend idtags linknum
3575 global mergemax numcommits pending_select
3576 global cmitmode
3578 catch {unset pending_select}
3579 $canv delete hover
3580 normalline
3581 if {$l < 0 || $l >= $numcommits} return
3582 set y [expr {$canvy0 + $l * $linespc}]
3583 set ymax [lindex [$canv cget -scrollregion] 3]
3584 set ytop [expr {$y - $linespc - 1}]
3585 set ybot [expr {$y + $linespc + 1}]
3586 set wnow [$canv yview]
3587 set wtop [expr {[lindex $wnow 0] * $ymax}]
3588 set wbot [expr {[lindex $wnow 1] * $ymax}]
3589 set wh [expr {$wbot - $wtop}]
3590 set newtop $wtop
3591 if {$ytop < $wtop} {
3592 if {$ybot < $wtop} {
3593 set newtop [expr {$y - $wh / 2.0}]
3594 } else {
3595 set newtop $ytop
3596 if {$newtop > $wtop - $linespc} {
3597 set newtop [expr {$wtop - $linespc}]
3600 } elseif {$ybot > $wbot} {
3601 if {$ytop > $wbot} {
3602 set newtop [expr {$y - $wh / 2.0}]
3603 } else {
3604 set newtop [expr {$ybot - $wh}]
3605 if {$newtop < $wtop + $linespc} {
3606 set newtop [expr {$wtop + $linespc}]
3610 if {$newtop != $wtop} {
3611 if {$newtop < 0} {
3612 set newtop 0
3614 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3615 drawvisible
3618 if {![info exists linehtag($l)]} return
3619 $canv delete secsel
3620 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3621 -tags secsel -fill [$canv cget -selectbackground]]
3622 $canv lower $t
3623 $canv2 delete secsel
3624 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3625 -tags secsel -fill [$canv2 cget -selectbackground]]
3626 $canv2 lower $t
3627 $canv3 delete secsel
3628 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3629 -tags secsel -fill [$canv3 cget -selectbackground]]
3630 $canv3 lower $t
3632 if {$isnew} {
3633 addtohistory [list selectline $l 0]
3636 set selectedline $l
3638 set id [lindex $displayorder $l]
3639 set currentid $id
3640 $sha1entry delete 0 end
3641 $sha1entry insert 0 $id
3642 $sha1entry selection from 0
3643 $sha1entry selection to end
3645 $ctext conf -state normal
3646 $ctext delete 0.0 end
3647 set linknum 0
3648 set info $commitinfo($id)
3649 set date [formatdate [lindex $info 2]]
3650 $ctext insert end "Author: [lindex $info 1] $date\n"
3651 set date [formatdate [lindex $info 4]]
3652 $ctext insert end "Committer: [lindex $info 3] $date\n"
3653 if {[info exists idtags($id)]} {
3654 $ctext insert end "Tags:"
3655 foreach tag $idtags($id) {
3656 $ctext insert end " $tag"
3658 $ctext insert end "\n"
3661 set comment {}
3662 set olds [lindex $parentlist $l]
3663 if {[llength $olds] > 1} {
3664 set np 0
3665 foreach p $olds {
3666 if {$np >= $mergemax} {
3667 set tag mmax
3668 } else {
3669 set tag m$np
3671 $ctext insert end "Parent: " $tag
3672 appendwithlinks [commit_descriptor $p]
3673 incr np
3675 } else {
3676 foreach p $olds {
3677 append comment "Parent: [commit_descriptor $p]\n"
3681 foreach c [lindex $childlist $l] {
3682 append comment "Child: [commit_descriptor $c]\n"
3684 append comment "\n"
3685 append comment [lindex $info 5]
3687 # make anything that looks like a SHA1 ID be a clickable link
3688 appendwithlinks $comment
3690 $ctext tag delete Comments
3691 $ctext tag remove found 1.0 end
3692 $ctext conf -state disabled
3693 set commentend [$ctext index "end - 1c"]
3695 init_flist "Comments"
3696 if {$cmitmode eq "tree"} {
3697 gettree $id
3698 } elseif {[llength $olds] <= 1} {
3699 startdiff $id
3700 } else {
3701 mergediff $id $l
3705 proc selfirstline {} {
3706 unmarkmatches
3707 selectline 0 1
3710 proc sellastline {} {
3711 global numcommits
3712 unmarkmatches
3713 set l [expr {$numcommits - 1}]
3714 selectline $l 1
3717 proc selnextline {dir} {
3718 global selectedline
3719 if {![info exists selectedline]} return
3720 set l [expr {$selectedline + $dir}]
3721 unmarkmatches
3722 selectline $l 1
3725 proc selnextpage {dir} {
3726 global canv linespc selectedline numcommits
3728 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3729 if {$lpp < 1} {
3730 set lpp 1
3732 allcanvs yview scroll [expr {$dir * $lpp}] units
3733 drawvisible
3734 if {![info exists selectedline]} return
3735 set l [expr {$selectedline + $dir * $lpp}]
3736 if {$l < 0} {
3737 set l 0
3738 } elseif {$l >= $numcommits} {
3739 set l [expr $numcommits - 1]
3741 unmarkmatches
3742 selectline $l 1
3745 proc unselectline {} {
3746 global selectedline currentid
3748 catch {unset selectedline}
3749 catch {unset currentid}
3750 allcanvs delete secsel
3753 proc reselectline {} {
3754 global selectedline
3756 if {[info exists selectedline]} {
3757 selectline $selectedline 0
3761 proc addtohistory {cmd} {
3762 global history historyindex curview
3764 set elt [list $curview $cmd]
3765 if {$historyindex > 0
3766 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3767 return
3770 if {$historyindex < [llength $history]} {
3771 set history [lreplace $history $historyindex end $elt]
3772 } else {
3773 lappend history $elt
3775 incr historyindex
3776 if {$historyindex > 1} {
3777 .ctop.top.bar.leftbut conf -state normal
3778 } else {
3779 .ctop.top.bar.leftbut conf -state disabled
3781 .ctop.top.bar.rightbut conf -state disabled
3784 proc godo {elt} {
3785 global curview
3787 set view [lindex $elt 0]
3788 set cmd [lindex $elt 1]
3789 if {$curview != $view} {
3790 showview $view
3792 eval $cmd
3795 proc goback {} {
3796 global history historyindex
3798 if {$historyindex > 1} {
3799 incr historyindex -1
3800 godo [lindex $history [expr {$historyindex - 1}]]
3801 .ctop.top.bar.rightbut conf -state normal
3803 if {$historyindex <= 1} {
3804 .ctop.top.bar.leftbut conf -state disabled
3808 proc goforw {} {
3809 global history historyindex
3811 if {$historyindex < [llength $history]} {
3812 set cmd [lindex $history $historyindex]
3813 incr historyindex
3814 godo $cmd
3815 .ctop.top.bar.leftbut conf -state normal
3817 if {$historyindex >= [llength $history]} {
3818 .ctop.top.bar.rightbut conf -state disabled
3822 proc gettree {id} {
3823 global treefilelist treeidlist diffids diffmergeid treepending
3825 set diffids $id
3826 catch {unset diffmergeid}
3827 if {![info exists treefilelist($id)]} {
3828 if {![info exists treepending]} {
3829 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3830 return
3832 set treepending $id
3833 set treefilelist($id) {}
3834 set treeidlist($id) {}
3835 fconfigure $gtf -blocking 0
3836 fileevent $gtf readable [list gettreeline $gtf $id]
3838 } else {
3839 setfilelist $id
3843 proc gettreeline {gtf id} {
3844 global treefilelist treeidlist treepending cmitmode diffids
3846 while {[gets $gtf line] >= 0} {
3847 if {[lindex $line 1] ne "blob"} continue
3848 set sha1 [lindex $line 2]
3849 set fname [lindex $line 3]
3850 lappend treefilelist($id) $fname
3851 lappend treeidlist($id) $sha1
3853 if {![eof $gtf]} return
3854 close $gtf
3855 unset treepending
3856 if {$cmitmode ne "tree"} {
3857 if {![info exists diffmergeid]} {
3858 gettreediffs $diffids
3860 } elseif {$id ne $diffids} {
3861 gettree $diffids
3862 } else {
3863 setfilelist $id
3867 proc showfile {f} {
3868 global treefilelist treeidlist diffids
3869 global ctext commentend
3871 set i [lsearch -exact $treefilelist($diffids) $f]
3872 if {$i < 0} {
3873 puts "oops, $f not in list for id $diffids"
3874 return
3876 set blob [lindex $treeidlist($diffids) $i]
3877 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3878 puts "oops, error reading blob $blob: $err"
3879 return
3881 fconfigure $bf -blocking 0
3882 fileevent $bf readable [list getblobline $bf $diffids]
3883 $ctext config -state normal
3884 $ctext delete $commentend end
3885 $ctext insert end "\n"
3886 $ctext insert end "$f\n" filesep
3887 $ctext config -state disabled
3888 $ctext yview $commentend
3891 proc getblobline {bf id} {
3892 global diffids cmitmode ctext
3894 if {$id ne $diffids || $cmitmode ne "tree"} {
3895 catch {close $bf}
3896 return
3898 $ctext config -state normal
3899 while {[gets $bf line] >= 0} {
3900 $ctext insert end "$line\n"
3902 if {[eof $bf]} {
3903 # delete last newline
3904 $ctext delete "end - 2c" "end - 1c"
3905 close $bf
3907 $ctext config -state disabled
3910 proc mergediff {id l} {
3911 global diffmergeid diffopts mdifffd
3912 global diffids
3913 global parentlist
3915 set diffmergeid $id
3916 set diffids $id
3917 # this doesn't seem to actually affect anything...
3918 set env(GIT_DIFF_OPTS) $diffopts
3919 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3920 if {[catch {set mdf [open $cmd r]} err]} {
3921 error_popup "Error getting merge diffs: $err"
3922 return
3924 fconfigure $mdf -blocking 0
3925 set mdifffd($id) $mdf
3926 set np [llength [lindex $parentlist $l]]
3927 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3928 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3931 proc getmergediffline {mdf id np} {
3932 global diffmergeid ctext cflist nextupdate mergemax
3933 global difffilestart mdifffd
3935 set n [gets $mdf line]
3936 if {$n < 0} {
3937 if {[eof $mdf]} {
3938 close $mdf
3940 return
3942 if {![info exists diffmergeid] || $id != $diffmergeid
3943 || $mdf != $mdifffd($id)} {
3944 return
3946 $ctext conf -state normal
3947 if {[regexp {^diff --cc (.*)} $line match fname]} {
3948 # start of a new file
3949 $ctext insert end "\n"
3950 set here [$ctext index "end - 1c"]
3951 lappend difffilestart $here
3952 add_flist [list $fname]
3953 set l [expr {(78 - [string length $fname]) / 2}]
3954 set pad [string range "----------------------------------------" 1 $l]
3955 $ctext insert end "$pad $fname $pad\n" filesep
3956 } elseif {[regexp {^@@} $line]} {
3957 $ctext insert end "$line\n" hunksep
3958 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3959 # do nothing
3960 } else {
3961 # parse the prefix - one ' ', '-' or '+' for each parent
3962 set spaces {}
3963 set minuses {}
3964 set pluses {}
3965 set isbad 0
3966 for {set j 0} {$j < $np} {incr j} {
3967 set c [string range $line $j $j]
3968 if {$c == " "} {
3969 lappend spaces $j
3970 } elseif {$c == "-"} {
3971 lappend minuses $j
3972 } elseif {$c == "+"} {
3973 lappend pluses $j
3974 } else {
3975 set isbad 1
3976 break
3979 set tags {}
3980 set num {}
3981 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3982 # line doesn't appear in result, parents in $minuses have the line
3983 set num [lindex $minuses 0]
3984 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3985 # line appears in result, parents in $pluses don't have the line
3986 lappend tags mresult
3987 set num [lindex $spaces 0]
3989 if {$num ne {}} {
3990 if {$num >= $mergemax} {
3991 set num "max"
3993 lappend tags m$num
3995 $ctext insert end "$line\n" $tags
3997 $ctext conf -state disabled
3998 if {[clock clicks -milliseconds] >= $nextupdate} {
3999 incr nextupdate 100
4000 fileevent $mdf readable {}
4001 update
4002 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4006 proc startdiff {ids} {
4007 global treediffs diffids treepending diffmergeid
4009 set diffids $ids
4010 catch {unset diffmergeid}
4011 if {![info exists treediffs($ids)]} {
4012 if {![info exists treepending]} {
4013 gettreediffs $ids
4015 } else {
4016 addtocflist $ids
4020 proc addtocflist {ids} {
4021 global treediffs cflist
4022 add_flist $treediffs($ids)
4023 getblobdiffs $ids
4026 proc gettreediffs {ids} {
4027 global treediff treepending
4028 set treepending $ids
4029 set treediff {}
4030 if {[catch \
4031 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4032 ]} return
4033 fconfigure $gdtf -blocking 0
4034 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4037 proc gettreediffline {gdtf ids} {
4038 global treediff treediffs treepending diffids diffmergeid
4039 global cmitmode
4041 set n [gets $gdtf line]
4042 if {$n < 0} {
4043 if {![eof $gdtf]} return
4044 close $gdtf
4045 set treediffs($ids) $treediff
4046 unset treepending
4047 if {$cmitmode eq "tree"} {
4048 gettree $diffids
4049 } elseif {$ids != $diffids} {
4050 if {![info exists diffmergeid]} {
4051 gettreediffs $diffids
4053 } else {
4054 addtocflist $ids
4056 return
4058 set file [lindex $line 5]
4059 lappend treediff $file
4062 proc getblobdiffs {ids} {
4063 global diffopts blobdifffd diffids env curdifftag curtagstart
4064 global nextupdate diffinhdr treediffs
4066 set env(GIT_DIFF_OPTS) $diffopts
4067 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4068 if {[catch {set bdf [open $cmd r]} err]} {
4069 puts "error getting diffs: $err"
4070 return
4072 set diffinhdr 0
4073 fconfigure $bdf -blocking 0
4074 set blobdifffd($ids) $bdf
4075 set curdifftag Comments
4076 set curtagstart 0.0
4077 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4078 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4081 proc setinlist {var i val} {
4082 global $var
4084 while {[llength [set $var]] < $i} {
4085 lappend $var {}
4087 if {[llength [set $var]] == $i} {
4088 lappend $var $val
4089 } else {
4090 lset $var $i $val
4094 proc getblobdiffline {bdf ids} {
4095 global diffids blobdifffd ctext curdifftag curtagstart
4096 global diffnexthead diffnextnote difffilestart
4097 global nextupdate diffinhdr treediffs
4099 set n [gets $bdf line]
4100 if {$n < 0} {
4101 if {[eof $bdf]} {
4102 close $bdf
4103 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4104 $ctext tag add $curdifftag $curtagstart end
4107 return
4109 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4110 return
4112 $ctext conf -state normal
4113 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4114 # start of a new file
4115 $ctext insert end "\n"
4116 $ctext tag add $curdifftag $curtagstart end
4117 set here [$ctext index "end - 1c"]
4118 set curtagstart $here
4119 set header $newname
4120 set i [lsearch -exact $treediffs($ids) $fname]
4121 if {$i >= 0} {
4122 setinlist difffilestart $i $here
4124 if {$newname ne $fname} {
4125 set i [lsearch -exact $treediffs($ids) $newname]
4126 if {$i >= 0} {
4127 setinlist difffilestart $i $here
4130 set curdifftag "f:$fname"
4131 $ctext tag delete $curdifftag
4132 set l [expr {(78 - [string length $header]) / 2}]
4133 set pad [string range "----------------------------------------" 1 $l]
4134 $ctext insert end "$pad $header $pad\n" filesep
4135 set diffinhdr 1
4136 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4137 # do nothing
4138 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4139 set diffinhdr 0
4140 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4141 $line match f1l f1c f2l f2c rest]} {
4142 $ctext insert end "$line\n" hunksep
4143 set diffinhdr 0
4144 } else {
4145 set x [string range $line 0 0]
4146 if {$x == "-" || $x == "+"} {
4147 set tag [expr {$x == "+"}]
4148 $ctext insert end "$line\n" d$tag
4149 } elseif {$x == " "} {
4150 $ctext insert end "$line\n"
4151 } elseif {$diffinhdr || $x == "\\"} {
4152 # e.g. "\ No newline at end of file"
4153 $ctext insert end "$line\n" filesep
4154 } else {
4155 # Something else we don't recognize
4156 if {$curdifftag != "Comments"} {
4157 $ctext insert end "\n"
4158 $ctext tag add $curdifftag $curtagstart end
4159 set curtagstart [$ctext index "end - 1c"]
4160 set curdifftag Comments
4162 $ctext insert end "$line\n" filesep
4165 $ctext conf -state disabled
4166 if {[clock clicks -milliseconds] >= $nextupdate} {
4167 incr nextupdate 100
4168 fileevent $bdf readable {}
4169 update
4170 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4174 proc nextfile {} {
4175 global difffilestart ctext
4176 set here [$ctext index @0,0]
4177 foreach loc $difffilestart {
4178 if {[$ctext compare $loc > $here]} {
4179 $ctext yview $loc
4184 proc setcoords {} {
4185 global linespc charspc canvx0 canvy0 mainfont
4186 global xspc1 xspc2 lthickness
4188 set linespc [font metrics $mainfont -linespace]
4189 set charspc [font measure $mainfont "m"]
4190 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4191 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4192 set lthickness [expr {int($linespc / 9) + 1}]
4193 set xspc1(0) $linespc
4194 set xspc2 $linespc
4197 proc redisplay {} {
4198 global canv
4199 global selectedline
4201 set ymax [lindex [$canv cget -scrollregion] 3]
4202 if {$ymax eq {} || $ymax == 0} return
4203 set span [$canv yview]
4204 clear_display
4205 setcanvscroll
4206 allcanvs yview moveto [lindex $span 0]
4207 drawvisible
4208 if {[info exists selectedline]} {
4209 selectline $selectedline 0
4213 proc incrfont {inc} {
4214 global mainfont textfont ctext canv phase
4215 global stopped entries
4216 unmarkmatches
4217 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4218 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4219 setcoords
4220 $ctext conf -font $textfont
4221 $ctext tag conf filesep -font [concat $textfont bold]
4222 foreach e $entries {
4223 $e conf -font $mainfont
4225 if {$phase eq "getcommits"} {
4226 $canv itemconf textitems -font $mainfont
4228 redisplay
4231 proc clearsha1 {} {
4232 global sha1entry sha1string
4233 if {[string length $sha1string] == 40} {
4234 $sha1entry delete 0 end
4238 proc sha1change {n1 n2 op} {
4239 global sha1string currentid sha1but
4240 if {$sha1string == {}
4241 || ([info exists currentid] && $sha1string == $currentid)} {
4242 set state disabled
4243 } else {
4244 set state normal
4246 if {[$sha1but cget -state] == $state} return
4247 if {$state == "normal"} {
4248 $sha1but conf -state normal -relief raised -text "Goto: "
4249 } else {
4250 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4254 proc gotocommit {} {
4255 global sha1string currentid commitrow tagids headids
4256 global displayorder numcommits curview
4258 if {$sha1string == {}
4259 || ([info exists currentid] && $sha1string == $currentid)} return
4260 if {[info exists tagids($sha1string)]} {
4261 set id $tagids($sha1string)
4262 } elseif {[info exists headids($sha1string)]} {
4263 set id $headids($sha1string)
4264 } else {
4265 set id [string tolower $sha1string]
4266 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4267 set matches {}
4268 foreach i $displayorder {
4269 if {[string match $id* $i]} {
4270 lappend matches $i
4273 if {$matches ne {}} {
4274 if {[llength $matches] > 1} {
4275 error_popup "Short SHA1 id $id is ambiguous"
4276 return
4278 set id [lindex $matches 0]
4282 if {[info exists commitrow($curview,$id)]} {
4283 selectline $commitrow($curview,$id) 1
4284 return
4286 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4287 set type "SHA1 id"
4288 } else {
4289 set type "Tag/Head"
4291 error_popup "$type $sha1string is not known"
4294 proc lineenter {x y id} {
4295 global hoverx hovery hoverid hovertimer
4296 global commitinfo canv
4298 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4299 set hoverx $x
4300 set hovery $y
4301 set hoverid $id
4302 if {[info exists hovertimer]} {
4303 after cancel $hovertimer
4305 set hovertimer [after 500 linehover]
4306 $canv delete hover
4309 proc linemotion {x y id} {
4310 global hoverx hovery hoverid hovertimer
4312 if {[info exists hoverid] && $id == $hoverid} {
4313 set hoverx $x
4314 set hovery $y
4315 if {[info exists hovertimer]} {
4316 after cancel $hovertimer
4318 set hovertimer [after 500 linehover]
4322 proc lineleave {id} {
4323 global hoverid hovertimer canv
4325 if {[info exists hoverid] && $id == $hoverid} {
4326 $canv delete hover
4327 if {[info exists hovertimer]} {
4328 after cancel $hovertimer
4329 unset hovertimer
4331 unset hoverid
4335 proc linehover {} {
4336 global hoverx hovery hoverid hovertimer
4337 global canv linespc lthickness
4338 global commitinfo mainfont
4340 set text [lindex $commitinfo($hoverid) 0]
4341 set ymax [lindex [$canv cget -scrollregion] 3]
4342 if {$ymax == {}} return
4343 set yfrac [lindex [$canv yview] 0]
4344 set x [expr {$hoverx + 2 * $linespc}]
4345 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4346 set x0 [expr {$x - 2 * $lthickness}]
4347 set y0 [expr {$y - 2 * $lthickness}]
4348 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4349 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4350 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4351 -fill \#ffff80 -outline black -width 1 -tags hover]
4352 $canv raise $t
4353 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4354 $canv raise $t
4357 proc clickisonarrow {id y} {
4358 global lthickness
4360 set ranges [rowranges $id]
4361 set thresh [expr {2 * $lthickness + 6}]
4362 set n [expr {[llength $ranges] - 1}]
4363 for {set i 1} {$i < $n} {incr i} {
4364 set row [lindex $ranges $i]
4365 if {abs([yc $row] - $y) < $thresh} {
4366 return $i
4369 return {}
4372 proc arrowjump {id n y} {
4373 global canv
4375 # 1 <-> 2, 3 <-> 4, etc...
4376 set n [expr {(($n - 1) ^ 1) + 1}]
4377 set row [lindex [rowranges $id] $n]
4378 set yt [yc $row]
4379 set ymax [lindex [$canv cget -scrollregion] 3]
4380 if {$ymax eq {} || $ymax <= 0} return
4381 set view [$canv yview]
4382 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4383 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4384 if {$yfrac < 0} {
4385 set yfrac 0
4387 allcanvs yview moveto $yfrac
4390 proc lineclick {x y id isnew} {
4391 global ctext commitinfo children canv thickerline curview
4393 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4394 unmarkmatches
4395 unselectline
4396 normalline
4397 $canv delete hover
4398 # draw this line thicker than normal
4399 set thickerline $id
4400 drawlines $id
4401 if {$isnew} {
4402 set ymax [lindex [$canv cget -scrollregion] 3]
4403 if {$ymax eq {}} return
4404 set yfrac [lindex [$canv yview] 0]
4405 set y [expr {$y + $yfrac * $ymax}]
4407 set dirn [clickisonarrow $id $y]
4408 if {$dirn ne {}} {
4409 arrowjump $id $dirn $y
4410 return
4413 if {$isnew} {
4414 addtohistory [list lineclick $x $y $id 0]
4416 # fill the details pane with info about this line
4417 $ctext conf -state normal
4418 $ctext delete 0.0 end
4419 $ctext tag conf link -foreground blue -underline 1
4420 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4421 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4422 $ctext insert end "Parent:\t"
4423 $ctext insert end $id [list link link0]
4424 $ctext tag bind link0 <1> [list selbyid $id]
4425 set info $commitinfo($id)
4426 $ctext insert end "\n\t[lindex $info 0]\n"
4427 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4428 set date [formatdate [lindex $info 2]]
4429 $ctext insert end "\tDate:\t$date\n"
4430 set kids $children($curview,$id)
4431 if {$kids ne {}} {
4432 $ctext insert end "\nChildren:"
4433 set i 0
4434 foreach child $kids {
4435 incr i
4436 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4437 set info $commitinfo($child)
4438 $ctext insert end "\n\t"
4439 $ctext insert end $child [list link link$i]
4440 $ctext tag bind link$i <1> [list selbyid $child]
4441 $ctext insert end "\n\t[lindex $info 0]"
4442 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4443 set date [formatdate [lindex $info 2]]
4444 $ctext insert end "\n\tDate:\t$date\n"
4447 $ctext conf -state disabled
4448 init_flist {}
4451 proc normalline {} {
4452 global thickerline
4453 if {[info exists thickerline]} {
4454 set id $thickerline
4455 unset thickerline
4456 drawlines $id
4460 proc selbyid {id} {
4461 global commitrow curview
4462 if {[info exists commitrow($curview,$id)]} {
4463 selectline $commitrow($curview,$id) 1
4467 proc mstime {} {
4468 global startmstime
4469 if {![info exists startmstime]} {
4470 set startmstime [clock clicks -milliseconds]
4472 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4475 proc rowmenu {x y id} {
4476 global rowctxmenu commitrow selectedline rowmenuid curview
4478 if {![info exists selectedline]
4479 || $commitrow($curview,$id) eq $selectedline} {
4480 set state disabled
4481 } else {
4482 set state normal
4484 $rowctxmenu entryconfigure 0 -state $state
4485 $rowctxmenu entryconfigure 1 -state $state
4486 $rowctxmenu entryconfigure 2 -state $state
4487 set rowmenuid $id
4488 tk_popup $rowctxmenu $x $y
4491 proc diffvssel {dirn} {
4492 global rowmenuid selectedline displayorder
4494 if {![info exists selectedline]} return
4495 if {$dirn} {
4496 set oldid [lindex $displayorder $selectedline]
4497 set newid $rowmenuid
4498 } else {
4499 set oldid $rowmenuid
4500 set newid [lindex $displayorder $selectedline]
4502 addtohistory [list doseldiff $oldid $newid]
4503 doseldiff $oldid $newid
4506 proc doseldiff {oldid newid} {
4507 global ctext
4508 global commitinfo
4510 $ctext conf -state normal
4511 $ctext delete 0.0 end
4512 init_flist "Top"
4513 $ctext insert end "From "
4514 $ctext tag conf link -foreground blue -underline 1
4515 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4516 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4517 $ctext tag bind link0 <1> [list selbyid $oldid]
4518 $ctext insert end $oldid [list link link0]
4519 $ctext insert end "\n "
4520 $ctext insert end [lindex $commitinfo($oldid) 0]
4521 $ctext insert end "\n\nTo "
4522 $ctext tag bind link1 <1> [list selbyid $newid]
4523 $ctext insert end $newid [list link link1]
4524 $ctext insert end "\n "
4525 $ctext insert end [lindex $commitinfo($newid) 0]
4526 $ctext insert end "\n"
4527 $ctext conf -state disabled
4528 $ctext tag delete Comments
4529 $ctext tag remove found 1.0 end
4530 startdiff [list $oldid $newid]
4533 proc mkpatch {} {
4534 global rowmenuid currentid commitinfo patchtop patchnum
4536 if {![info exists currentid]} return
4537 set oldid $currentid
4538 set oldhead [lindex $commitinfo($oldid) 0]
4539 set newid $rowmenuid
4540 set newhead [lindex $commitinfo($newid) 0]
4541 set top .patch
4542 set patchtop $top
4543 catch {destroy $top}
4544 toplevel $top
4545 label $top.title -text "Generate patch"
4546 grid $top.title - -pady 10
4547 label $top.from -text "From:"
4548 entry $top.fromsha1 -width 40 -relief flat
4549 $top.fromsha1 insert 0 $oldid
4550 $top.fromsha1 conf -state readonly
4551 grid $top.from $top.fromsha1 -sticky w
4552 entry $top.fromhead -width 60 -relief flat
4553 $top.fromhead insert 0 $oldhead
4554 $top.fromhead conf -state readonly
4555 grid x $top.fromhead -sticky w
4556 label $top.to -text "To:"
4557 entry $top.tosha1 -width 40 -relief flat
4558 $top.tosha1 insert 0 $newid
4559 $top.tosha1 conf -state readonly
4560 grid $top.to $top.tosha1 -sticky w
4561 entry $top.tohead -width 60 -relief flat
4562 $top.tohead insert 0 $newhead
4563 $top.tohead conf -state readonly
4564 grid x $top.tohead -sticky w
4565 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4566 grid $top.rev x -pady 10
4567 label $top.flab -text "Output file:"
4568 entry $top.fname -width 60
4569 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4570 incr patchnum
4571 grid $top.flab $top.fname -sticky w
4572 frame $top.buts
4573 button $top.buts.gen -text "Generate" -command mkpatchgo
4574 button $top.buts.can -text "Cancel" -command mkpatchcan
4575 grid $top.buts.gen $top.buts.can
4576 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4577 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4578 grid $top.buts - -pady 10 -sticky ew
4579 focus $top.fname
4582 proc mkpatchrev {} {
4583 global patchtop
4585 set oldid [$patchtop.fromsha1 get]
4586 set oldhead [$patchtop.fromhead get]
4587 set newid [$patchtop.tosha1 get]
4588 set newhead [$patchtop.tohead get]
4589 foreach e [list fromsha1 fromhead tosha1 tohead] \
4590 v [list $newid $newhead $oldid $oldhead] {
4591 $patchtop.$e conf -state normal
4592 $patchtop.$e delete 0 end
4593 $patchtop.$e insert 0 $v
4594 $patchtop.$e conf -state readonly
4598 proc mkpatchgo {} {
4599 global patchtop
4601 set oldid [$patchtop.fromsha1 get]
4602 set newid [$patchtop.tosha1 get]
4603 set fname [$patchtop.fname get]
4604 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4605 error_popup "Error creating patch: $err"
4607 catch {destroy $patchtop}
4608 unset patchtop
4611 proc mkpatchcan {} {
4612 global patchtop
4614 catch {destroy $patchtop}
4615 unset patchtop
4618 proc mktag {} {
4619 global rowmenuid mktagtop commitinfo
4621 set top .maketag
4622 set mktagtop $top
4623 catch {destroy $top}
4624 toplevel $top
4625 label $top.title -text "Create tag"
4626 grid $top.title - -pady 10
4627 label $top.id -text "ID:"
4628 entry $top.sha1 -width 40 -relief flat
4629 $top.sha1 insert 0 $rowmenuid
4630 $top.sha1 conf -state readonly
4631 grid $top.id $top.sha1 -sticky w
4632 entry $top.head -width 60 -relief flat
4633 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4634 $top.head conf -state readonly
4635 grid x $top.head -sticky w
4636 label $top.tlab -text "Tag name:"
4637 entry $top.tag -width 60
4638 grid $top.tlab $top.tag -sticky w
4639 frame $top.buts
4640 button $top.buts.gen -text "Create" -command mktaggo
4641 button $top.buts.can -text "Cancel" -command mktagcan
4642 grid $top.buts.gen $top.buts.can
4643 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4644 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4645 grid $top.buts - -pady 10 -sticky ew
4646 focus $top.tag
4649 proc domktag {} {
4650 global mktagtop env tagids idtags
4652 set id [$mktagtop.sha1 get]
4653 set tag [$mktagtop.tag get]
4654 if {$tag == {}} {
4655 error_popup "No tag name specified"
4656 return
4658 if {[info exists tagids($tag)]} {
4659 error_popup "Tag \"$tag\" already exists"
4660 return
4662 if {[catch {
4663 set dir [gitdir]
4664 set fname [file join $dir "refs/tags" $tag]
4665 set f [open $fname w]
4666 puts $f $id
4667 close $f
4668 } err]} {
4669 error_popup "Error creating tag: $err"
4670 return
4673 set tagids($tag) $id
4674 lappend idtags($id) $tag
4675 redrawtags $id
4678 proc redrawtags {id} {
4679 global canv linehtag commitrow idpos selectedline curview
4681 if {![info exists commitrow($curview,$id)]} return
4682 drawcmitrow $commitrow($curview,$id)
4683 $canv delete tag.$id
4684 set xt [eval drawtags $id $idpos($id)]
4685 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4686 if {[info exists selectedline]
4687 && $selectedline == $commitrow($curview,$id)} {
4688 selectline $selectedline 0
4692 proc mktagcan {} {
4693 global mktagtop
4695 catch {destroy $mktagtop}
4696 unset mktagtop
4699 proc mktaggo {} {
4700 domktag
4701 mktagcan
4704 proc writecommit {} {
4705 global rowmenuid wrcomtop commitinfo wrcomcmd
4707 set top .writecommit
4708 set wrcomtop $top
4709 catch {destroy $top}
4710 toplevel $top
4711 label $top.title -text "Write commit to file"
4712 grid $top.title - -pady 10
4713 label $top.id -text "ID:"
4714 entry $top.sha1 -width 40 -relief flat
4715 $top.sha1 insert 0 $rowmenuid
4716 $top.sha1 conf -state readonly
4717 grid $top.id $top.sha1 -sticky w
4718 entry $top.head -width 60 -relief flat
4719 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4720 $top.head conf -state readonly
4721 grid x $top.head -sticky w
4722 label $top.clab -text "Command:"
4723 entry $top.cmd -width 60 -textvariable wrcomcmd
4724 grid $top.clab $top.cmd -sticky w -pady 10
4725 label $top.flab -text "Output file:"
4726 entry $top.fname -width 60
4727 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4728 grid $top.flab $top.fname -sticky w
4729 frame $top.buts
4730 button $top.buts.gen -text "Write" -command wrcomgo
4731 button $top.buts.can -text "Cancel" -command wrcomcan
4732 grid $top.buts.gen $top.buts.can
4733 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4734 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4735 grid $top.buts - -pady 10 -sticky ew
4736 focus $top.fname
4739 proc wrcomgo {} {
4740 global wrcomtop
4742 set id [$wrcomtop.sha1 get]
4743 set cmd "echo $id | [$wrcomtop.cmd get]"
4744 set fname [$wrcomtop.fname get]
4745 if {[catch {exec sh -c $cmd >$fname &} err]} {
4746 error_popup "Error writing commit: $err"
4748 catch {destroy $wrcomtop}
4749 unset wrcomtop
4752 proc wrcomcan {} {
4753 global wrcomtop
4755 catch {destroy $wrcomtop}
4756 unset wrcomtop
4759 proc listrefs {id} {
4760 global idtags idheads idotherrefs
4762 set x {}
4763 if {[info exists idtags($id)]} {
4764 set x $idtags($id)
4766 set y {}
4767 if {[info exists idheads($id)]} {
4768 set y $idheads($id)
4770 set z {}
4771 if {[info exists idotherrefs($id)]} {
4772 set z $idotherrefs($id)
4774 return [list $x $y $z]
4777 proc rereadrefs {} {
4778 global idtags idheads idotherrefs
4780 set refids [concat [array names idtags] \
4781 [array names idheads] [array names idotherrefs]]
4782 foreach id $refids {
4783 if {![info exists ref($id)]} {
4784 set ref($id) [listrefs $id]
4787 readrefs
4788 set refids [lsort -unique [concat $refids [array names idtags] \
4789 [array names idheads] [array names idotherrefs]]]
4790 foreach id $refids {
4791 set v [listrefs $id]
4792 if {![info exists ref($id)] || $ref($id) != $v} {
4793 redrawtags $id
4798 proc showtag {tag isnew} {
4799 global ctext tagcontents tagids linknum
4801 if {$isnew} {
4802 addtohistory [list showtag $tag 0]
4804 $ctext conf -state normal
4805 $ctext delete 0.0 end
4806 set linknum 0
4807 if {[info exists tagcontents($tag)]} {
4808 set text $tagcontents($tag)
4809 } else {
4810 set text "Tag: $tag\nId: $tagids($tag)"
4812 appendwithlinks $text
4813 $ctext conf -state disabled
4814 init_flist {}
4817 proc doquit {} {
4818 global stopped
4819 set stopped 100
4820 destroy .
4823 proc doprefs {} {
4824 global maxwidth maxgraphpct diffopts findmergefiles
4825 global oldprefs prefstop
4827 set top .gitkprefs
4828 set prefstop $top
4829 if {[winfo exists $top]} {
4830 raise $top
4831 return
4833 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4834 set oldprefs($v) [set $v]
4836 toplevel $top
4837 wm title $top "Gitk preferences"
4838 label $top.ldisp -text "Commit list display options"
4839 grid $top.ldisp - -sticky w -pady 10
4840 label $top.spacer -text " "
4841 label $top.maxwidthl -text "Maximum graph width (lines)" \
4842 -font optionfont
4843 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4844 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4845 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4846 -font optionfont
4847 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4848 grid x $top.maxpctl $top.maxpct -sticky w
4849 checkbutton $top.findm -variable findmergefiles
4850 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4851 -font optionfont
4852 grid $top.findm $top.findml - -sticky w
4853 label $top.ddisp -text "Diff display options"
4854 grid $top.ddisp - -sticky w -pady 10
4855 label $top.diffoptl -text "Options for diff program" \
4856 -font optionfont
4857 entry $top.diffopt -width 20 -textvariable diffopts
4858 grid x $top.diffoptl $top.diffopt -sticky w
4859 frame $top.buts
4860 button $top.buts.ok -text "OK" -command prefsok
4861 button $top.buts.can -text "Cancel" -command prefscan
4862 grid $top.buts.ok $top.buts.can
4863 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4864 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4865 grid $top.buts - - -pady 10 -sticky ew
4868 proc prefscan {} {
4869 global maxwidth maxgraphpct diffopts findmergefiles
4870 global oldprefs prefstop
4872 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4873 set $v $oldprefs($v)
4875 catch {destroy $prefstop}
4876 unset prefstop
4879 proc prefsok {} {
4880 global maxwidth maxgraphpct
4881 global oldprefs prefstop
4883 catch {destroy $prefstop}
4884 unset prefstop
4885 if {$maxwidth != $oldprefs(maxwidth)
4886 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4887 redisplay
4891 proc formatdate {d} {
4892 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4895 # This list of encoding names and aliases is distilled from
4896 # http://www.iana.org/assignments/character-sets.
4897 # Not all of them are supported by Tcl.
4898 set encoding_aliases {
4899 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4900 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4901 { ISO-10646-UTF-1 csISO10646UTF1 }
4902 { ISO_646.basic:1983 ref csISO646basic1983 }
4903 { INVARIANT csINVARIANT }
4904 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4905 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4906 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4907 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4908 { NATS-DANO iso-ir-9-1 csNATSDANO }
4909 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4910 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4911 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4912 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4913 { ISO-2022-KR csISO2022KR }
4914 { EUC-KR csEUCKR }
4915 { ISO-2022-JP csISO2022JP }
4916 { ISO-2022-JP-2 csISO2022JP2 }
4917 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4918 csISO13JISC6220jp }
4919 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4920 { IT iso-ir-15 ISO646-IT csISO15Italian }
4921 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4922 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4923 { greek7-old iso-ir-18 csISO18Greek7Old }
4924 { latin-greek iso-ir-19 csISO19LatinGreek }
4925 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4926 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4927 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4928 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4929 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4930 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4931 { INIS iso-ir-49 csISO49INIS }
4932 { INIS-8 iso-ir-50 csISO50INIS8 }
4933 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4934 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4935 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4936 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4937 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4938 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4939 csISO60Norwegian1 }
4940 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4941 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4942 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4943 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4944 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4945 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4946 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4947 { greek7 iso-ir-88 csISO88Greek7 }
4948 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4949 { iso-ir-90 csISO90 }
4950 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4951 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4952 csISO92JISC62991984b }
4953 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4954 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4955 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4956 csISO95JIS62291984handadd }
4957 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4958 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4959 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4960 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4961 CP819 csISOLatin1 }
4962 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4963 { T.61-7bit iso-ir-102 csISO102T617bit }
4964 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4965 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4966 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4967 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4968 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4969 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4970 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4971 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4972 arabic csISOLatinArabic }
4973 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4974 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4975 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4976 greek greek8 csISOLatinGreek }
4977 { T.101-G2 iso-ir-128 csISO128T101G2 }
4978 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4979 csISOLatinHebrew }
4980 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4981 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4982 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4983 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4984 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4985 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4986 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4987 csISOLatinCyrillic }
4988 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4989 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4990 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4991 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4992 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4993 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4994 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4995 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4996 { ISO_10367-box iso-ir-155 csISO10367Box }
4997 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4998 { latin-lap lap iso-ir-158 csISO158Lap }
4999 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5000 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5001 { us-dk csUSDK }
5002 { dk-us csDKUS }
5003 { JIS_X0201 X0201 csHalfWidthKatakana }
5004 { KSC5636 ISO646-KR csKSC5636 }
5005 { ISO-10646-UCS-2 csUnicode }
5006 { ISO-10646-UCS-4 csUCS4 }
5007 { DEC-MCS dec csDECMCS }
5008 { hp-roman8 roman8 r8 csHPRoman8 }
5009 { macintosh mac csMacintosh }
5010 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5011 csIBM037 }
5012 { IBM038 EBCDIC-INT cp038 csIBM038 }
5013 { IBM273 CP273 csIBM273 }
5014 { IBM274 EBCDIC-BE CP274 csIBM274 }
5015 { IBM275 EBCDIC-BR cp275 csIBM275 }
5016 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5017 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5018 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5019 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5020 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5021 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5022 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5023 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5024 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5025 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5026 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5027 { IBM437 cp437 437 csPC8CodePage437 }
5028 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5029 { IBM775 cp775 csPC775Baltic }
5030 { IBM850 cp850 850 csPC850Multilingual }
5031 { IBM851 cp851 851 csIBM851 }
5032 { IBM852 cp852 852 csPCp852 }
5033 { IBM855 cp855 855 csIBM855 }
5034 { IBM857 cp857 857 csIBM857 }
5035 { IBM860 cp860 860 csIBM860 }
5036 { IBM861 cp861 861 cp-is csIBM861 }
5037 { IBM862 cp862 862 csPC862LatinHebrew }
5038 { IBM863 cp863 863 csIBM863 }
5039 { IBM864 cp864 csIBM864 }
5040 { IBM865 cp865 865 csIBM865 }
5041 { IBM866 cp866 866 csIBM866 }
5042 { IBM868 CP868 cp-ar csIBM868 }
5043 { IBM869 cp869 869 cp-gr csIBM869 }
5044 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5045 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5046 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5047 { IBM891 cp891 csIBM891 }
5048 { IBM903 cp903 csIBM903 }
5049 { IBM904 cp904 904 csIBBM904 }
5050 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5051 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5052 { IBM1026 CP1026 csIBM1026 }
5053 { EBCDIC-AT-DE csIBMEBCDICATDE }
5054 { EBCDIC-AT-DE-A csEBCDICATDEA }
5055 { EBCDIC-CA-FR csEBCDICCAFR }
5056 { EBCDIC-DK-NO csEBCDICDKNO }
5057 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5058 { EBCDIC-FI-SE csEBCDICFISE }
5059 { EBCDIC-FI-SE-A csEBCDICFISEA }
5060 { EBCDIC-FR csEBCDICFR }
5061 { EBCDIC-IT csEBCDICIT }
5062 { EBCDIC-PT csEBCDICPT }
5063 { EBCDIC-ES csEBCDICES }
5064 { EBCDIC-ES-A csEBCDICESA }
5065 { EBCDIC-ES-S csEBCDICESS }
5066 { EBCDIC-UK csEBCDICUK }
5067 { EBCDIC-US csEBCDICUS }
5068 { UNKNOWN-8BIT csUnknown8BiT }
5069 { MNEMONIC csMnemonic }
5070 { MNEM csMnem }
5071 { VISCII csVISCII }
5072 { VIQR csVIQR }
5073 { KOI8-R csKOI8R }
5074 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5075 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5076 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5077 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5078 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5079 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5080 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5081 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5082 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5083 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5084 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5085 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5086 { IBM1047 IBM-1047 }
5087 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5088 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5089 { UNICODE-1-1 csUnicode11 }
5090 { CESU-8 csCESU-8 }
5091 { BOCU-1 csBOCU-1 }
5092 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5093 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5094 l8 }
5095 { ISO-8859-15 ISO_8859-15 Latin-9 }
5096 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5097 { GBK CP936 MS936 windows-936 }
5098 { JIS_Encoding csJISEncoding }
5099 { Shift_JIS MS_Kanji csShiftJIS }
5100 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5101 EUC-JP }
5102 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5103 { ISO-10646-UCS-Basic csUnicodeASCII }
5104 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5105 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5106 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5107 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5108 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5109 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5110 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5111 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5112 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5113 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5114 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5115 { Ventura-US csVenturaUS }
5116 { Ventura-International csVenturaInternational }
5117 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5118 { PC8-Turkish csPC8Turkish }
5119 { IBM-Symbols csIBMSymbols }
5120 { IBM-Thai csIBMThai }
5121 { HP-Legal csHPLegal }
5122 { HP-Pi-font csHPPiFont }
5123 { HP-Math8 csHPMath8 }
5124 { Adobe-Symbol-Encoding csHPPSMath }
5125 { HP-DeskTop csHPDesktop }
5126 { Ventura-Math csVenturaMath }
5127 { Microsoft-Publishing csMicrosoftPublishing }
5128 { Windows-31J csWindows31J }
5129 { GB2312 csGB2312 }
5130 { Big5 csBig5 }
5133 proc tcl_encoding {enc} {
5134 global encoding_aliases
5135 set names [encoding names]
5136 set lcnames [string tolower $names]
5137 set enc [string tolower $enc]
5138 set i [lsearch -exact $lcnames $enc]
5139 if {$i < 0} {
5140 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5141 if {[regsub {^iso[-_]} $enc iso encx]} {
5142 set i [lsearch -exact $lcnames $encx]
5145 if {$i < 0} {
5146 foreach l $encoding_aliases {
5147 set ll [string tolower $l]
5148 if {[lsearch -exact $ll $enc] < 0} continue
5149 # look through the aliases for one that tcl knows about
5150 foreach e $ll {
5151 set i [lsearch -exact $lcnames $e]
5152 if {$i < 0} {
5153 if {[regsub {^iso[-_]} $e iso ex]} {
5154 set i [lsearch -exact $lcnames $ex]
5157 if {$i >= 0} break
5159 break
5162 if {$i >= 0} {
5163 return [lindex $names $i]
5165 return {}
5168 # defaults...
5169 set datemode 0
5170 set diffopts "-U 5 -p"
5171 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5173 set gitencoding {}
5174 catch {
5175 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5177 if {$gitencoding == ""} {
5178 set gitencoding "utf-8"
5180 set tclencoding [tcl_encoding $gitencoding]
5181 if {$tclencoding == {}} {
5182 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5185 set mainfont {Helvetica 9}
5186 set textfont {Courier 9}
5187 set uifont {Helvetica 9 bold}
5188 set findmergefiles 0
5189 set maxgraphpct 50
5190 set maxwidth 16
5191 set revlistorder 0
5192 set fastdate 0
5193 set uparrowlen 7
5194 set downarrowlen 7
5195 set mingaplen 30
5196 set cmitmode "patch"
5198 set colors {green red blue magenta darkgrey brown orange}
5200 catch {source ~/.gitk}
5202 font create optionfont -family sans-serif -size -12
5204 set revtreeargs {}
5205 foreach arg $argv {
5206 switch -regexp -- $arg {
5207 "^$" { }
5208 "^-d" { set datemode 1 }
5209 default {
5210 lappend revtreeargs $arg
5215 # check that we can find a .git directory somewhere...
5216 set gitdir [gitdir]
5217 if {![file isdirectory $gitdir]} {
5218 show_error . "Cannot find the git directory \"$gitdir\"."
5219 exit 1
5222 set cmdline_files {}
5223 set i [lsearch -exact $revtreeargs "--"]
5224 if {$i >= 0} {
5225 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5226 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5227 } elseif {$revtreeargs ne {}} {
5228 if {[catch {
5229 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5230 set cmdline_files [split $f "\n"]
5231 set n [llength $cmdline_files]
5232 set revtreeargs [lrange $revtreeargs 0 end-$n]
5233 } err]} {
5234 # unfortunately we get both stdout and stderr in $err,
5235 # so look for "fatal:".
5236 set i [string first "fatal:" $err]
5237 if {$i > 0} {
5238 set err [string range [expr {$i + 6}] end]
5240 show_error . "Bad arguments to gitk:\n$err"
5241 exit 1
5245 set history {}
5246 set historyindex 0
5247 set fh_serial 0
5248 set highlight_names {}
5249 set nhl_names {}
5250 set highlight_paths {}
5252 set optim_delay 16
5254 set nextviewnum 1
5255 set curview 0
5256 set selectedview 0
5257 set selectedhlview None
5258 set viewfiles(0) {}
5259 set viewperm(0) 0
5260 set viewargs(0) {}
5262 set cmdlineok 0
5263 set stopped 0
5264 set stuffsaved 0
5265 set patchnum 0
5266 setcoords
5267 makewindow
5268 readrefs
5270 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5271 # create a view for the files/dirs specified on the command line
5272 set curview 1
5273 set selectedview 1
5274 set nextviewnum 2
5275 set viewname(1) "Command line"
5276 set viewfiles(1) $cmdline_files
5277 set viewargs(1) $revtreeargs
5278 set viewperm(1) 0
5279 addviewmenu 1
5280 .bar.view entryconf 2 -state normal
5281 .bar.view entryconf 3 -state normal
5284 if {[info exists permviews]} {
5285 foreach v $permviews {
5286 set n $nextviewnum
5287 incr nextviewnum
5288 set viewname($n) [lindex $v 0]
5289 set viewfiles($n) [lindex $v 1]
5290 set viewargs($n) [lindex $v 2]
5291 set viewperm($n) 1
5292 addviewmenu $n
5295 getcommits