git-svn: don't allow globs to match regular files
[git/kirr.git] / gitk
blobb1c65d76806d1c26da0759569e6b83982a414bf1
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
19 proc start_rev_list {view} {
20 global startmsecs nextupdate
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 commitidx($view) 0
27 set args $viewargs($view)
28 if {$viewfiles($view) ne {}} {
29 set args [concat $args "--" $viewfiles($view)]
31 set order "--topo-order"
32 if {$datemode} {
33 set order "--date-order"
35 if {[catch {
36 set fd [open [concat | git rev-list --header $order \
37 --parents --boundary --default HEAD $args] r]
38 } err]} {
39 puts stderr "Error executing git rev-list: $err"
40 exit 1
42 set commfd($view) $fd
43 set leftover($view) {}
44 fconfigure $fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $fd -encoding $tclencoding
48 fileevent $fd readable [list getcommitlines $fd $view]
49 nowbusy $view
52 proc stop_rev_list {} {
53 global commfd curview
55 if {![info exists commfd($curview)]} return
56 set fd $commfd($curview)
57 catch {
58 set pid [pid $fd]
59 exec kill $pid
61 catch {close $fd}
62 unset commfd($curview)
65 proc getcommits {} {
66 global phase canv mainfont curview
68 set phase getcommits
69 initlayout
70 start_rev_list $curview
71 show_status "Reading commits..."
74 proc getcommitlines {fd view} {
75 global commitlisted nextupdate
76 global leftover commfd
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children curview hlview
79 global vparentlist vchildlist vdisporder vcmitlisted
81 set stuff [read $fd 500000]
82 if {$stuff == {}} {
83 if {![eof $fd]} return
84 global viewname
85 unset commfd($view)
86 notbusy $view
87 # set it blocking so we wait for the process to terminate
88 fconfigure $fd -blocking 1
89 if {[catch {close $fd} err]} {
90 set fv {}
91 if {$view != $curview} {
92 set fv " for the \"$viewname($view)\" view"
94 if {[string range $err 0 4] == "usage"} {
95 set err "Gitk: error reading commits$fv:\
96 bad arguments to git rev-list."
97 if {$viewname($view) eq "Command line"} {
98 append err \
99 " (Note: arguments to gitk are passed to git rev-list\
100 to allow selection of commits to be displayed.)"
102 } else {
103 set err "Error reading commits$fv: $err"
105 error_popup $err
107 if {$view == $curview} {
108 after idle finishcommits
110 return
112 set start 0
113 set gotsome 0
114 while 1 {
115 set i [string first "\0" $stuff $start]
116 if {$i < 0} {
117 append leftover($view) [string range $stuff $start end]
118 break
120 if {$start == 0} {
121 set cmit $leftover($view)
122 append cmit [string range $stuff 0 [expr {$i - 1}]]
123 set leftover($view) {}
124 } else {
125 set cmit [string range $stuff $start [expr {$i - 1}]]
127 set start [expr {$i + 1}]
128 set j [string first "\n" $cmit]
129 set ok 0
130 set listed 1
131 if {$j >= 0} {
132 set ids [string range $cmit 0 [expr {$j - 1}]]
133 if {[string range $ids 0 0] == "-"} {
134 set listed 0
135 set ids [string range $ids 1 end]
137 set ok 1
138 foreach id $ids {
139 if {[string length $id] != 40} {
140 set ok 0
141 break
145 if {!$ok} {
146 set shortcmit $cmit
147 if {[string length $shortcmit] > 80} {
148 set shortcmit "[string range $shortcmit 0 80]..."
150 error_popup "Can't parse git rev-list output: {$shortcmit}"
151 exit 1
153 set id [lindex $ids 0]
154 if {$listed} {
155 set olds [lrange $ids 1 end]
156 set i 0
157 foreach p $olds {
158 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
159 lappend children($view,$p) $id
161 incr i
163 } else {
164 set olds {}
166 if {![info exists children($view,$id)]} {
167 set children($view,$id) {}
169 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
170 set commitrow($view,$id) $commitidx($view)
171 incr commitidx($view)
172 if {$view == $curview} {
173 lappend parentlist $olds
174 lappend childlist $children($view,$id)
175 lappend displayorder $id
176 lappend commitlisted $listed
177 } else {
178 lappend vparentlist($view) $olds
179 lappend vchildlist($view) $children($view,$id)
180 lappend vdisporder($view) $id
181 lappend vcmitlisted($view) $listed
183 set gotsome 1
185 if {$gotsome} {
186 if {$view == $curview} {
187 while {[layoutmore $nextupdate]} doupdate
188 } elseif {[info exists hlview] && $view == $hlview} {
189 vhighlightmore
192 if {[clock clicks -milliseconds] >= $nextupdate} {
193 doupdate
197 proc doupdate {} {
198 global commfd nextupdate numcommits
200 foreach v [array names commfd] {
201 fileevent $commfd($v) readable {}
203 update
204 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
205 foreach v [array names commfd] {
206 set fd $commfd($v)
207 fileevent $fd readable [list getcommitlines $fd $v]
211 proc readcommit {id} {
212 if {[catch {set contents [exec git cat-file commit $id]}]} return
213 parsecommit $id $contents 0
216 proc updatecommits {} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
220 if {$phase ne {}} {
221 stop_rev_list
222 set phase {}
224 set n $curview
225 foreach id $displayorder {
226 catch {unset children($n,$id)}
227 catch {unset commitrow($n,$id)}
229 set curview -1
230 catch {unset selectedline}
231 catch {unset thickerline}
232 catch {unset viewdata($n)}
233 discardallcommits
234 readrefs
235 showview $n
238 proc parsecommit {id contents listed} {
239 global commitinfo cdate
241 set inhdr 1
242 set comment {}
243 set headline {}
244 set auname {}
245 set audate {}
246 set comname {}
247 set comdate {}
248 set hdrend [string first "\n\n" $contents]
249 if {$hdrend < 0} {
250 # should never happen...
251 set hdrend [string length $contents]
253 set header [string range $contents 0 [expr {$hdrend - 1}]]
254 set comment [string range $contents [expr {$hdrend + 2}] end]
255 foreach line [split $header "\n"] {
256 set tag [lindex $line 0]
257 if {$tag == "author"} {
258 set audate [lindex $line end-1]
259 set auname [lrange $line 1 end-2]
260 } elseif {$tag == "committer"} {
261 set comdate [lindex $line end-1]
262 set comname [lrange $line 1 end-2]
265 set headline {}
266 # take the first line of the comment as the headline
267 set i [string first "\n" $comment]
268 if {$i >= 0} {
269 set headline [string trim [string range $comment 0 $i]]
270 } else {
271 set headline $comment
273 if {!$listed} {
274 # git rev-list indents the comment by 4 spaces;
275 # if we got this via git cat-file, add the indentation
276 set newcomment {}
277 foreach line [split $comment "\n"] {
278 append newcomment " "
279 append newcomment $line
280 append newcomment "\n"
282 set comment $newcomment
284 if {$comdate != {}} {
285 set cdate($id) $comdate
287 set commitinfo($id) [list $headline $auname $audate \
288 $comname $comdate $comment]
291 proc getcommit {id} {
292 global commitdata commitinfo
294 if {[info exists commitdata($id)]} {
295 parsecommit $id $commitdata($id) 1
296 } else {
297 readcommit $id
298 if {![info exists commitinfo($id)]} {
299 set commitinfo($id) {"No commit information available"}
302 return 1
305 proc readrefs {} {
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs mainhead
309 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
310 catch {unset $v}
312 set refd [open [list | git show-ref] r]
313 while {0 <= [set n [gets $refd line]]} {
314 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
315 match id path]} {
316 continue
318 if {[regexp {^remotes/.*/HEAD$} $path match]} {
319 continue
321 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
322 set type others
323 set name $path
325 if {[regexp {^remotes/} $path match]} {
326 set type heads
328 if {$type == "tags"} {
329 set tagids($name) $id
330 lappend idtags($id) $name
331 set obj {}
332 set type {}
333 set tag {}
334 catch {
335 set commit [exec git rev-parse "$id^0"]
336 if {$commit != $id} {
337 set tagids($name) $commit
338 lappend idtags($commit) $name
341 catch {
342 set tagcontents($name) [exec git cat-file tag $id]
344 } elseif { $type == "heads" } {
345 set headids($name) $id
346 lappend idheads($id) $name
347 } else {
348 set otherrefids($name) $id
349 lappend idotherrefs($id) $name
352 close $refd
353 set mainhead {}
354 catch {
355 set thehead [exec git symbolic-ref HEAD]
356 if {[string match "refs/heads/*" $thehead]} {
357 set mainhead [string range $thehead 11 end]
362 proc show_error {w top 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 $top"
366 pack $w.ok -side bottom -fill x
367 bind $top <Visibility> "grab $top; focus $top"
368 bind $top <Key-Return> "destroy $top"
369 tkwait window $top
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $w $msg
379 proc confirm_popup msg {
380 global confirm_ok
381 set confirm_ok 0
382 set w .confirm
383 toplevel $w
384 wm transient $w .
385 message $w.m -text $msg -justify center -aspect 400
386 pack $w.m -side top -fill x -padx 20 -pady 20
387 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
388 pack $w.ok -side left -fill x
389 button $w.cancel -text Cancel -command "destroy $w"
390 pack $w.cancel -side right -fill x
391 bind $w <Visibility> "grab $w; focus $w"
392 tkwait window $w
393 return $confirm_ok
396 proc makewindow {} {
397 global canv canv2 canv3 linespc charspc ctext cflist
398 global textfont mainfont uifont
399 global findtype findtypemenu findloc findstring fstring geometry
400 global entries sha1entry sha1string sha1but
401 global maincursor textcursor curtextcursor
402 global rowctxmenu mergemax wrapcomment
403 global highlight_files gdttype
404 global searchstring sstring
405 global bgcolor fgcolor bglist fglist diffcolors
406 global headctxmenu
408 menu .bar
409 .bar add cascade -label "File" -menu .bar.file
410 .bar configure -font $uifont
411 menu .bar.file
412 .bar.file add command -label "Update" -command updatecommits
413 .bar.file add command -label "Reread references" -command rereadrefs
414 .bar.file add command -label "Quit" -command doquit
415 .bar.file configure -font $uifont
416 menu .bar.edit
417 .bar add cascade -label "Edit" -menu .bar.edit
418 .bar.edit add command -label "Preferences" -command doprefs
419 .bar.edit configure -font $uifont
421 menu .bar.view -font $uifont
422 .bar add cascade -label "View" -menu .bar.view
423 .bar.view add command -label "New view..." -command {newview 0}
424 .bar.view add command -label "Edit view..." -command editview \
425 -state disabled
426 .bar.view add command -label "Delete view" -command delview -state disabled
427 .bar.view add separator
428 .bar.view add radiobutton -label "All files" -command {showview 0} \
429 -variable selectedview -value 0
431 menu .bar.help
432 .bar add cascade -label "Help" -menu .bar.help
433 .bar.help add command -label "About gitk" -command about
434 .bar.help add command -label "Key bindings" -command keys
435 .bar.help configure -font $uifont
436 . configure -menu .bar
438 # the gui has upper and lower half, parts of a paned window.
439 panedwindow .ctop -orient vertical
441 # possibly use assumed geometry
442 if {![info exists geometry(pwsash0)]} {
443 set geometry(topheight) [expr {15 * $linespc}]
444 set geometry(topwidth) [expr {80 * $charspc}]
445 set geometry(botheight) [expr {15 * $linespc}]
446 set geometry(botwidth) [expr {50 * $charspc}]
447 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
448 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
451 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
452 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
453 frame .tf.histframe
454 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
456 # create three canvases
457 set cscroll .tf.histframe.csb
458 set canv .tf.histframe.pwclist.canv
459 canvas $canv \
460 -background $bgcolor -bd 0 \
461 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
462 .tf.histframe.pwclist add $canv
463 set canv2 .tf.histframe.pwclist.canv2
464 canvas $canv2 \
465 -background $bgcolor -bd 0 -yscrollincr $linespc
466 .tf.histframe.pwclist add $canv2
467 set canv3 .tf.histframe.pwclist.canv3
468 canvas $canv3 \
469 -background $bgcolor -bd 0 -yscrollincr $linespc
470 .tf.histframe.pwclist add $canv3
471 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
472 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
474 # a scroll bar to rule them
475 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
476 pack $cscroll -side right -fill y
477 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
478 lappend bglist $canv $canv2 $canv3
479 pack .tf.histframe.pwclist -fill both -expand 1 -side left
481 # we have two button bars at bottom of top frame. Bar 1
482 frame .tf.bar
483 frame .tf.lbar -height 15
485 set sha1entry .tf.bar.sha1
486 set entries $sha1entry
487 set sha1but .tf.bar.sha1label
488 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
489 -command gotocommit -width 8 -font $uifont
490 $sha1but conf -disabledforeground [$sha1but cget -foreground]
491 pack .tf.bar.sha1label -side left
492 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
493 trace add variable sha1string write sha1change
494 pack $sha1entry -side left -pady 2
496 image create bitmap bm-left -data {
497 #define left_width 16
498 #define left_height 16
499 static unsigned char left_bits[] = {
500 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
501 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
502 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
504 image create bitmap bm-right -data {
505 #define right_width 16
506 #define right_height 16
507 static unsigned char right_bits[] = {
508 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
509 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
510 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
512 button .tf.bar.leftbut -image bm-left -command goback \
513 -state disabled -width 26
514 pack .tf.bar.leftbut -side left -fill y
515 button .tf.bar.rightbut -image bm-right -command goforw \
516 -state disabled -width 26
517 pack .tf.bar.rightbut -side left -fill y
519 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
520 pack .tf.bar.findbut -side left
521 set findstring {}
522 set fstring .tf.bar.findstring
523 lappend entries $fstring
524 entry $fstring -width 30 -font $textfont -textvariable findstring
525 trace add variable findstring write find_change
526 pack $fstring -side left -expand 1 -fill x -in .tf.bar
527 set findtype Exact
528 set findtypemenu [tk_optionMenu .tf.bar.findtype \
529 findtype Exact IgnCase Regexp]
530 trace add variable findtype write find_change
531 .tf.bar.findtype configure -font $uifont
532 .tf.bar.findtype.menu configure -font $uifont
533 set findloc "All fields"
534 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
535 Comments Author Committer
536 trace add variable findloc write find_change
537 .tf.bar.findloc configure -font $uifont
538 .tf.bar.findloc.menu configure -font $uifont
539 pack .tf.bar.findloc -side right
540 pack .tf.bar.findtype -side right
542 # build up the bottom bar of upper window
543 label .tf.lbar.flabel -text "Highlight: Commits " \
544 -font $uifont
545 pack .tf.lbar.flabel -side left -fill y
546 set gdttype "touching paths:"
547 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
548 "adding/removing string:"]
549 trace add variable gdttype write hfiles_change
550 $gm conf -font $uifont
551 .tf.lbar.gdttype conf -font $uifont
552 pack .tf.lbar.gdttype -side left -fill y
553 entry .tf.lbar.fent -width 25 -font $textfont \
554 -textvariable highlight_files
555 trace add variable highlight_files write hfiles_change
556 lappend entries .tf.lbar.fent
557 pack .tf.lbar.fent -side left -fill x -expand 1
558 label .tf.lbar.vlabel -text " OR in view" -font $uifont
559 pack .tf.lbar.vlabel -side left -fill y
560 global viewhlmenu selectedhlview
561 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
562 $viewhlmenu entryconf None -command delvhighlight
563 $viewhlmenu conf -font $uifont
564 .tf.lbar.vhl conf -font $uifont
565 pack .tf.lbar.vhl -side left -fill y
566 label .tf.lbar.rlabel -text " OR " -font $uifont
567 pack .tf.lbar.rlabel -side left -fill y
568 global highlight_related
569 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
570 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
571 $m conf -font $uifont
572 .tf.lbar.relm conf -font $uifont
573 trace add variable highlight_related write vrel_change
574 pack .tf.lbar.relm -side left -fill y
576 # Finish putting the upper half of the viewer together
577 pack .tf.lbar -in .tf -side bottom -fill x
578 pack .tf.bar -in .tf -side bottom -fill x
579 pack .tf.histframe -fill both -side top -expand 1
580 .ctop add .tf
581 .ctop paneconfigure .tf -height $geometry(topheight)
582 .ctop paneconfigure .tf -width $geometry(topwidth)
584 # now build up the bottom
585 panedwindow .pwbottom -orient horizontal
587 # lower left, a text box over search bar, scroll bar to the right
588 # if we know window height, then that will set the lower text height, otherwise
589 # we set lower text height which will drive window height
590 if {[info exists geometry(main)]} {
591 frame .bleft -width $geometry(botwidth)
592 } else {
593 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
595 frame .bleft.top
597 button .bleft.top.search -text "Search" -command dosearch \
598 -font $uifont
599 pack .bleft.top.search -side left -padx 5
600 set sstring .bleft.top.sstring
601 entry $sstring -width 20 -font $textfont -textvariable searchstring
602 lappend entries $sstring
603 trace add variable searchstring write incrsearch
604 pack $sstring -side left -expand 1 -fill x
605 set ctext .bleft.ctext
606 text $ctext -background $bgcolor -foreground $fgcolor \
607 -state disabled -font $textfont \
608 -yscrollcommand scrolltext -wrap none
609 scrollbar .bleft.sb -command "$ctext yview"
610 pack .bleft.top -side top -fill x
611 pack .bleft.sb -side right -fill y
612 pack $ctext -side left -fill both -expand 1
613 lappend bglist $ctext
614 lappend fglist $ctext
616 $ctext tag conf comment -wrap $wrapcomment
617 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
618 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
619 $ctext tag conf d0 -fore [lindex $diffcolors 0]
620 $ctext tag conf d1 -fore [lindex $diffcolors 1]
621 $ctext tag conf m0 -fore red
622 $ctext tag conf m1 -fore blue
623 $ctext tag conf m2 -fore green
624 $ctext tag conf m3 -fore purple
625 $ctext tag conf m4 -fore brown
626 $ctext tag conf m5 -fore "#009090"
627 $ctext tag conf m6 -fore magenta
628 $ctext tag conf m7 -fore "#808000"
629 $ctext tag conf m8 -fore "#009000"
630 $ctext tag conf m9 -fore "#ff0080"
631 $ctext tag conf m10 -fore cyan
632 $ctext tag conf m11 -fore "#b07070"
633 $ctext tag conf m12 -fore "#70b0f0"
634 $ctext tag conf m13 -fore "#70f0b0"
635 $ctext tag conf m14 -fore "#f0b070"
636 $ctext tag conf m15 -fore "#ff70b0"
637 $ctext tag conf mmax -fore darkgrey
638 set mergemax 16
639 $ctext tag conf mresult -font [concat $textfont bold]
640 $ctext tag conf msep -font [concat $textfont bold]
641 $ctext tag conf found -back yellow
643 .pwbottom add .bleft
644 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
646 # lower right
647 frame .bright
648 frame .bright.mode
649 radiobutton .bright.mode.patch -text "Patch" \
650 -command reselectline -variable cmitmode -value "patch"
651 .bright.mode.patch configure -font $uifont
652 radiobutton .bright.mode.tree -text "Tree" \
653 -command reselectline -variable cmitmode -value "tree"
654 .bright.mode.tree configure -font $uifont
655 grid .bright.mode.patch .bright.mode.tree -sticky ew
656 pack .bright.mode -side top -fill x
657 set cflist .bright.cfiles
658 set indent [font measure $mainfont "nn"]
659 text $cflist \
660 -background $bgcolor -foreground $fgcolor \
661 -font $mainfont \
662 -tabs [list $indent [expr {2 * $indent}]] \
663 -yscrollcommand ".bright.sb set" \
664 -cursor [. cget -cursor] \
665 -spacing1 1 -spacing3 1
666 lappend bglist $cflist
667 lappend fglist $cflist
668 scrollbar .bright.sb -command "$cflist yview"
669 pack .bright.sb -side right -fill y
670 pack $cflist -side left -fill both -expand 1
671 $cflist tag configure highlight \
672 -background [$cflist cget -selectbackground]
673 $cflist tag configure bold -font [concat $mainfont bold]
675 .pwbottom add .bright
676 .ctop add .pwbottom
678 # restore window position if known
679 if {[info exists geometry(main)]} {
680 wm geometry . "$geometry(main)"
683 bind .pwbottom <Configure> {resizecdetpanes %W %w}
684 pack .ctop -fill both -expand 1
685 bindall <1> {selcanvline %W %x %y}
686 #bindall <B1-Motion> {selcanvline %W %x %y}
687 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
688 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
689 bindall <2> "canvscan mark %W %x %y"
690 bindall <B2-Motion> "canvscan dragto %W %x %y"
691 bindkey <Home> selfirstline
692 bindkey <End> sellastline
693 bind . <Key-Up> "selnextline -1"
694 bind . <Key-Down> "selnextline 1"
695 bind . <Shift-Key-Up> "next_highlight -1"
696 bind . <Shift-Key-Down> "next_highlight 1"
697 bindkey <Key-Right> "goforw"
698 bindkey <Key-Left> "goback"
699 bind . <Key-Prior> "selnextpage -1"
700 bind . <Key-Next> "selnextpage 1"
701 bind . <Control-Home> "allcanvs yview moveto 0.0"
702 bind . <Control-End> "allcanvs yview moveto 1.0"
703 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
704 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
705 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
706 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
707 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
708 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
709 bindkey <Key-space> "$ctext yview scroll 1 pages"
710 bindkey p "selnextline -1"
711 bindkey n "selnextline 1"
712 bindkey z "goback"
713 bindkey x "goforw"
714 bindkey i "selnextline -1"
715 bindkey k "selnextline 1"
716 bindkey j "goback"
717 bindkey l "goforw"
718 bindkey b "$ctext yview scroll -1 pages"
719 bindkey d "$ctext yview scroll 18 units"
720 bindkey u "$ctext yview scroll -18 units"
721 bindkey / {findnext 1}
722 bindkey <Key-Return> {findnext 0}
723 bindkey ? findprev
724 bindkey f nextfile
725 bindkey <F5> updatecommits
726 bind . <Control-q> doquit
727 bind . <Control-f> dofind
728 bind . <Control-g> {findnext 0}
729 bind . <Control-r> dosearchback
730 bind . <Control-s> dosearch
731 bind . <Control-equal> {incrfont 1}
732 bind . <Control-KP_Add> {incrfont 1}
733 bind . <Control-minus> {incrfont -1}
734 bind . <Control-KP_Subtract> {incrfont -1}
735 wm protocol . WM_DELETE_WINDOW doquit
736 bind . <Button-1> "click %W"
737 bind $fstring <Key-Return> dofind
738 bind $sha1entry <Key-Return> gotocommit
739 bind $sha1entry <<PasteSelection>> clearsha1
740 bind $cflist <1> {sel_flist %W %x %y; break}
741 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
742 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
744 set maincursor [. cget -cursor]
745 set textcursor [$ctext cget -cursor]
746 set curtextcursor $textcursor
748 set rowctxmenu .rowctxmenu
749 menu $rowctxmenu -tearoff 0
750 $rowctxmenu add command -label "Diff this -> selected" \
751 -command {diffvssel 0}
752 $rowctxmenu add command -label "Diff selected -> this" \
753 -command {diffvssel 1}
754 $rowctxmenu add command -label "Make patch" -command mkpatch
755 $rowctxmenu add command -label "Create tag" -command mktag
756 $rowctxmenu add command -label "Write commit to file" -command writecommit
757 $rowctxmenu add command -label "Create new branch" -command mkbranch
758 $rowctxmenu add command -label "Cherry-pick this commit" \
759 -command cherrypick
761 set headctxmenu .headctxmenu
762 menu $headctxmenu -tearoff 0
763 $headctxmenu add command -label "Check out this branch" \
764 -command cobranch
765 $headctxmenu add command -label "Remove this branch" \
766 -command rmbranch
769 # mouse-2 makes all windows scan vertically, but only the one
770 # the cursor is in scans horizontally
771 proc canvscan {op w x y} {
772 global canv canv2 canv3
773 foreach c [list $canv $canv2 $canv3] {
774 if {$c == $w} {
775 $c scan $op $x $y
776 } else {
777 $c scan $op 0 $y
782 proc scrollcanv {cscroll f0 f1} {
783 $cscroll set $f0 $f1
784 drawfrac $f0 $f1
785 flushhighlights
788 # when we make a key binding for the toplevel, make sure
789 # it doesn't get triggered when that key is pressed in the
790 # find string entry widget.
791 proc bindkey {ev script} {
792 global entries
793 bind . $ev $script
794 set escript [bind Entry $ev]
795 if {$escript == {}} {
796 set escript [bind Entry <Key>]
798 foreach e $entries {
799 bind $e $ev "$escript; break"
803 # set the focus back to the toplevel for any click outside
804 # the entry widgets
805 proc click {w} {
806 global entries
807 foreach e $entries {
808 if {$w == $e} return
810 focus .
813 proc savestuff {w} {
814 global canv canv2 canv3 ctext cflist mainfont textfont uifont
815 global stuffsaved findmergefiles maxgraphpct
816 global maxwidth showneartags
817 global viewname viewfiles viewargs viewperm nextviewnum
818 global cmitmode wrapcomment
819 global colors bgcolor fgcolor diffcolors
821 if {$stuffsaved} return
822 if {![winfo viewable .]} return
823 catch {
824 set f [open "~/.gitk-new" w]
825 puts $f [list set mainfont $mainfont]
826 puts $f [list set textfont $textfont]
827 puts $f [list set uifont $uifont]
828 puts $f [list set findmergefiles $findmergefiles]
829 puts $f [list set maxgraphpct $maxgraphpct]
830 puts $f [list set maxwidth $maxwidth]
831 puts $f [list set cmitmode $cmitmode]
832 puts $f [list set wrapcomment $wrapcomment]
833 puts $f [list set showneartags $showneartags]
834 puts $f [list set bgcolor $bgcolor]
835 puts $f [list set fgcolor $fgcolor]
836 puts $f [list set colors $colors]
837 puts $f [list set diffcolors $diffcolors]
839 puts $f "set geometry(main) [wm geometry .]"
840 puts $f "set geometry(topwidth) [winfo width .tf]"
841 puts $f "set geometry(topheight) [winfo height .tf]"
842 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
843 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
844 puts $f "set geometry(botwidth) [winfo width .bleft]"
845 puts $f "set geometry(botheight) [winfo height .bleft]"
847 puts -nonewline $f "set permviews {"
848 for {set v 0} {$v < $nextviewnum} {incr v} {
849 if {$viewperm($v)} {
850 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
853 puts $f "}"
854 close $f
855 file rename -force "~/.gitk-new" "~/.gitk"
857 set stuffsaved 1
860 proc resizeclistpanes {win w} {
861 global oldwidth
862 if {[info exists oldwidth($win)]} {
863 set s0 [$win sash coord 0]
864 set s1 [$win sash coord 1]
865 if {$w < 60} {
866 set sash0 [expr {int($w/2 - 2)}]
867 set sash1 [expr {int($w*5/6 - 2)}]
868 } else {
869 set factor [expr {1.0 * $w / $oldwidth($win)}]
870 set sash0 [expr {int($factor * [lindex $s0 0])}]
871 set sash1 [expr {int($factor * [lindex $s1 0])}]
872 if {$sash0 < 30} {
873 set sash0 30
875 if {$sash1 < $sash0 + 20} {
876 set sash1 [expr {$sash0 + 20}]
878 if {$sash1 > $w - 10} {
879 set sash1 [expr {$w - 10}]
880 if {$sash0 > $sash1 - 20} {
881 set sash0 [expr {$sash1 - 20}]
885 $win sash place 0 $sash0 [lindex $s0 1]
886 $win sash place 1 $sash1 [lindex $s1 1]
888 set oldwidth($win) $w
891 proc resizecdetpanes {win w} {
892 global oldwidth
893 if {[info exists oldwidth($win)]} {
894 set s0 [$win sash coord 0]
895 if {$w < 60} {
896 set sash0 [expr {int($w*3/4 - 2)}]
897 } else {
898 set factor [expr {1.0 * $w / $oldwidth($win)}]
899 set sash0 [expr {int($factor * [lindex $s0 0])}]
900 if {$sash0 < 45} {
901 set sash0 45
903 if {$sash0 > $w - 15} {
904 set sash0 [expr {$w - 15}]
907 $win sash place 0 $sash0 [lindex $s0 1]
909 set oldwidth($win) $w
912 proc allcanvs args {
913 global canv canv2 canv3
914 eval $canv $args
915 eval $canv2 $args
916 eval $canv3 $args
919 proc bindall {event action} {
920 global canv canv2 canv3
921 bind $canv $event $action
922 bind $canv2 $event $action
923 bind $canv3 $event $action
926 proc about {} {
927 global uifont
928 set w .about
929 if {[winfo exists $w]} {
930 raise $w
931 return
933 toplevel $w
934 wm title $w "About gitk"
935 message $w.m -text {
936 Gitk - a commit viewer for git
938 Copyright © 2005-2006 Paul Mackerras
940 Use and redistribute under the terms of the GNU General Public License} \
941 -justify center -aspect 400 -border 2 -bg white -relief groove
942 pack $w.m -side top -fill x -padx 2 -pady 2
943 $w.m configure -font $uifont
944 button $w.ok -text Close -command "destroy $w" -default active
945 pack $w.ok -side bottom
946 $w.ok configure -font $uifont
947 bind $w <Visibility> "focus $w.ok"
948 bind $w <Key-Escape> "destroy $w"
949 bind $w <Key-Return> "destroy $w"
952 proc keys {} {
953 global uifont
954 set w .keys
955 if {[winfo exists $w]} {
956 raise $w
957 return
959 toplevel $w
960 wm title $w "Gitk key bindings"
961 message $w.m -text {
962 Gitk key bindings:
964 <Ctrl-Q> Quit
965 <Home> Move to first commit
966 <End> Move to last commit
967 <Up>, p, i Move up one commit
968 <Down>, n, k Move down one commit
969 <Left>, z, j Go back in history list
970 <Right>, x, l Go forward in history list
971 <PageUp> Move up one page in commit list
972 <PageDown> Move down one page in commit list
973 <Ctrl-Home> Scroll to top of commit list
974 <Ctrl-End> Scroll to bottom of commit list
975 <Ctrl-Up> Scroll commit list up one line
976 <Ctrl-Down> Scroll commit list down one line
977 <Ctrl-PageUp> Scroll commit list up one page
978 <Ctrl-PageDown> Scroll commit list down one page
979 <Shift-Up> Move to previous highlighted line
980 <Shift-Down> Move to next highlighted line
981 <Delete>, b Scroll diff view up one page
982 <Backspace> Scroll diff view up one page
983 <Space> Scroll diff view down one page
984 u Scroll diff view up 18 lines
985 d Scroll diff view down 18 lines
986 <Ctrl-F> Find
987 <Ctrl-G> Move to next find hit
988 <Return> Move to next find hit
989 / Move to next find hit, or redo find
990 ? Move to previous find hit
991 f Scroll diff view to next file
992 <Ctrl-S> Search for next hit in diff view
993 <Ctrl-R> Search for previous hit in diff view
994 <Ctrl-KP+> Increase font size
995 <Ctrl-plus> Increase font size
996 <Ctrl-KP-> Decrease font size
997 <Ctrl-minus> Decrease font size
998 <F5> Update
1000 -justify left -bg white -border 2 -relief groove
1001 pack $w.m -side top -fill both -padx 2 -pady 2
1002 $w.m configure -font $uifont
1003 button $w.ok -text Close -command "destroy $w" -default active
1004 pack $w.ok -side bottom
1005 $w.ok configure -font $uifont
1006 bind $w <Visibility> "focus $w.ok"
1007 bind $w <Key-Escape> "destroy $w"
1008 bind $w <Key-Return> "destroy $w"
1011 # Procedures for manipulating the file list window at the
1012 # bottom right of the overall window.
1014 proc treeview {w l openlevs} {
1015 global treecontents treediropen treeheight treeparent treeindex
1017 set ix 0
1018 set treeindex() 0
1019 set lev 0
1020 set prefix {}
1021 set prefixend -1
1022 set prefendstack {}
1023 set htstack {}
1024 set ht 0
1025 set treecontents() {}
1026 $w conf -state normal
1027 foreach f $l {
1028 while {[string range $f 0 $prefixend] ne $prefix} {
1029 if {$lev <= $openlevs} {
1030 $w mark set e:$treeindex($prefix) "end -1c"
1031 $w mark gravity e:$treeindex($prefix) left
1033 set treeheight($prefix) $ht
1034 incr ht [lindex $htstack end]
1035 set htstack [lreplace $htstack end end]
1036 set prefixend [lindex $prefendstack end]
1037 set prefendstack [lreplace $prefendstack end end]
1038 set prefix [string range $prefix 0 $prefixend]
1039 incr lev -1
1041 set tail [string range $f [expr {$prefixend+1}] end]
1042 while {[set slash [string first "/" $tail]] >= 0} {
1043 lappend htstack $ht
1044 set ht 0
1045 lappend prefendstack $prefixend
1046 incr prefixend [expr {$slash + 1}]
1047 set d [string range $tail 0 $slash]
1048 lappend treecontents($prefix) $d
1049 set oldprefix $prefix
1050 append prefix $d
1051 set treecontents($prefix) {}
1052 set treeindex($prefix) [incr ix]
1053 set treeparent($prefix) $oldprefix
1054 set tail [string range $tail [expr {$slash+1}] end]
1055 if {$lev <= $openlevs} {
1056 set ht 1
1057 set treediropen($prefix) [expr {$lev < $openlevs}]
1058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1059 $w mark set d:$ix "end -1c"
1060 $w mark gravity d:$ix left
1061 set str "\n"
1062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1063 $w insert end $str
1064 $w image create end -align center -image $bm -padx 1 \
1065 -name a:$ix
1066 $w insert end $d [highlight_tag $prefix]
1067 $w mark set s:$ix "end -1c"
1068 $w mark gravity s:$ix left
1070 incr lev
1072 if {$tail ne {}} {
1073 if {$lev <= $openlevs} {
1074 incr ht
1075 set str "\n"
1076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1077 $w insert end $str
1078 $w insert end $tail [highlight_tag $f]
1080 lappend treecontents($prefix) $tail
1083 while {$htstack ne {}} {
1084 set treeheight($prefix) $ht
1085 incr ht [lindex $htstack end]
1086 set htstack [lreplace $htstack end end]
1088 $w conf -state disabled
1091 proc linetoelt {l} {
1092 global treeheight treecontents
1094 set y 2
1095 set prefix {}
1096 while {1} {
1097 foreach e $treecontents($prefix) {
1098 if {$y == $l} {
1099 return "$prefix$e"
1101 set n 1
1102 if {[string index $e end] eq "/"} {
1103 set n $treeheight($prefix$e)
1104 if {$y + $n > $l} {
1105 append prefix $e
1106 incr y
1107 break
1110 incr y $n
1115 proc highlight_tree {y prefix} {
1116 global treeheight treecontents cflist
1118 foreach e $treecontents($prefix) {
1119 set path $prefix$e
1120 if {[highlight_tag $path] ne {}} {
1121 $cflist tag add bold $y.0 "$y.0 lineend"
1123 incr y
1124 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1125 set y [highlight_tree $y $path]
1128 return $y
1131 proc treeclosedir {w dir} {
1132 global treediropen treeheight treeparent treeindex
1134 set ix $treeindex($dir)
1135 $w conf -state normal
1136 $w delete s:$ix e:$ix
1137 set treediropen($dir) 0
1138 $w image configure a:$ix -image tri-rt
1139 $w conf -state disabled
1140 set n [expr {1 - $treeheight($dir)}]
1141 while {$dir ne {}} {
1142 incr treeheight($dir) $n
1143 set dir $treeparent($dir)
1147 proc treeopendir {w dir} {
1148 global treediropen treeheight treeparent treecontents treeindex
1150 set ix $treeindex($dir)
1151 $w conf -state normal
1152 $w image configure a:$ix -image tri-dn
1153 $w mark set e:$ix s:$ix
1154 $w mark gravity e:$ix right
1155 set lev 0
1156 set str "\n"
1157 set n [llength $treecontents($dir)]
1158 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1159 incr lev
1160 append str "\t"
1161 incr treeheight($x) $n
1163 foreach e $treecontents($dir) {
1164 set de $dir$e
1165 if {[string index $e end] eq "/"} {
1166 set iy $treeindex($de)
1167 $w mark set d:$iy e:$ix
1168 $w mark gravity d:$iy left
1169 $w insert e:$ix $str
1170 set treediropen($de) 0
1171 $w image create e:$ix -align center -image tri-rt -padx 1 \
1172 -name a:$iy
1173 $w insert e:$ix $e [highlight_tag $de]
1174 $w mark set s:$iy e:$ix
1175 $w mark gravity s:$iy left
1176 set treeheight($de) 1
1177 } else {
1178 $w insert e:$ix $str
1179 $w insert e:$ix $e [highlight_tag $de]
1182 $w mark gravity e:$ix left
1183 $w conf -state disabled
1184 set treediropen($dir) 1
1185 set top [lindex [split [$w index @0,0] .] 0]
1186 set ht [$w cget -height]
1187 set l [lindex [split [$w index s:$ix] .] 0]
1188 if {$l < $top} {
1189 $w yview $l.0
1190 } elseif {$l + $n + 1 > $top + $ht} {
1191 set top [expr {$l + $n + 2 - $ht}]
1192 if {$l < $top} {
1193 set top $l
1195 $w yview $top.0
1199 proc treeclick {w x y} {
1200 global treediropen cmitmode ctext cflist cflist_top
1202 if {$cmitmode ne "tree"} return
1203 if {![info exists cflist_top]} return
1204 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1205 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1206 $cflist tag add highlight $l.0 "$l.0 lineend"
1207 set cflist_top $l
1208 if {$l == 1} {
1209 $ctext yview 1.0
1210 return
1212 set e [linetoelt $l]
1213 if {[string index $e end] ne "/"} {
1214 showfile $e
1215 } elseif {$treediropen($e)} {
1216 treeclosedir $w $e
1217 } else {
1218 treeopendir $w $e
1222 proc setfilelist {id} {
1223 global treefilelist cflist
1225 treeview $cflist $treefilelist($id) 0
1228 image create bitmap tri-rt -background black -foreground blue -data {
1229 #define tri-rt_width 13
1230 #define tri-rt_height 13
1231 static unsigned char tri-rt_bits[] = {
1232 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1233 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1234 0x00, 0x00};
1235 } -maskdata {
1236 #define tri-rt-mask_width 13
1237 #define tri-rt-mask_height 13
1238 static unsigned char tri-rt-mask_bits[] = {
1239 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1240 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1241 0x08, 0x00};
1243 image create bitmap tri-dn -background black -foreground blue -data {
1244 #define tri-dn_width 13
1245 #define tri-dn_height 13
1246 static unsigned char tri-dn_bits[] = {
1247 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1248 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1249 0x00, 0x00};
1250 } -maskdata {
1251 #define tri-dn-mask_width 13
1252 #define tri-dn-mask_height 13
1253 static unsigned char tri-dn-mask_bits[] = {
1254 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1255 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1256 0x00, 0x00};
1259 proc init_flist {first} {
1260 global cflist cflist_top selectedline difffilestart
1262 $cflist conf -state normal
1263 $cflist delete 0.0 end
1264 if {$first ne {}} {
1265 $cflist insert end $first
1266 set cflist_top 1
1267 $cflist tag add highlight 1.0 "1.0 lineend"
1268 } else {
1269 catch {unset cflist_top}
1271 $cflist conf -state disabled
1272 set difffilestart {}
1275 proc highlight_tag {f} {
1276 global highlight_paths
1278 foreach p $highlight_paths {
1279 if {[string match $p $f]} {
1280 return "bold"
1283 return {}
1286 proc highlight_filelist {} {
1287 global cmitmode cflist
1289 $cflist conf -state normal
1290 if {$cmitmode ne "tree"} {
1291 set end [lindex [split [$cflist index end] .] 0]
1292 for {set l 2} {$l < $end} {incr l} {
1293 set line [$cflist get $l.0 "$l.0 lineend"]
1294 if {[highlight_tag $line] ne {}} {
1295 $cflist tag add bold $l.0 "$l.0 lineend"
1298 } else {
1299 highlight_tree 2 {}
1301 $cflist conf -state disabled
1304 proc unhighlight_filelist {} {
1305 global cflist
1307 $cflist conf -state normal
1308 $cflist tag remove bold 1.0 end
1309 $cflist conf -state disabled
1312 proc add_flist {fl} {
1313 global cflist
1315 $cflist conf -state normal
1316 foreach f $fl {
1317 $cflist insert end "\n"
1318 $cflist insert end $f [highlight_tag $f]
1320 $cflist conf -state disabled
1323 proc sel_flist {w x y} {
1324 global ctext difffilestart cflist cflist_top cmitmode
1326 if {$cmitmode eq "tree"} return
1327 if {![info exists cflist_top]} return
1328 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1329 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1330 $cflist tag add highlight $l.0 "$l.0 lineend"
1331 set cflist_top $l
1332 if {$l == 1} {
1333 $ctext yview 1.0
1334 } else {
1335 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1339 # Functions for adding and removing shell-type quoting
1341 proc shellquote {str} {
1342 if {![string match "*\['\"\\ \t]*" $str]} {
1343 return $str
1345 if {![string match "*\['\"\\]*" $str]} {
1346 return "\"$str\""
1348 if {![string match "*'*" $str]} {
1349 return "'$str'"
1351 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1354 proc shellarglist {l} {
1355 set str {}
1356 foreach a $l {
1357 if {$str ne {}} {
1358 append str " "
1360 append str [shellquote $a]
1362 return $str
1365 proc shelldequote {str} {
1366 set ret {}
1367 set used -1
1368 while {1} {
1369 incr used
1370 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1371 append ret [string range $str $used end]
1372 set used [string length $str]
1373 break
1375 set first [lindex $first 0]
1376 set ch [string index $str $first]
1377 if {$first > $used} {
1378 append ret [string range $str $used [expr {$first - 1}]]
1379 set used $first
1381 if {$ch eq " " || $ch eq "\t"} break
1382 incr used
1383 if {$ch eq "'"} {
1384 set first [string first "'" $str $used]
1385 if {$first < 0} {
1386 error "unmatched single-quote"
1388 append ret [string range $str $used [expr {$first - 1}]]
1389 set used $first
1390 continue
1392 if {$ch eq "\\"} {
1393 if {$used >= [string length $str]} {
1394 error "trailing backslash"
1396 append ret [string index $str $used]
1397 continue
1399 # here ch == "\""
1400 while {1} {
1401 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1402 error "unmatched double-quote"
1404 set first [lindex $first 0]
1405 set ch [string index $str $first]
1406 if {$first > $used} {
1407 append ret [string range $str $used [expr {$first - 1}]]
1408 set used $first
1410 if {$ch eq "\""} break
1411 incr used
1412 append ret [string index $str $used]
1413 incr used
1416 return [list $used $ret]
1419 proc shellsplit {str} {
1420 set l {}
1421 while {1} {
1422 set str [string trimleft $str]
1423 if {$str eq {}} break
1424 set dq [shelldequote $str]
1425 set n [lindex $dq 0]
1426 set word [lindex $dq 1]
1427 set str [string range $str $n end]
1428 lappend l $word
1430 return $l
1433 # Code to implement multiple views
1435 proc newview {ishighlight} {
1436 global nextviewnum newviewname newviewperm uifont newishighlight
1437 global newviewargs revtreeargs
1439 set newishighlight $ishighlight
1440 set top .gitkview
1441 if {[winfo exists $top]} {
1442 raise $top
1443 return
1445 set newviewname($nextviewnum) "View $nextviewnum"
1446 set newviewperm($nextviewnum) 0
1447 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1448 vieweditor $top $nextviewnum "Gitk view definition"
1451 proc editview {} {
1452 global curview
1453 global viewname viewperm newviewname newviewperm
1454 global viewargs newviewargs
1456 set top .gitkvedit-$curview
1457 if {[winfo exists $top]} {
1458 raise $top
1459 return
1461 set newviewname($curview) $viewname($curview)
1462 set newviewperm($curview) $viewperm($curview)
1463 set newviewargs($curview) [shellarglist $viewargs($curview)]
1464 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1467 proc vieweditor {top n title} {
1468 global newviewname newviewperm viewfiles
1469 global uifont
1471 toplevel $top
1472 wm title $top $title
1473 label $top.nl -text "Name" -font $uifont
1474 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1475 grid $top.nl $top.name -sticky w -pady 5
1476 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1477 -font $uifont
1478 grid $top.perm - -pady 5 -sticky w
1479 message $top.al -aspect 1000 -font $uifont \
1480 -text "Commits to include (arguments to git rev-list):"
1481 grid $top.al - -sticky w -pady 5
1482 entry $top.args -width 50 -textvariable newviewargs($n) \
1483 -background white -font $uifont
1484 grid $top.args - -sticky ew -padx 5
1485 message $top.l -aspect 1000 -font $uifont \
1486 -text "Enter files and directories to include, one per line:"
1487 grid $top.l - -sticky w
1488 text $top.t -width 40 -height 10 -background white -font $uifont
1489 if {[info exists viewfiles($n)]} {
1490 foreach f $viewfiles($n) {
1491 $top.t insert end $f
1492 $top.t insert end "\n"
1494 $top.t delete {end - 1c} end
1495 $top.t mark set insert 0.0
1497 grid $top.t - -sticky ew -padx 5
1498 frame $top.buts
1499 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1500 -font $uifont
1501 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1502 -font $uifont
1503 grid $top.buts.ok $top.buts.can
1504 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1505 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1506 grid $top.buts - -pady 10 -sticky ew
1507 focus $top.t
1510 proc doviewmenu {m first cmd op argv} {
1511 set nmenu [$m index end]
1512 for {set i $first} {$i <= $nmenu} {incr i} {
1513 if {[$m entrycget $i -command] eq $cmd} {
1514 eval $m $op $i $argv
1515 break
1520 proc allviewmenus {n op args} {
1521 global viewhlmenu
1523 doviewmenu .bar.view 5 [list showview $n] $op $args
1524 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1527 proc newviewok {top n} {
1528 global nextviewnum newviewperm newviewname newishighlight
1529 global viewname viewfiles viewperm selectedview curview
1530 global viewargs newviewargs viewhlmenu
1532 if {[catch {
1533 set newargs [shellsplit $newviewargs($n)]
1534 } err]} {
1535 error_popup "Error in commit selection arguments: $err"
1536 wm raise $top
1537 focus $top
1538 return
1540 set files {}
1541 foreach f [split [$top.t get 0.0 end] "\n"] {
1542 set ft [string trim $f]
1543 if {$ft ne {}} {
1544 lappend files $ft
1547 if {![info exists viewfiles($n)]} {
1548 # creating a new view
1549 incr nextviewnum
1550 set viewname($n) $newviewname($n)
1551 set viewperm($n) $newviewperm($n)
1552 set viewfiles($n) $files
1553 set viewargs($n) $newargs
1554 addviewmenu $n
1555 if {!$newishighlight} {
1556 after idle showview $n
1557 } else {
1558 after idle addvhighlight $n
1560 } else {
1561 # editing an existing view
1562 set viewperm($n) $newviewperm($n)
1563 if {$newviewname($n) ne $viewname($n)} {
1564 set viewname($n) $newviewname($n)
1565 doviewmenu .bar.view 5 [list showview $n] \
1566 entryconf [list -label $viewname($n)]
1567 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1568 entryconf [list -label $viewname($n) -value $viewname($n)]
1570 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1571 set viewfiles($n) $files
1572 set viewargs($n) $newargs
1573 if {$curview == $n} {
1574 after idle updatecommits
1578 catch {destroy $top}
1581 proc delview {} {
1582 global curview viewdata viewperm hlview selectedhlview
1584 if {$curview == 0} return
1585 if {[info exists hlview] && $hlview == $curview} {
1586 set selectedhlview None
1587 unset hlview
1589 allviewmenus $curview delete
1590 set viewdata($curview) {}
1591 set viewperm($curview) 0
1592 showview 0
1595 proc addviewmenu {n} {
1596 global viewname viewhlmenu
1598 .bar.view add radiobutton -label $viewname($n) \
1599 -command [list showview $n] -variable selectedview -value $n
1600 $viewhlmenu add radiobutton -label $viewname($n) \
1601 -command [list addvhighlight $n] -variable selectedhlview
1604 proc flatten {var} {
1605 global $var
1607 set ret {}
1608 foreach i [array names $var] {
1609 lappend ret $i [set $var\($i\)]
1611 return $ret
1614 proc unflatten {var l} {
1615 global $var
1617 catch {unset $var}
1618 foreach {i v} $l {
1619 set $var\($i\) $v
1623 proc showview {n} {
1624 global curview viewdata viewfiles
1625 global displayorder parentlist childlist rowidlist rowoffsets
1626 global colormap rowtextx commitrow nextcolor canvxmax
1627 global numcommits rowrangelist commitlisted idrowranges
1628 global selectedline currentid canv canvy0
1629 global matchinglines treediffs
1630 global pending_select phase
1631 global commitidx rowlaidout rowoptim linesegends
1632 global commfd nextupdate
1633 global selectedview
1634 global vparentlist vchildlist vdisporder vcmitlisted
1635 global hlview selectedhlview
1637 if {$n == $curview} return
1638 set selid {}
1639 if {[info exists selectedline]} {
1640 set selid $currentid
1641 set y [yc $selectedline]
1642 set ymax [lindex [$canv cget -scrollregion] 3]
1643 set span [$canv yview]
1644 set ytop [expr {[lindex $span 0] * $ymax}]
1645 set ybot [expr {[lindex $span 1] * $ymax}]
1646 if {$ytop < $y && $y < $ybot} {
1647 set yscreen [expr {$y - $ytop}]
1648 } else {
1649 set yscreen [expr {($ybot - $ytop) / 2}]
1652 unselectline
1653 normalline
1654 stopfindproc
1655 if {$curview >= 0} {
1656 set vparentlist($curview) $parentlist
1657 set vchildlist($curview) $childlist
1658 set vdisporder($curview) $displayorder
1659 set vcmitlisted($curview) $commitlisted
1660 if {$phase ne {}} {
1661 set viewdata($curview) \
1662 [list $phase $rowidlist $rowoffsets $rowrangelist \
1663 [flatten idrowranges] [flatten idinlist] \
1664 $rowlaidout $rowoptim $numcommits $linesegends]
1665 } elseif {![info exists viewdata($curview)]
1666 || [lindex $viewdata($curview) 0] ne {}} {
1667 set viewdata($curview) \
1668 [list {} $rowidlist $rowoffsets $rowrangelist]
1671 catch {unset matchinglines}
1672 catch {unset treediffs}
1673 clear_display
1674 if {[info exists hlview] && $hlview == $n} {
1675 unset hlview
1676 set selectedhlview None
1679 set curview $n
1680 set selectedview $n
1681 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1682 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1684 if {![info exists viewdata($n)]} {
1685 set pending_select $selid
1686 getcommits
1687 return
1690 set v $viewdata($n)
1691 set phase [lindex $v 0]
1692 set displayorder $vdisporder($n)
1693 set parentlist $vparentlist($n)
1694 set childlist $vchildlist($n)
1695 set commitlisted $vcmitlisted($n)
1696 set rowidlist [lindex $v 1]
1697 set rowoffsets [lindex $v 2]
1698 set rowrangelist [lindex $v 3]
1699 if {$phase eq {}} {
1700 set numcommits [llength $displayorder]
1701 catch {unset idrowranges}
1702 } else {
1703 unflatten idrowranges [lindex $v 4]
1704 unflatten idinlist [lindex $v 5]
1705 set rowlaidout [lindex $v 6]
1706 set rowoptim [lindex $v 7]
1707 set numcommits [lindex $v 8]
1708 set linesegends [lindex $v 9]
1711 catch {unset colormap}
1712 catch {unset rowtextx}
1713 set nextcolor 0
1714 set canvxmax [$canv cget -width]
1715 set curview $n
1716 set row 0
1717 setcanvscroll
1718 set yf 0
1719 set row 0
1720 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1721 set row $commitrow($n,$selid)
1722 # try to get the selected row in the same position on the screen
1723 set ymax [lindex [$canv cget -scrollregion] 3]
1724 set ytop [expr {[yc $row] - $yscreen}]
1725 if {$ytop < 0} {
1726 set ytop 0
1728 set yf [expr {$ytop * 1.0 / $ymax}]
1730 allcanvs yview moveto $yf
1731 drawvisible
1732 selectline $row 0
1733 if {$phase ne {}} {
1734 if {$phase eq "getcommits"} {
1735 show_status "Reading commits..."
1737 if {[info exists commfd($n)]} {
1738 layoutmore {}
1739 } else {
1740 finishcommits
1742 } elseif {$numcommits == 0} {
1743 show_status "No commits selected"
1747 # Stuff relating to the highlighting facility
1749 proc ishighlighted {row} {
1750 global vhighlights fhighlights nhighlights rhighlights
1752 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1753 return $nhighlights($row)
1755 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1756 return $vhighlights($row)
1758 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1759 return $fhighlights($row)
1761 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1762 return $rhighlights($row)
1764 return 0
1767 proc bolden {row font} {
1768 global canv linehtag selectedline boldrows
1770 lappend boldrows $row
1771 $canv itemconf $linehtag($row) -font $font
1772 if {[info exists selectedline] && $row == $selectedline} {
1773 $canv delete secsel
1774 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1775 -outline {{}} -tags secsel \
1776 -fill [$canv cget -selectbackground]]
1777 $canv lower $t
1781 proc bolden_name {row font} {
1782 global canv2 linentag selectedline boldnamerows
1784 lappend boldnamerows $row
1785 $canv2 itemconf $linentag($row) -font $font
1786 if {[info exists selectedline] && $row == $selectedline} {
1787 $canv2 delete secsel
1788 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1789 -outline {{}} -tags secsel \
1790 -fill [$canv2 cget -selectbackground]]
1791 $canv2 lower $t
1795 proc unbolden {} {
1796 global mainfont boldrows
1798 set stillbold {}
1799 foreach row $boldrows {
1800 if {![ishighlighted $row]} {
1801 bolden $row $mainfont
1802 } else {
1803 lappend stillbold $row
1806 set boldrows $stillbold
1809 proc addvhighlight {n} {
1810 global hlview curview viewdata vhl_done vhighlights commitidx
1812 if {[info exists hlview]} {
1813 delvhighlight
1815 set hlview $n
1816 if {$n != $curview && ![info exists viewdata($n)]} {
1817 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1818 set vparentlist($n) {}
1819 set vchildlist($n) {}
1820 set vdisporder($n) {}
1821 set vcmitlisted($n) {}
1822 start_rev_list $n
1824 set vhl_done $commitidx($hlview)
1825 if {$vhl_done > 0} {
1826 drawvisible
1830 proc delvhighlight {} {
1831 global hlview vhighlights
1833 if {![info exists hlview]} return
1834 unset hlview
1835 catch {unset vhighlights}
1836 unbolden
1839 proc vhighlightmore {} {
1840 global hlview vhl_done commitidx vhighlights
1841 global displayorder vdisporder curview mainfont
1843 set font [concat $mainfont bold]
1844 set max $commitidx($hlview)
1845 if {$hlview == $curview} {
1846 set disp $displayorder
1847 } else {
1848 set disp $vdisporder($hlview)
1850 set vr [visiblerows]
1851 set r0 [lindex $vr 0]
1852 set r1 [lindex $vr 1]
1853 for {set i $vhl_done} {$i < $max} {incr i} {
1854 set id [lindex $disp $i]
1855 if {[info exists commitrow($curview,$id)]} {
1856 set row $commitrow($curview,$id)
1857 if {$r0 <= $row && $row <= $r1} {
1858 if {![highlighted $row]} {
1859 bolden $row $font
1861 set vhighlights($row) 1
1865 set vhl_done $max
1868 proc askvhighlight {row id} {
1869 global hlview vhighlights commitrow iddrawn mainfont
1871 if {[info exists commitrow($hlview,$id)]} {
1872 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1873 bolden $row [concat $mainfont bold]
1875 set vhighlights($row) 1
1876 } else {
1877 set vhighlights($row) 0
1881 proc hfiles_change {name ix op} {
1882 global highlight_files filehighlight fhighlights fh_serial
1883 global mainfont highlight_paths
1885 if {[info exists filehighlight]} {
1886 # delete previous highlights
1887 catch {close $filehighlight}
1888 unset filehighlight
1889 catch {unset fhighlights}
1890 unbolden
1891 unhighlight_filelist
1893 set highlight_paths {}
1894 after cancel do_file_hl $fh_serial
1895 incr fh_serial
1896 if {$highlight_files ne {}} {
1897 after 300 do_file_hl $fh_serial
1901 proc makepatterns {l} {
1902 set ret {}
1903 foreach e $l {
1904 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1905 if {[string index $ee end] eq "/"} {
1906 lappend ret "$ee*"
1907 } else {
1908 lappend ret $ee
1909 lappend ret "$ee/*"
1912 return $ret
1915 proc do_file_hl {serial} {
1916 global highlight_files filehighlight highlight_paths gdttype fhl_list
1918 if {$gdttype eq "touching paths:"} {
1919 if {[catch {set paths [shellsplit $highlight_files]}]} return
1920 set highlight_paths [makepatterns $paths]
1921 highlight_filelist
1922 set gdtargs [concat -- $paths]
1923 } else {
1924 set gdtargs [list "-S$highlight_files"]
1926 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1927 set filehighlight [open $cmd r+]
1928 fconfigure $filehighlight -blocking 0
1929 fileevent $filehighlight readable readfhighlight
1930 set fhl_list {}
1931 drawvisible
1932 flushhighlights
1935 proc flushhighlights {} {
1936 global filehighlight fhl_list
1938 if {[info exists filehighlight]} {
1939 lappend fhl_list {}
1940 puts $filehighlight ""
1941 flush $filehighlight
1945 proc askfilehighlight {row id} {
1946 global filehighlight fhighlights fhl_list
1948 lappend fhl_list $id
1949 set fhighlights($row) -1
1950 puts $filehighlight $id
1953 proc readfhighlight {} {
1954 global filehighlight fhighlights commitrow curview mainfont iddrawn
1955 global fhl_list
1957 while {[gets $filehighlight line] >= 0} {
1958 set line [string trim $line]
1959 set i [lsearch -exact $fhl_list $line]
1960 if {$i < 0} continue
1961 for {set j 0} {$j < $i} {incr j} {
1962 set id [lindex $fhl_list $j]
1963 if {[info exists commitrow($curview,$id)]} {
1964 set fhighlights($commitrow($curview,$id)) 0
1967 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1968 if {$line eq {}} continue
1969 if {![info exists commitrow($curview,$line)]} continue
1970 set row $commitrow($curview,$line)
1971 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1972 bolden $row [concat $mainfont bold]
1974 set fhighlights($row) 1
1976 if {[eof $filehighlight]} {
1977 # strange...
1978 puts "oops, git diff-tree died"
1979 catch {close $filehighlight}
1980 unset filehighlight
1982 next_hlcont
1985 proc find_change {name ix op} {
1986 global nhighlights mainfont boldnamerows
1987 global findstring findpattern findtype
1989 # delete previous highlights, if any
1990 foreach row $boldnamerows {
1991 bolden_name $row $mainfont
1993 set boldnamerows {}
1994 catch {unset nhighlights}
1995 unbolden
1996 if {$findtype ne "Regexp"} {
1997 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1998 $findstring]
1999 set findpattern "*$e*"
2001 drawvisible
2004 proc askfindhighlight {row id} {
2005 global nhighlights commitinfo iddrawn mainfont
2006 global findstring findtype findloc findpattern
2008 if {![info exists commitinfo($id)]} {
2009 getcommit $id
2011 set info $commitinfo($id)
2012 set isbold 0
2013 set fldtypes {Headline Author Date Committer CDate Comments}
2014 foreach f $info ty $fldtypes {
2015 if {$findloc ne "All fields" && $findloc ne $ty} {
2016 continue
2018 if {$findtype eq "Regexp"} {
2019 set doesmatch [regexp $findstring $f]
2020 } elseif {$findtype eq "IgnCase"} {
2021 set doesmatch [string match -nocase $findpattern $f]
2022 } else {
2023 set doesmatch [string match $findpattern $f]
2025 if {$doesmatch} {
2026 if {$ty eq "Author"} {
2027 set isbold 2
2028 } else {
2029 set isbold 1
2033 if {[info exists iddrawn($id)]} {
2034 if {$isbold && ![ishighlighted $row]} {
2035 bolden $row [concat $mainfont bold]
2037 if {$isbold >= 2} {
2038 bolden_name $row [concat $mainfont bold]
2041 set nhighlights($row) $isbold
2044 proc vrel_change {name ix op} {
2045 global highlight_related
2047 rhighlight_none
2048 if {$highlight_related ne "None"} {
2049 after idle drawvisible
2053 # prepare for testing whether commits are descendents or ancestors of a
2054 proc rhighlight_sel {a} {
2055 global descendent desc_todo ancestor anc_todo
2056 global highlight_related rhighlights
2058 catch {unset descendent}
2059 set desc_todo [list $a]
2060 catch {unset ancestor}
2061 set anc_todo [list $a]
2062 if {$highlight_related ne "None"} {
2063 rhighlight_none
2064 after idle drawvisible
2068 proc rhighlight_none {} {
2069 global rhighlights
2071 catch {unset rhighlights}
2072 unbolden
2075 proc is_descendent {a} {
2076 global curview children commitrow descendent desc_todo
2078 set v $curview
2079 set la $commitrow($v,$a)
2080 set todo $desc_todo
2081 set leftover {}
2082 set done 0
2083 for {set i 0} {$i < [llength $todo]} {incr i} {
2084 set do [lindex $todo $i]
2085 if {$commitrow($v,$do) < $la} {
2086 lappend leftover $do
2087 continue
2089 foreach nk $children($v,$do) {
2090 if {![info exists descendent($nk)]} {
2091 set descendent($nk) 1
2092 lappend todo $nk
2093 if {$nk eq $a} {
2094 set done 1
2098 if {$done} {
2099 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2100 return
2103 set descendent($a) 0
2104 set desc_todo $leftover
2107 proc is_ancestor {a} {
2108 global curview parentlist commitrow ancestor anc_todo
2110 set v $curview
2111 set la $commitrow($v,$a)
2112 set todo $anc_todo
2113 set leftover {}
2114 set done 0
2115 for {set i 0} {$i < [llength $todo]} {incr i} {
2116 set do [lindex $todo $i]
2117 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2118 lappend leftover $do
2119 continue
2121 foreach np [lindex $parentlist $commitrow($v,$do)] {
2122 if {![info exists ancestor($np)]} {
2123 set ancestor($np) 1
2124 lappend todo $np
2125 if {$np eq $a} {
2126 set done 1
2130 if {$done} {
2131 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2132 return
2135 set ancestor($a) 0
2136 set anc_todo $leftover
2139 proc askrelhighlight {row id} {
2140 global descendent highlight_related iddrawn mainfont rhighlights
2141 global selectedline ancestor
2143 if {![info exists selectedline]} return
2144 set isbold 0
2145 if {$highlight_related eq "Descendent" ||
2146 $highlight_related eq "Not descendent"} {
2147 if {![info exists descendent($id)]} {
2148 is_descendent $id
2150 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2151 set isbold 1
2153 } elseif {$highlight_related eq "Ancestor" ||
2154 $highlight_related eq "Not ancestor"} {
2155 if {![info exists ancestor($id)]} {
2156 is_ancestor $id
2158 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2159 set isbold 1
2162 if {[info exists iddrawn($id)]} {
2163 if {$isbold && ![ishighlighted $row]} {
2164 bolden $row [concat $mainfont bold]
2167 set rhighlights($row) $isbold
2170 proc next_hlcont {} {
2171 global fhl_row fhl_dirn displayorder numcommits
2172 global vhighlights fhighlights nhighlights rhighlights
2173 global hlview filehighlight findstring highlight_related
2175 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2176 set row $fhl_row
2177 while {1} {
2178 if {$row < 0 || $row >= $numcommits} {
2179 bell
2180 set fhl_dirn 0
2181 return
2183 set id [lindex $displayorder $row]
2184 if {[info exists hlview]} {
2185 if {![info exists vhighlights($row)]} {
2186 askvhighlight $row $id
2188 if {$vhighlights($row) > 0} break
2190 if {$findstring ne {}} {
2191 if {![info exists nhighlights($row)]} {
2192 askfindhighlight $row $id
2194 if {$nhighlights($row) > 0} break
2196 if {$highlight_related ne "None"} {
2197 if {![info exists rhighlights($row)]} {
2198 askrelhighlight $row $id
2200 if {$rhighlights($row) > 0} break
2202 if {[info exists filehighlight]} {
2203 if {![info exists fhighlights($row)]} {
2204 # ask for a few more while we're at it...
2205 set r $row
2206 for {set n 0} {$n < 100} {incr n} {
2207 if {![info exists fhighlights($r)]} {
2208 askfilehighlight $r [lindex $displayorder $r]
2210 incr r $fhl_dirn
2211 if {$r < 0 || $r >= $numcommits} break
2213 flushhighlights
2215 if {$fhighlights($row) < 0} {
2216 set fhl_row $row
2217 return
2219 if {$fhighlights($row) > 0} break
2221 incr row $fhl_dirn
2223 set fhl_dirn 0
2224 selectline $row 1
2227 proc next_highlight {dirn} {
2228 global selectedline fhl_row fhl_dirn
2229 global hlview filehighlight findstring highlight_related
2231 if {![info exists selectedline]} return
2232 if {!([info exists hlview] || $findstring ne {} ||
2233 $highlight_related ne "None" || [info exists filehighlight])} return
2234 set fhl_row [expr {$selectedline + $dirn}]
2235 set fhl_dirn $dirn
2236 next_hlcont
2239 proc cancel_next_highlight {} {
2240 global fhl_dirn
2242 set fhl_dirn 0
2245 # Graph layout functions
2247 proc shortids {ids} {
2248 set res {}
2249 foreach id $ids {
2250 if {[llength $id] > 1} {
2251 lappend res [shortids $id]
2252 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2253 lappend res [string range $id 0 7]
2254 } else {
2255 lappend res $id
2258 return $res
2261 proc incrange {l x o} {
2262 set n [llength $l]
2263 while {$x < $n} {
2264 set e [lindex $l $x]
2265 if {$e ne {}} {
2266 lset l $x [expr {$e + $o}]
2268 incr x
2270 return $l
2273 proc ntimes {n o} {
2274 set ret {}
2275 for {} {$n > 0} {incr n -1} {
2276 lappend ret $o
2278 return $ret
2281 proc usedinrange {id l1 l2} {
2282 global children commitrow childlist curview
2284 if {[info exists commitrow($curview,$id)]} {
2285 set r $commitrow($curview,$id)
2286 if {$l1 <= $r && $r <= $l2} {
2287 return [expr {$r - $l1 + 1}]
2289 set kids [lindex $childlist $r]
2290 } else {
2291 set kids $children($curview,$id)
2293 foreach c $kids {
2294 set r $commitrow($curview,$c)
2295 if {$l1 <= $r && $r <= $l2} {
2296 return [expr {$r - $l1 + 1}]
2299 return 0
2302 proc sanity {row {full 0}} {
2303 global rowidlist rowoffsets
2305 set col -1
2306 set ids [lindex $rowidlist $row]
2307 foreach id $ids {
2308 incr col
2309 if {$id eq {}} continue
2310 if {$col < [llength $ids] - 1 &&
2311 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2312 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2314 set o [lindex $rowoffsets $row $col]
2315 set y $row
2316 set x $col
2317 while {$o ne {}} {
2318 incr y -1
2319 incr x $o
2320 if {[lindex $rowidlist $y $x] != $id} {
2321 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2322 puts " id=[shortids $id] check started at row $row"
2323 for {set i $row} {$i >= $y} {incr i -1} {
2324 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2326 break
2328 if {!$full} break
2329 set o [lindex $rowoffsets $y $x]
2334 proc makeuparrow {oid x y z} {
2335 global rowidlist rowoffsets uparrowlen idrowranges
2337 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2338 incr y -1
2339 incr x $z
2340 set off0 [lindex $rowoffsets $y]
2341 for {set x0 $x} {1} {incr x0} {
2342 if {$x0 >= [llength $off0]} {
2343 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2344 break
2346 set z [lindex $off0 $x0]
2347 if {$z ne {}} {
2348 incr x0 $z
2349 break
2352 set z [expr {$x0 - $x}]
2353 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2354 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2356 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2357 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2358 lappend idrowranges($oid) $y
2361 proc initlayout {} {
2362 global rowidlist rowoffsets displayorder commitlisted
2363 global rowlaidout rowoptim
2364 global idinlist rowchk rowrangelist idrowranges
2365 global numcommits canvxmax canv
2366 global nextcolor
2367 global parentlist childlist children
2368 global colormap rowtextx
2369 global linesegends
2371 set numcommits 0
2372 set displayorder {}
2373 set commitlisted {}
2374 set parentlist {}
2375 set childlist {}
2376 set rowrangelist {}
2377 set nextcolor 0
2378 set rowidlist {{}}
2379 set rowoffsets {{}}
2380 catch {unset idinlist}
2381 catch {unset rowchk}
2382 set rowlaidout 0
2383 set rowoptim 0
2384 set canvxmax [$canv cget -width]
2385 catch {unset colormap}
2386 catch {unset rowtextx}
2387 catch {unset idrowranges}
2388 set linesegends {}
2391 proc setcanvscroll {} {
2392 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2394 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2395 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2396 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2397 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2400 proc visiblerows {} {
2401 global canv numcommits linespc
2403 set ymax [lindex [$canv cget -scrollregion] 3]
2404 if {$ymax eq {} || $ymax == 0} return
2405 set f [$canv yview]
2406 set y0 [expr {int([lindex $f 0] * $ymax)}]
2407 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2408 if {$r0 < 0} {
2409 set r0 0
2411 set y1 [expr {int([lindex $f 1] * $ymax)}]
2412 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2413 if {$r1 >= $numcommits} {
2414 set r1 [expr {$numcommits - 1}]
2416 return [list $r0 $r1]
2419 proc layoutmore {tmax} {
2420 global rowlaidout rowoptim commitidx numcommits optim_delay
2421 global uparrowlen curview
2423 while {1} {
2424 if {$rowoptim - $optim_delay > $numcommits} {
2425 showstuff [expr {$rowoptim - $optim_delay}]
2426 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2427 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2428 if {$nr > 100} {
2429 set nr 100
2431 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2432 incr rowoptim $nr
2433 } elseif {$commitidx($curview) > $rowlaidout} {
2434 set nr [expr {$commitidx($curview) - $rowlaidout}]
2435 # may need to increase this threshold if uparrowlen or
2436 # mingaplen are increased...
2437 if {$nr > 150} {
2438 set nr 150
2440 set row $rowlaidout
2441 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2442 if {$rowlaidout == $row} {
2443 return 0
2445 } else {
2446 return 0
2448 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2449 return 1
2454 proc showstuff {canshow} {
2455 global numcommits commitrow pending_select selectedline
2456 global linesegends idrowranges idrangedrawn curview
2458 if {$numcommits == 0} {
2459 global phase
2460 set phase "incrdraw"
2461 allcanvs delete all
2463 set row $numcommits
2464 set numcommits $canshow
2465 setcanvscroll
2466 set rows [visiblerows]
2467 set r0 [lindex $rows 0]
2468 set r1 [lindex $rows 1]
2469 set selrow -1
2470 for {set r $row} {$r < $canshow} {incr r} {
2471 foreach id [lindex $linesegends [expr {$r+1}]] {
2472 set i -1
2473 foreach {s e} [rowranges $id] {
2474 incr i
2475 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2476 && ![info exists idrangedrawn($id,$i)]} {
2477 drawlineseg $id $i
2478 set idrangedrawn($id,$i) 1
2483 if {$canshow > $r1} {
2484 set canshow $r1
2486 while {$row < $canshow} {
2487 drawcmitrow $row
2488 incr row
2490 if {[info exists pending_select] &&
2491 [info exists commitrow($curview,$pending_select)] &&
2492 $commitrow($curview,$pending_select) < $numcommits} {
2493 selectline $commitrow($curview,$pending_select) 1
2495 if {![info exists selectedline] && ![info exists pending_select]} {
2496 selectline 0 1
2500 proc layoutrows {row endrow last} {
2501 global rowidlist rowoffsets displayorder
2502 global uparrowlen downarrowlen maxwidth mingaplen
2503 global childlist parentlist
2504 global idrowranges linesegends
2505 global commitidx curview
2506 global idinlist rowchk rowrangelist
2508 set idlist [lindex $rowidlist $row]
2509 set offs [lindex $rowoffsets $row]
2510 while {$row < $endrow} {
2511 set id [lindex $displayorder $row]
2512 set oldolds {}
2513 set newolds {}
2514 foreach p [lindex $parentlist $row] {
2515 if {![info exists idinlist($p)]} {
2516 lappend newolds $p
2517 } elseif {!$idinlist($p)} {
2518 lappend oldolds $p
2521 set lse {}
2522 set nev [expr {[llength $idlist] + [llength $newolds]
2523 + [llength $oldolds] - $maxwidth + 1}]
2524 if {$nev > 0} {
2525 if {!$last &&
2526 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2527 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2528 set i [lindex $idlist $x]
2529 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2530 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2531 [expr {$row + $uparrowlen + $mingaplen}]]
2532 if {$r == 0} {
2533 set idlist [lreplace $idlist $x $x]
2534 set offs [lreplace $offs $x $x]
2535 set offs [incrange $offs $x 1]
2536 set idinlist($i) 0
2537 set rm1 [expr {$row - 1}]
2538 lappend lse $i
2539 lappend idrowranges($i) $rm1
2540 if {[incr nev -1] <= 0} break
2541 continue
2543 set rowchk($id) [expr {$row + $r}]
2546 lset rowidlist $row $idlist
2547 lset rowoffsets $row $offs
2549 lappend linesegends $lse
2550 set col [lsearch -exact $idlist $id]
2551 if {$col < 0} {
2552 set col [llength $idlist]
2553 lappend idlist $id
2554 lset rowidlist $row $idlist
2555 set z {}
2556 if {[lindex $childlist $row] ne {}} {
2557 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2558 unset idinlist($id)
2560 lappend offs $z
2561 lset rowoffsets $row $offs
2562 if {$z ne {}} {
2563 makeuparrow $id $col $row $z
2565 } else {
2566 unset idinlist($id)
2568 set ranges {}
2569 if {[info exists idrowranges($id)]} {
2570 set ranges $idrowranges($id)
2571 lappend ranges $row
2572 unset idrowranges($id)
2574 lappend rowrangelist $ranges
2575 incr row
2576 set offs [ntimes [llength $idlist] 0]
2577 set l [llength $newolds]
2578 set idlist [eval lreplace \$idlist $col $col $newolds]
2579 set o 0
2580 if {$l != 1} {
2581 set offs [lrange $offs 0 [expr {$col - 1}]]
2582 foreach x $newolds {
2583 lappend offs {}
2584 incr o -1
2586 incr o
2587 set tmp [expr {[llength $idlist] - [llength $offs]}]
2588 if {$tmp > 0} {
2589 set offs [concat $offs [ntimes $tmp $o]]
2591 } else {
2592 lset offs $col {}
2594 foreach i $newolds {
2595 set idinlist($i) 1
2596 set idrowranges($i) $row
2598 incr col $l
2599 foreach oid $oldolds {
2600 set idinlist($oid) 1
2601 set idlist [linsert $idlist $col $oid]
2602 set offs [linsert $offs $col $o]
2603 makeuparrow $oid $col $row $o
2604 incr col
2606 lappend rowidlist $idlist
2607 lappend rowoffsets $offs
2609 return $row
2612 proc addextraid {id row} {
2613 global displayorder commitrow commitinfo
2614 global commitidx commitlisted
2615 global parentlist childlist children curview
2617 incr commitidx($curview)
2618 lappend displayorder $id
2619 lappend commitlisted 0
2620 lappend parentlist {}
2621 set commitrow($curview,$id) $row
2622 readcommit $id
2623 if {![info exists commitinfo($id)]} {
2624 set commitinfo($id) {"No commit information available"}
2626 if {![info exists children($curview,$id)]} {
2627 set children($curview,$id) {}
2629 lappend childlist $children($curview,$id)
2632 proc layouttail {} {
2633 global rowidlist rowoffsets idinlist commitidx curview
2634 global idrowranges rowrangelist
2636 set row $commitidx($curview)
2637 set idlist [lindex $rowidlist $row]
2638 while {$idlist ne {}} {
2639 set col [expr {[llength $idlist] - 1}]
2640 set id [lindex $idlist $col]
2641 addextraid $id $row
2642 unset idinlist($id)
2643 lappend idrowranges($id) $row
2644 lappend rowrangelist $idrowranges($id)
2645 unset idrowranges($id)
2646 incr row
2647 set offs [ntimes $col 0]
2648 set idlist [lreplace $idlist $col $col]
2649 lappend rowidlist $idlist
2650 lappend rowoffsets $offs
2653 foreach id [array names idinlist] {
2654 addextraid $id $row
2655 lset rowidlist $row [list $id]
2656 lset rowoffsets $row 0
2657 makeuparrow $id 0 $row 0
2658 lappend idrowranges($id) $row
2659 lappend rowrangelist $idrowranges($id)
2660 unset idrowranges($id)
2661 incr row
2662 lappend rowidlist {}
2663 lappend rowoffsets {}
2667 proc insert_pad {row col npad} {
2668 global rowidlist rowoffsets
2670 set pad [ntimes $npad {}]
2671 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2672 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2673 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2676 proc optimize_rows {row col endrow} {
2677 global rowidlist rowoffsets idrowranges displayorder
2679 for {} {$row < $endrow} {incr row} {
2680 set idlist [lindex $rowidlist $row]
2681 set offs [lindex $rowoffsets $row]
2682 set haspad 0
2683 for {} {$col < [llength $offs]} {incr col} {
2684 if {[lindex $idlist $col] eq {}} {
2685 set haspad 1
2686 continue
2688 set z [lindex $offs $col]
2689 if {$z eq {}} continue
2690 set isarrow 0
2691 set x0 [expr {$col + $z}]
2692 set y0 [expr {$row - 1}]
2693 set z0 [lindex $rowoffsets $y0 $x0]
2694 if {$z0 eq {}} {
2695 set id [lindex $idlist $col]
2696 set ranges [rowranges $id]
2697 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2698 set isarrow 1
2701 if {$z < -1 || ($z < 0 && $isarrow)} {
2702 set npad [expr {-1 - $z + $isarrow}]
2703 set offs [incrange $offs $col $npad]
2704 insert_pad $y0 $x0 $npad
2705 if {$y0 > 0} {
2706 optimize_rows $y0 $x0 $row
2708 set z [lindex $offs $col]
2709 set x0 [expr {$col + $z}]
2710 set z0 [lindex $rowoffsets $y0 $x0]
2711 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2712 set npad [expr {$z - 1 + $isarrow}]
2713 set y1 [expr {$row + 1}]
2714 set offs2 [lindex $rowoffsets $y1]
2715 set x1 -1
2716 foreach z $offs2 {
2717 incr x1
2718 if {$z eq {} || $x1 + $z < $col} continue
2719 if {$x1 + $z > $col} {
2720 incr npad
2722 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2723 break
2725 set pad [ntimes $npad {}]
2726 set idlist [eval linsert \$idlist $col $pad]
2727 set tmp [eval linsert \$offs $col $pad]
2728 incr col $npad
2729 set offs [incrange $tmp $col [expr {-$npad}]]
2730 set z [lindex $offs $col]
2731 set haspad 1
2733 if {$z0 eq {} && !$isarrow} {
2734 # this line links to its first child on row $row-2
2735 set rm2 [expr {$row - 2}]
2736 set id [lindex $displayorder $rm2]
2737 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2738 if {$xc >= 0} {
2739 set z0 [expr {$xc - $x0}]
2742 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2743 insert_pad $y0 $x0 1
2744 set offs [incrange $offs $col 1]
2745 optimize_rows $y0 [expr {$x0 + 1}] $row
2748 if {!$haspad} {
2749 set o {}
2750 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2751 set o [lindex $offs $col]
2752 if {$o eq {}} {
2753 # check if this is the link to the first child
2754 set id [lindex $idlist $col]
2755 set ranges [rowranges $id]
2756 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2757 # it is, work out offset to child
2758 set y0 [expr {$row - 1}]
2759 set id [lindex $displayorder $y0]
2760 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2761 if {$x0 >= 0} {
2762 set o [expr {$x0 - $col}]
2766 if {$o eq {} || $o <= 0} break
2768 if {$o ne {} && [incr col] < [llength $idlist]} {
2769 set y1 [expr {$row + 1}]
2770 set offs2 [lindex $rowoffsets $y1]
2771 set x1 -1
2772 foreach z $offs2 {
2773 incr x1
2774 if {$z eq {} || $x1 + $z < $col} continue
2775 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2776 break
2778 set idlist [linsert $idlist $col {}]
2779 set tmp [linsert $offs $col {}]
2780 incr col
2781 set offs [incrange $tmp $col -1]
2784 lset rowidlist $row $idlist
2785 lset rowoffsets $row $offs
2786 set col 0
2790 proc xc {row col} {
2791 global canvx0 linespc
2792 return [expr {$canvx0 + $col * $linespc}]
2795 proc yc {row} {
2796 global canvy0 linespc
2797 return [expr {$canvy0 + $row * $linespc}]
2800 proc linewidth {id} {
2801 global thickerline lthickness
2803 set wid $lthickness
2804 if {[info exists thickerline] && $id eq $thickerline} {
2805 set wid [expr {2 * $lthickness}]
2807 return $wid
2810 proc rowranges {id} {
2811 global phase idrowranges commitrow rowlaidout rowrangelist curview
2813 set ranges {}
2814 if {$phase eq {} ||
2815 ([info exists commitrow($curview,$id)]
2816 && $commitrow($curview,$id) < $rowlaidout)} {
2817 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2818 } elseif {[info exists idrowranges($id)]} {
2819 set ranges $idrowranges($id)
2821 return $ranges
2824 proc drawlineseg {id i} {
2825 global rowoffsets rowidlist
2826 global displayorder
2827 global canv colormap linespc
2828 global numcommits commitrow curview
2830 set ranges [rowranges $id]
2831 set downarrow 1
2832 if {[info exists commitrow($curview,$id)]
2833 && $commitrow($curview,$id) < $numcommits} {
2834 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2835 } else {
2836 set downarrow 1
2838 set startrow [lindex $ranges [expr {2 * $i}]]
2839 set row [lindex $ranges [expr {2 * $i + 1}]]
2840 if {$startrow == $row} return
2841 assigncolor $id
2842 set coords {}
2843 set col [lsearch -exact [lindex $rowidlist $row] $id]
2844 if {$col < 0} {
2845 puts "oops: drawline: id $id not on row $row"
2846 return
2848 set lasto {}
2849 set ns 0
2850 while {1} {
2851 set o [lindex $rowoffsets $row $col]
2852 if {$o eq {}} break
2853 if {$o ne $lasto} {
2854 # changing direction
2855 set x [xc $row $col]
2856 set y [yc $row]
2857 lappend coords $x $y
2858 set lasto $o
2860 incr col $o
2861 incr row -1
2863 set x [xc $row $col]
2864 set y [yc $row]
2865 lappend coords $x $y
2866 if {$i == 0} {
2867 # draw the link to the first child as part of this line
2868 incr row -1
2869 set child [lindex $displayorder $row]
2870 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2871 if {$ccol >= 0} {
2872 set x [xc $row $ccol]
2873 set y [yc $row]
2874 if {$ccol < $col - 1} {
2875 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2876 } elseif {$ccol > $col + 1} {
2877 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2879 lappend coords $x $y
2882 if {[llength $coords] < 4} return
2883 if {$downarrow} {
2884 # This line has an arrow at the lower end: check if the arrow is
2885 # on a diagonal segment, and if so, work around the Tk 8.4
2886 # refusal to draw arrows on diagonal lines.
2887 set x0 [lindex $coords 0]
2888 set x1 [lindex $coords 2]
2889 if {$x0 != $x1} {
2890 set y0 [lindex $coords 1]
2891 set y1 [lindex $coords 3]
2892 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2893 # we have a nearby vertical segment, just trim off the diag bit
2894 set coords [lrange $coords 2 end]
2895 } else {
2896 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2897 set xi [expr {$x0 - $slope * $linespc / 2}]
2898 set yi [expr {$y0 - $linespc / 2}]
2899 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2903 set arrow [expr {2 * ($i > 0) + $downarrow}]
2904 set arrow [lindex {none first last both} $arrow]
2905 set t [$canv create line $coords -width [linewidth $id] \
2906 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2907 $canv lower $t
2908 bindline $t $id
2911 proc drawparentlinks {id row col olds} {
2912 global rowidlist canv colormap
2914 set row2 [expr {$row + 1}]
2915 set x [xc $row $col]
2916 set y [yc $row]
2917 set y2 [yc $row2]
2918 set ids [lindex $rowidlist $row2]
2919 # rmx = right-most X coord used
2920 set rmx 0
2921 foreach p $olds {
2922 set i [lsearch -exact $ids $p]
2923 if {$i < 0} {
2924 puts "oops, parent $p of $id not in list"
2925 continue
2927 set x2 [xc $row2 $i]
2928 if {$x2 > $rmx} {
2929 set rmx $x2
2931 set ranges [rowranges $p]
2932 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2933 && $row2 < [lindex $ranges 1]} {
2934 # drawlineseg will do this one for us
2935 continue
2937 assigncolor $p
2938 # should handle duplicated parents here...
2939 set coords [list $x $y]
2940 if {$i < $col - 1} {
2941 lappend coords [xc $row [expr {$i + 1}]] $y
2942 } elseif {$i > $col + 1} {
2943 lappend coords [xc $row [expr {$i - 1}]] $y
2945 lappend coords $x2 $y2
2946 set t [$canv create line $coords -width [linewidth $p] \
2947 -fill $colormap($p) -tags lines.$p]
2948 $canv lower $t
2949 bindline $t $p
2951 return $rmx
2954 proc drawlines {id} {
2955 global colormap canv
2956 global idrangedrawn
2957 global children iddrawn commitrow rowidlist curview
2959 $canv delete lines.$id
2960 set nr [expr {[llength [rowranges $id]] / 2}]
2961 for {set i 0} {$i < $nr} {incr i} {
2962 if {[info exists idrangedrawn($id,$i)]} {
2963 drawlineseg $id $i
2966 foreach child $children($curview,$id) {
2967 if {[info exists iddrawn($child)]} {
2968 set row $commitrow($curview,$child)
2969 set col [lsearch -exact [lindex $rowidlist $row] $child]
2970 if {$col >= 0} {
2971 drawparentlinks $child $row $col [list $id]
2977 proc drawcmittext {id row col rmx} {
2978 global linespc canv canv2 canv3 canvy0 fgcolor
2979 global commitlisted commitinfo rowidlist
2980 global rowtextx idpos idtags idheads idotherrefs
2981 global linehtag linentag linedtag
2982 global mainfont canvxmax boldrows boldnamerows fgcolor
2984 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2985 set x [xc $row $col]
2986 set y [yc $row]
2987 set orad [expr {$linespc / 3}]
2988 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2989 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2990 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2991 $canv raise $t
2992 $canv bind $t <1> {selcanvline {} %x %y}
2993 set xt [xc $row [llength [lindex $rowidlist $row]]]
2994 if {$xt < $rmx} {
2995 set xt $rmx
2997 set rowtextx($row) $xt
2998 set idpos($id) [list $x $xt $y]
2999 if {[info exists idtags($id)] || [info exists idheads($id)]
3000 || [info exists idotherrefs($id)]} {
3001 set xt [drawtags $id $x $xt $y]
3003 set headline [lindex $commitinfo($id) 0]
3004 set name [lindex $commitinfo($id) 1]
3005 set date [lindex $commitinfo($id) 2]
3006 set date [formatdate $date]
3007 set font $mainfont
3008 set nfont $mainfont
3009 set isbold [ishighlighted $row]
3010 if {$isbold > 0} {
3011 lappend boldrows $row
3012 lappend font bold
3013 if {$isbold > 1} {
3014 lappend boldnamerows $row
3015 lappend nfont bold
3018 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3019 -text $headline -font $font -tags text]
3020 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3021 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3022 -text $name -font $nfont -tags text]
3023 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3024 -text $date -font $mainfont -tags text]
3025 set xr [expr {$xt + [font measure $mainfont $headline]}]
3026 if {$xr > $canvxmax} {
3027 set canvxmax $xr
3028 setcanvscroll
3032 proc drawcmitrow {row} {
3033 global displayorder rowidlist
3034 global idrangedrawn iddrawn
3035 global commitinfo parentlist numcommits
3036 global filehighlight fhighlights findstring nhighlights
3037 global hlview vhighlights
3038 global highlight_related rhighlights
3040 if {$row >= $numcommits} return
3041 foreach id [lindex $rowidlist $row] {
3042 if {$id eq {}} continue
3043 set i -1
3044 foreach {s e} [rowranges $id] {
3045 incr i
3046 if {$row < $s} continue
3047 if {$e eq {}} break
3048 if {$row <= $e} {
3049 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3050 drawlineseg $id $i
3051 set idrangedrawn($id,$i) 1
3053 break
3058 set id [lindex $displayorder $row]
3059 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3060 askvhighlight $row $id
3062 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3063 askfilehighlight $row $id
3065 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3066 askfindhighlight $row $id
3068 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3069 askrelhighlight $row $id
3071 if {[info exists iddrawn($id)]} return
3072 set col [lsearch -exact [lindex $rowidlist $row] $id]
3073 if {$col < 0} {
3074 puts "oops, row $row id $id not in list"
3075 return
3077 if {![info exists commitinfo($id)]} {
3078 getcommit $id
3080 assigncolor $id
3081 set olds [lindex $parentlist $row]
3082 if {$olds ne {}} {
3083 set rmx [drawparentlinks $id $row $col $olds]
3084 } else {
3085 set rmx 0
3087 drawcmittext $id $row $col $rmx
3088 set iddrawn($id) 1
3091 proc drawfrac {f0 f1} {
3092 global numcommits canv
3093 global linespc
3095 set ymax [lindex [$canv cget -scrollregion] 3]
3096 if {$ymax eq {} || $ymax == 0} return
3097 set y0 [expr {int($f0 * $ymax)}]
3098 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3099 if {$row < 0} {
3100 set row 0
3102 set y1 [expr {int($f1 * $ymax)}]
3103 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3104 if {$endrow >= $numcommits} {
3105 set endrow [expr {$numcommits - 1}]
3107 for {} {$row <= $endrow} {incr row} {
3108 drawcmitrow $row
3112 proc drawvisible {} {
3113 global canv
3114 eval drawfrac [$canv yview]
3117 proc clear_display {} {
3118 global iddrawn idrangedrawn
3119 global vhighlights fhighlights nhighlights rhighlights
3121 allcanvs delete all
3122 catch {unset iddrawn}
3123 catch {unset idrangedrawn}
3124 catch {unset vhighlights}
3125 catch {unset fhighlights}
3126 catch {unset nhighlights}
3127 catch {unset rhighlights}
3130 proc findcrossings {id} {
3131 global rowidlist parentlist numcommits rowoffsets displayorder
3133 set cross {}
3134 set ccross {}
3135 foreach {s e} [rowranges $id] {
3136 if {$e >= $numcommits} {
3137 set e [expr {$numcommits - 1}]
3139 if {$e <= $s} continue
3140 set x [lsearch -exact [lindex $rowidlist $e] $id]
3141 if {$x < 0} {
3142 puts "findcrossings: oops, no [shortids $id] in row $e"
3143 continue
3145 for {set row $e} {[incr row -1] >= $s} {} {
3146 set olds [lindex $parentlist $row]
3147 set kid [lindex $displayorder $row]
3148 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3149 if {$kidx < 0} continue
3150 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3151 foreach p $olds {
3152 set px [lsearch -exact $nextrow $p]
3153 if {$px < 0} continue
3154 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3155 if {[lsearch -exact $ccross $p] >= 0} continue
3156 if {$x == $px + ($kidx < $px? -1: 1)} {
3157 lappend ccross $p
3158 } elseif {[lsearch -exact $cross $p] < 0} {
3159 lappend cross $p
3163 set inc [lindex $rowoffsets $row $x]
3164 if {$inc eq {}} break
3165 incr x $inc
3168 return [concat $ccross {{}} $cross]
3171 proc assigncolor {id} {
3172 global colormap colors nextcolor
3173 global commitrow parentlist children children curview
3175 if {[info exists colormap($id)]} return
3176 set ncolors [llength $colors]
3177 if {[info exists children($curview,$id)]} {
3178 set kids $children($curview,$id)
3179 } else {
3180 set kids {}
3182 if {[llength $kids] == 1} {
3183 set child [lindex $kids 0]
3184 if {[info exists colormap($child)]
3185 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3186 set colormap($id) $colormap($child)
3187 return
3190 set badcolors {}
3191 set origbad {}
3192 foreach x [findcrossings $id] {
3193 if {$x eq {}} {
3194 # delimiter between corner crossings and other crossings
3195 if {[llength $badcolors] >= $ncolors - 1} break
3196 set origbad $badcolors
3198 if {[info exists colormap($x)]
3199 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3200 lappend badcolors $colormap($x)
3203 if {[llength $badcolors] >= $ncolors} {
3204 set badcolors $origbad
3206 set origbad $badcolors
3207 if {[llength $badcolors] < $ncolors - 1} {
3208 foreach child $kids {
3209 if {[info exists colormap($child)]
3210 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3211 lappend badcolors $colormap($child)
3213 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3214 if {[info exists colormap($p)]
3215 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3216 lappend badcolors $colormap($p)
3220 if {[llength $badcolors] >= $ncolors} {
3221 set badcolors $origbad
3224 for {set i 0} {$i <= $ncolors} {incr i} {
3225 set c [lindex $colors $nextcolor]
3226 if {[incr nextcolor] >= $ncolors} {
3227 set nextcolor 0
3229 if {[lsearch -exact $badcolors $c]} break
3231 set colormap($id) $c
3234 proc bindline {t id} {
3235 global canv
3237 $canv bind $t <Enter> "lineenter %x %y $id"
3238 $canv bind $t <Motion> "linemotion %x %y $id"
3239 $canv bind $t <Leave> "lineleave $id"
3240 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3243 proc drawtags {id x xt y1} {
3244 global idtags idheads idotherrefs mainhead
3245 global linespc lthickness
3246 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3248 set marks {}
3249 set ntags 0
3250 set nheads 0
3251 if {[info exists idtags($id)]} {
3252 set marks $idtags($id)
3253 set ntags [llength $marks]
3255 if {[info exists idheads($id)]} {
3256 set marks [concat $marks $idheads($id)]
3257 set nheads [llength $idheads($id)]
3259 if {[info exists idotherrefs($id)]} {
3260 set marks [concat $marks $idotherrefs($id)]
3262 if {$marks eq {}} {
3263 return $xt
3266 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3267 set yt [expr {$y1 - 0.5 * $linespc}]
3268 set yb [expr {$yt + $linespc - 1}]
3269 set xvals {}
3270 set wvals {}
3271 set i -1
3272 foreach tag $marks {
3273 incr i
3274 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3275 set wid [font measure [concat $mainfont bold] $tag]
3276 } else {
3277 set wid [font measure $mainfont $tag]
3279 lappend xvals $xt
3280 lappend wvals $wid
3281 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3283 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3284 -width $lthickness -fill black -tags tag.$id]
3285 $canv lower $t
3286 foreach tag $marks x $xvals wid $wvals {
3287 set xl [expr {$x + $delta}]
3288 set xr [expr {$x + $delta + $wid + $lthickness}]
3289 set font $mainfont
3290 if {[incr ntags -1] >= 0} {
3291 # draw a tag
3292 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3293 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3294 -width 1 -outline black -fill yellow -tags tag.$id]
3295 $canv bind $t <1> [list showtag $tag 1]
3296 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3297 } else {
3298 # draw a head or other ref
3299 if {[incr nheads -1] >= 0} {
3300 set col green
3301 if {$tag eq $mainhead} {
3302 lappend font bold
3304 } else {
3305 set col "#ddddff"
3307 set xl [expr {$xl - $delta/2}]
3308 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3309 -width 1 -outline black -fill $col -tags tag.$id
3310 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3311 set rwid [font measure $mainfont $remoteprefix]
3312 set xi [expr {$x + 1}]
3313 set yti [expr {$yt + 1}]
3314 set xri [expr {$x + $rwid}]
3315 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3316 -width 0 -fill "#ffddaa" -tags tag.$id
3319 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3320 -font $font -tags [list tag.$id text]]
3321 if {$ntags >= 0} {
3322 $canv bind $t <1> [list showtag $tag 1]
3323 } elseif {$nheads >= 0} {
3324 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3327 return $xt
3330 proc xcoord {i level ln} {
3331 global canvx0 xspc1 xspc2
3333 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3334 if {$i > 0 && $i == $level} {
3335 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3336 } elseif {$i > $level} {
3337 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3339 return $x
3342 proc show_status {msg} {
3343 global canv mainfont fgcolor
3345 clear_display
3346 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3347 -tags text -fill $fgcolor
3350 proc finishcommits {} {
3351 global commitidx phase curview
3352 global pending_select
3354 if {$commitidx($curview) > 0} {
3355 drawrest
3356 } else {
3357 show_status "No commits selected"
3359 set phase {}
3360 catch {unset pending_select}
3363 # Insert a new commit as the child of the commit on row $row.
3364 # The new commit will be displayed on row $row and the commits
3365 # on that row and below will move down one row.
3366 proc insertrow {row newcmit} {
3367 global displayorder parentlist childlist commitlisted
3368 global commitrow curview rowidlist rowoffsets numcommits
3369 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3370 global linesegends selectedline
3372 if {$row >= $numcommits} {
3373 puts "oops, inserting new row $row but only have $numcommits rows"
3374 return
3376 set p [lindex $displayorder $row]
3377 set displayorder [linsert $displayorder $row $newcmit]
3378 set parentlist [linsert $parentlist $row $p]
3379 set kids [lindex $childlist $row]
3380 lappend kids $newcmit
3381 lset childlist $row $kids
3382 set childlist [linsert $childlist $row {}]
3383 set commitlisted [linsert $commitlisted $row 1]
3384 set l [llength $displayorder]
3385 for {set r $row} {$r < $l} {incr r} {
3386 set id [lindex $displayorder $r]
3387 set commitrow($curview,$id) $r
3390 set idlist [lindex $rowidlist $row]
3391 set offs [lindex $rowoffsets $row]
3392 set newoffs {}
3393 foreach x $idlist {
3394 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3395 lappend newoffs {}
3396 } else {
3397 lappend newoffs 0
3400 if {[llength $kids] == 1} {
3401 set col [lsearch -exact $idlist $p]
3402 lset idlist $col $newcmit
3403 } else {
3404 set col [llength $idlist]
3405 lappend idlist $newcmit
3406 lappend offs {}
3407 lset rowoffsets $row $offs
3409 set rowidlist [linsert $rowidlist $row $idlist]
3410 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3412 set rowrangelist [linsert $rowrangelist $row {}]
3413 set l [llength $rowrangelist]
3414 for {set r 0} {$r < $l} {incr r} {
3415 set ranges [lindex $rowrangelist $r]
3416 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3417 set newranges {}
3418 foreach x $ranges {
3419 if {$x >= $row} {
3420 lappend newranges [expr {$x + 1}]
3421 } else {
3422 lappend newranges $x
3425 lset rowrangelist $r $newranges
3428 if {[llength $kids] > 1} {
3429 set rp1 [expr {$row + 1}]
3430 set ranges [lindex $rowrangelist $rp1]
3431 if {$ranges eq {}} {
3432 set ranges [list $row $rp1]
3433 } elseif {[lindex $ranges end-1] == $rp1} {
3434 lset ranges end-1 $row
3436 lset rowrangelist $rp1 $ranges
3438 foreach id [array names idrowranges] {
3439 set ranges $idrowranges($id)
3440 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3441 set newranges {}
3442 foreach x $ranges {
3443 if {$x >= $row} {
3444 lappend newranges [expr {$x + 1}]
3445 } else {
3446 lappend newranges $x
3449 set idrowranges($id) $newranges
3453 set linesegends [linsert $linesegends $row {}]
3455 incr rowlaidout
3456 incr rowoptim
3457 incr numcommits
3459 if {[info exists selectedline] && $selectedline >= $row} {
3460 incr selectedline
3462 redisplay
3465 # Don't change the text pane cursor if it is currently the hand cursor,
3466 # showing that we are over a sha1 ID link.
3467 proc settextcursor {c} {
3468 global ctext curtextcursor
3470 if {[$ctext cget -cursor] == $curtextcursor} {
3471 $ctext config -cursor $c
3473 set curtextcursor $c
3476 proc nowbusy {what} {
3477 global isbusy
3479 if {[array names isbusy] eq {}} {
3480 . config -cursor watch
3481 settextcursor watch
3483 set isbusy($what) 1
3486 proc notbusy {what} {
3487 global isbusy maincursor textcursor
3489 catch {unset isbusy($what)}
3490 if {[array names isbusy] eq {}} {
3491 . config -cursor $maincursor
3492 settextcursor $textcursor
3496 proc drawrest {} {
3497 global startmsecs
3498 global rowlaidout commitidx curview
3499 global pending_select
3501 set row $rowlaidout
3502 layoutrows $rowlaidout $commitidx($curview) 1
3503 layouttail
3504 optimize_rows $row 0 $commitidx($curview)
3505 showstuff $commitidx($curview)
3506 if {[info exists pending_select]} {
3507 selectline 0 1
3510 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3511 #global numcommits
3512 #puts "overall $drawmsecs ms for $numcommits commits"
3515 proc findmatches {f} {
3516 global findtype foundstring foundstrlen
3517 if {$findtype == "Regexp"} {
3518 set matches [regexp -indices -all -inline $foundstring $f]
3519 } else {
3520 if {$findtype == "IgnCase"} {
3521 set str [string tolower $f]
3522 } else {
3523 set str $f
3525 set matches {}
3526 set i 0
3527 while {[set j [string first $foundstring $str $i]] >= 0} {
3528 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3529 set i [expr {$j + $foundstrlen}]
3532 return $matches
3535 proc dofind {} {
3536 global findtype findloc findstring markedmatches commitinfo
3537 global numcommits displayorder linehtag linentag linedtag
3538 global mainfont canv canv2 canv3 selectedline
3539 global matchinglines foundstring foundstrlen matchstring
3540 global commitdata
3542 stopfindproc
3543 unmarkmatches
3544 cancel_next_highlight
3545 focus .
3546 set matchinglines {}
3547 if {$findtype == "IgnCase"} {
3548 set foundstring [string tolower $findstring]
3549 } else {
3550 set foundstring $findstring
3552 set foundstrlen [string length $findstring]
3553 if {$foundstrlen == 0} return
3554 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3555 set matchstring "*$matchstring*"
3556 if {![info exists selectedline]} {
3557 set oldsel -1
3558 } else {
3559 set oldsel $selectedline
3561 set didsel 0
3562 set fldtypes {Headline Author Date Committer CDate Comments}
3563 set l -1
3564 foreach id $displayorder {
3565 set d $commitdata($id)
3566 incr l
3567 if {$findtype == "Regexp"} {
3568 set doesmatch [regexp $foundstring $d]
3569 } elseif {$findtype == "IgnCase"} {
3570 set doesmatch [string match -nocase $matchstring $d]
3571 } else {
3572 set doesmatch [string match $matchstring $d]
3574 if {!$doesmatch} continue
3575 if {![info exists commitinfo($id)]} {
3576 getcommit $id
3578 set info $commitinfo($id)
3579 set doesmatch 0
3580 foreach f $info ty $fldtypes {
3581 if {$findloc != "All fields" && $findloc != $ty} {
3582 continue
3584 set matches [findmatches $f]
3585 if {$matches == {}} continue
3586 set doesmatch 1
3587 if {$ty == "Headline"} {
3588 drawcmitrow $l
3589 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3590 } elseif {$ty == "Author"} {
3591 drawcmitrow $l
3592 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3593 } elseif {$ty == "Date"} {
3594 drawcmitrow $l
3595 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3598 if {$doesmatch} {
3599 lappend matchinglines $l
3600 if {!$didsel && $l > $oldsel} {
3601 findselectline $l
3602 set didsel 1
3606 if {$matchinglines == {}} {
3607 bell
3608 } elseif {!$didsel} {
3609 findselectline [lindex $matchinglines 0]
3613 proc findselectline {l} {
3614 global findloc commentend ctext
3615 selectline $l 1
3616 if {$findloc == "All fields" || $findloc == "Comments"} {
3617 # highlight the matches in the comments
3618 set f [$ctext get 1.0 $commentend]
3619 set matches [findmatches $f]
3620 foreach match $matches {
3621 set start [lindex $match 0]
3622 set end [expr {[lindex $match 1] + 1}]
3623 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3628 proc findnext {restart} {
3629 global matchinglines selectedline
3630 if {![info exists matchinglines]} {
3631 if {$restart} {
3632 dofind
3634 return
3636 if {![info exists selectedline]} return
3637 foreach l $matchinglines {
3638 if {$l > $selectedline} {
3639 findselectline $l
3640 return
3643 bell
3646 proc findprev {} {
3647 global matchinglines selectedline
3648 if {![info exists matchinglines]} {
3649 dofind
3650 return
3652 if {![info exists selectedline]} return
3653 set prev {}
3654 foreach l $matchinglines {
3655 if {$l >= $selectedline} break
3656 set prev $l
3658 if {$prev != {}} {
3659 findselectline $prev
3660 } else {
3661 bell
3665 proc stopfindproc {{done 0}} {
3666 global findprocpid findprocfile findids
3667 global ctext findoldcursor phase maincursor textcursor
3668 global findinprogress
3670 catch {unset findids}
3671 if {[info exists findprocpid]} {
3672 if {!$done} {
3673 catch {exec kill $findprocpid}
3675 catch {close $findprocfile}
3676 unset findprocpid
3678 catch {unset findinprogress}
3679 notbusy find
3682 # mark a commit as matching by putting a yellow background
3683 # behind the headline
3684 proc markheadline {l id} {
3685 global canv mainfont linehtag
3687 drawcmitrow $l
3688 set bbox [$canv bbox $linehtag($l)]
3689 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3690 $canv lower $t
3693 # mark the bits of a headline, author or date that match a find string
3694 proc markmatches {canv l str tag matches font} {
3695 set bbox [$canv bbox $tag]
3696 set x0 [lindex $bbox 0]
3697 set y0 [lindex $bbox 1]
3698 set y1 [lindex $bbox 3]
3699 foreach match $matches {
3700 set start [lindex $match 0]
3701 set end [lindex $match 1]
3702 if {$start > $end} continue
3703 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3704 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3705 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3706 [expr {$x0+$xlen+2}] $y1 \
3707 -outline {} -tags matches -fill yellow]
3708 $canv lower $t
3712 proc unmarkmatches {} {
3713 global matchinglines findids
3714 allcanvs delete matches
3715 catch {unset matchinglines}
3716 catch {unset findids}
3719 proc selcanvline {w x y} {
3720 global canv canvy0 ctext linespc
3721 global rowtextx
3722 set ymax [lindex [$canv cget -scrollregion] 3]
3723 if {$ymax == {}} return
3724 set yfrac [lindex [$canv yview] 0]
3725 set y [expr {$y + $yfrac * $ymax}]
3726 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3727 if {$l < 0} {
3728 set l 0
3730 if {$w eq $canv} {
3731 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3733 unmarkmatches
3734 selectline $l 1
3737 proc commit_descriptor {p} {
3738 global commitinfo
3739 if {![info exists commitinfo($p)]} {
3740 getcommit $p
3742 set l "..."
3743 if {[llength $commitinfo($p)] > 1} {
3744 set l [lindex $commitinfo($p) 0]
3746 return "$p ($l)\n"
3749 # append some text to the ctext widget, and make any SHA1 ID
3750 # that we know about be a clickable link.
3751 proc appendwithlinks {text tags} {
3752 global ctext commitrow linknum curview
3754 set start [$ctext index "end - 1c"]
3755 $ctext insert end $text $tags
3756 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3757 foreach l $links {
3758 set s [lindex $l 0]
3759 set e [lindex $l 1]
3760 set linkid [string range $text $s $e]
3761 if {![info exists commitrow($curview,$linkid)]} continue
3762 incr e
3763 $ctext tag add link "$start + $s c" "$start + $e c"
3764 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3765 $ctext tag bind link$linknum <1> \
3766 [list selectline $commitrow($curview,$linkid) 1]
3767 incr linknum
3769 $ctext tag conf link -foreground blue -underline 1
3770 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3771 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3774 proc viewnextline {dir} {
3775 global canv linespc
3777 $canv delete hover
3778 set ymax [lindex [$canv cget -scrollregion] 3]
3779 set wnow [$canv yview]
3780 set wtop [expr {[lindex $wnow 0] * $ymax}]
3781 set newtop [expr {$wtop + $dir * $linespc}]
3782 if {$newtop < 0} {
3783 set newtop 0
3784 } elseif {$newtop > $ymax} {
3785 set newtop $ymax
3787 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3790 # add a list of tag or branch names at position pos
3791 # returns the number of names inserted
3792 proc appendrefs {pos tags var} {
3793 global ctext commitrow linknum curview $var
3795 if {[catch {$ctext index $pos}]} {
3796 return 0
3798 set tags [lsort $tags]
3799 set sep {}
3800 foreach tag $tags {
3801 set id [set $var\($tag\)]
3802 set lk link$linknum
3803 incr linknum
3804 $ctext insert $pos $sep
3805 $ctext insert $pos $tag $lk
3806 $ctext tag conf $lk -foreground blue
3807 if {[info exists commitrow($curview,$id)]} {
3808 $ctext tag bind $lk <1> \
3809 [list selectline $commitrow($curview,$id) 1]
3810 $ctext tag conf $lk -underline 1
3811 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3812 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3814 set sep ", "
3816 return [llength $tags]
3819 proc taglist {ids} {
3820 global idtags
3822 set tags {}
3823 foreach id $ids {
3824 foreach tag $idtags($id) {
3825 lappend tags $tag
3828 return $tags
3831 # called when we have finished computing the nearby tags
3832 proc dispneartags {} {
3833 global selectedline currentid ctext anc_tags desc_tags showneartags
3834 global desc_heads
3836 if {![info exists selectedline] || !$showneartags} return
3837 set id $currentid
3838 $ctext conf -state normal
3839 if {[info exists desc_heads($id)]} {
3840 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3841 $ctext insert "branch -2c" "es"
3844 if {[info exists anc_tags($id)]} {
3845 appendrefs follows [taglist $anc_tags($id)] tagids
3847 if {[info exists desc_tags($id)]} {
3848 appendrefs precedes [taglist $desc_tags($id)] tagids
3850 $ctext conf -state disabled
3853 proc selectline {l isnew} {
3854 global canv canv2 canv3 ctext commitinfo selectedline
3855 global displayorder linehtag linentag linedtag
3856 global canvy0 linespc parentlist childlist
3857 global currentid sha1entry
3858 global commentend idtags linknum
3859 global mergemax numcommits pending_select
3860 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3862 catch {unset pending_select}
3863 $canv delete hover
3864 normalline
3865 cancel_next_highlight
3866 if {$l < 0 || $l >= $numcommits} return
3867 set y [expr {$canvy0 + $l * $linespc}]
3868 set ymax [lindex [$canv cget -scrollregion] 3]
3869 set ytop [expr {$y - $linespc - 1}]
3870 set ybot [expr {$y + $linespc + 1}]
3871 set wnow [$canv yview]
3872 set wtop [expr {[lindex $wnow 0] * $ymax}]
3873 set wbot [expr {[lindex $wnow 1] * $ymax}]
3874 set wh [expr {$wbot - $wtop}]
3875 set newtop $wtop
3876 if {$ytop < $wtop} {
3877 if {$ybot < $wtop} {
3878 set newtop [expr {$y - $wh / 2.0}]
3879 } else {
3880 set newtop $ytop
3881 if {$newtop > $wtop - $linespc} {
3882 set newtop [expr {$wtop - $linespc}]
3885 } elseif {$ybot > $wbot} {
3886 if {$ytop > $wbot} {
3887 set newtop [expr {$y - $wh / 2.0}]
3888 } else {
3889 set newtop [expr {$ybot - $wh}]
3890 if {$newtop < $wtop + $linespc} {
3891 set newtop [expr {$wtop + $linespc}]
3895 if {$newtop != $wtop} {
3896 if {$newtop < 0} {
3897 set newtop 0
3899 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3900 drawvisible
3903 if {![info exists linehtag($l)]} return
3904 $canv delete secsel
3905 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3906 -tags secsel -fill [$canv cget -selectbackground]]
3907 $canv lower $t
3908 $canv2 delete secsel
3909 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3910 -tags secsel -fill [$canv2 cget -selectbackground]]
3911 $canv2 lower $t
3912 $canv3 delete secsel
3913 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3914 -tags secsel -fill [$canv3 cget -selectbackground]]
3915 $canv3 lower $t
3917 if {$isnew} {
3918 addtohistory [list selectline $l 0]
3921 set selectedline $l
3923 set id [lindex $displayorder $l]
3924 set currentid $id
3925 $sha1entry delete 0 end
3926 $sha1entry insert 0 $id
3927 $sha1entry selection from 0
3928 $sha1entry selection to end
3929 rhighlight_sel $id
3931 $ctext conf -state normal
3932 clear_ctext
3933 set linknum 0
3934 set info $commitinfo($id)
3935 set date [formatdate [lindex $info 2]]
3936 $ctext insert end "Author: [lindex $info 1] $date\n"
3937 set date [formatdate [lindex $info 4]]
3938 $ctext insert end "Committer: [lindex $info 3] $date\n"
3939 if {[info exists idtags($id)]} {
3940 $ctext insert end "Tags:"
3941 foreach tag $idtags($id) {
3942 $ctext insert end " $tag"
3944 $ctext insert end "\n"
3947 set headers {}
3948 set olds [lindex $parentlist $l]
3949 if {[llength $olds] > 1} {
3950 set np 0
3951 foreach p $olds {
3952 if {$np >= $mergemax} {
3953 set tag mmax
3954 } else {
3955 set tag m$np
3957 $ctext insert end "Parent: " $tag
3958 appendwithlinks [commit_descriptor $p] {}
3959 incr np
3961 } else {
3962 foreach p $olds {
3963 append headers "Parent: [commit_descriptor $p]"
3967 foreach c [lindex $childlist $l] {
3968 append headers "Child: [commit_descriptor $c]"
3971 # make anything that looks like a SHA1 ID be a clickable link
3972 appendwithlinks $headers {}
3973 if {$showneartags} {
3974 if {![info exists allcommits]} {
3975 getallcommits
3977 $ctext insert end "Branch: "
3978 $ctext mark set branch "end -1c"
3979 $ctext mark gravity branch left
3980 if {[info exists desc_heads($id)]} {
3981 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3982 # turn "Branch" into "Branches"
3983 $ctext insert "branch -2c" "es"
3986 $ctext insert end "\nFollows: "
3987 $ctext mark set follows "end -1c"
3988 $ctext mark gravity follows left
3989 if {[info exists anc_tags($id)]} {
3990 appendrefs follows [taglist $anc_tags($id)] tagids
3992 $ctext insert end "\nPrecedes: "
3993 $ctext mark set precedes "end -1c"
3994 $ctext mark gravity precedes left
3995 if {[info exists desc_tags($id)]} {
3996 appendrefs precedes [taglist $desc_tags($id)] tagids
3998 $ctext insert end "\n"
4000 $ctext insert end "\n"
4001 appendwithlinks [lindex $info 5] {comment}
4003 $ctext tag delete Comments
4004 $ctext tag remove found 1.0 end
4005 $ctext conf -state disabled
4006 set commentend [$ctext index "end - 1c"]
4008 init_flist "Comments"
4009 if {$cmitmode eq "tree"} {
4010 gettree $id
4011 } elseif {[llength $olds] <= 1} {
4012 startdiff $id
4013 } else {
4014 mergediff $id $l
4018 proc selfirstline {} {
4019 unmarkmatches
4020 selectline 0 1
4023 proc sellastline {} {
4024 global numcommits
4025 unmarkmatches
4026 set l [expr {$numcommits - 1}]
4027 selectline $l 1
4030 proc selnextline {dir} {
4031 global selectedline
4032 if {![info exists selectedline]} return
4033 set l [expr {$selectedline + $dir}]
4034 unmarkmatches
4035 selectline $l 1
4038 proc selnextpage {dir} {
4039 global canv linespc selectedline numcommits
4041 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4042 if {$lpp < 1} {
4043 set lpp 1
4045 allcanvs yview scroll [expr {$dir * $lpp}] units
4046 drawvisible
4047 if {![info exists selectedline]} return
4048 set l [expr {$selectedline + $dir * $lpp}]
4049 if {$l < 0} {
4050 set l 0
4051 } elseif {$l >= $numcommits} {
4052 set l [expr $numcommits - 1]
4054 unmarkmatches
4055 selectline $l 1
4058 proc unselectline {} {
4059 global selectedline currentid
4061 catch {unset selectedline}
4062 catch {unset currentid}
4063 allcanvs delete secsel
4064 rhighlight_none
4065 cancel_next_highlight
4068 proc reselectline {} {
4069 global selectedline
4071 if {[info exists selectedline]} {
4072 selectline $selectedline 0
4076 proc addtohistory {cmd} {
4077 global history historyindex curview
4079 set elt [list $curview $cmd]
4080 if {$historyindex > 0
4081 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4082 return
4085 if {$historyindex < [llength $history]} {
4086 set history [lreplace $history $historyindex end $elt]
4087 } else {
4088 lappend history $elt
4090 incr historyindex
4091 if {$historyindex > 1} {
4092 .tf.bar.leftbut conf -state normal
4093 } else {
4094 .tf.bar.leftbut conf -state disabled
4096 .tf.bar.rightbut conf -state disabled
4099 proc godo {elt} {
4100 global curview
4102 set view [lindex $elt 0]
4103 set cmd [lindex $elt 1]
4104 if {$curview != $view} {
4105 showview $view
4107 eval $cmd
4110 proc goback {} {
4111 global history historyindex
4113 if {$historyindex > 1} {
4114 incr historyindex -1
4115 godo [lindex $history [expr {$historyindex - 1}]]
4116 .tf.bar.rightbut conf -state normal
4118 if {$historyindex <= 1} {
4119 .tf.bar.leftbut conf -state disabled
4123 proc goforw {} {
4124 global history historyindex
4126 if {$historyindex < [llength $history]} {
4127 set cmd [lindex $history $historyindex]
4128 incr historyindex
4129 godo $cmd
4130 .tf.bar.leftbut conf -state normal
4132 if {$historyindex >= [llength $history]} {
4133 .tf.bar.rightbut conf -state disabled
4137 proc gettree {id} {
4138 global treefilelist treeidlist diffids diffmergeid treepending
4140 set diffids $id
4141 catch {unset diffmergeid}
4142 if {![info exists treefilelist($id)]} {
4143 if {![info exists treepending]} {
4144 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4145 return
4147 set treepending $id
4148 set treefilelist($id) {}
4149 set treeidlist($id) {}
4150 fconfigure $gtf -blocking 0
4151 fileevent $gtf readable [list gettreeline $gtf $id]
4153 } else {
4154 setfilelist $id
4158 proc gettreeline {gtf id} {
4159 global treefilelist treeidlist treepending cmitmode diffids
4161 while {[gets $gtf line] >= 0} {
4162 if {[lindex $line 1] ne "blob"} continue
4163 set sha1 [lindex $line 2]
4164 set fname [lindex $line 3]
4165 lappend treefilelist($id) $fname
4166 lappend treeidlist($id) $sha1
4168 if {![eof $gtf]} return
4169 close $gtf
4170 unset treepending
4171 if {$cmitmode ne "tree"} {
4172 if {![info exists diffmergeid]} {
4173 gettreediffs $diffids
4175 } elseif {$id ne $diffids} {
4176 gettree $diffids
4177 } else {
4178 setfilelist $id
4182 proc showfile {f} {
4183 global treefilelist treeidlist diffids
4184 global ctext commentend
4186 set i [lsearch -exact $treefilelist($diffids) $f]
4187 if {$i < 0} {
4188 puts "oops, $f not in list for id $diffids"
4189 return
4191 set blob [lindex $treeidlist($diffids) $i]
4192 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4193 puts "oops, error reading blob $blob: $err"
4194 return
4196 fconfigure $bf -blocking 0
4197 fileevent $bf readable [list getblobline $bf $diffids]
4198 $ctext config -state normal
4199 clear_ctext $commentend
4200 $ctext insert end "\n"
4201 $ctext insert end "$f\n" filesep
4202 $ctext config -state disabled
4203 $ctext yview $commentend
4206 proc getblobline {bf id} {
4207 global diffids cmitmode ctext
4209 if {$id ne $diffids || $cmitmode ne "tree"} {
4210 catch {close $bf}
4211 return
4213 $ctext config -state normal
4214 while {[gets $bf line] >= 0} {
4215 $ctext insert end "$line\n"
4217 if {[eof $bf]} {
4218 # delete last newline
4219 $ctext delete "end - 2c" "end - 1c"
4220 close $bf
4222 $ctext config -state disabled
4225 proc mergediff {id l} {
4226 global diffmergeid diffopts mdifffd
4227 global diffids
4228 global parentlist
4230 set diffmergeid $id
4231 set diffids $id
4232 # this doesn't seem to actually affect anything...
4233 set env(GIT_DIFF_OPTS) $diffopts
4234 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4235 if {[catch {set mdf [open $cmd r]} err]} {
4236 error_popup "Error getting merge diffs: $err"
4237 return
4239 fconfigure $mdf -blocking 0
4240 set mdifffd($id) $mdf
4241 set np [llength [lindex $parentlist $l]]
4242 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4243 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4246 proc getmergediffline {mdf id np} {
4247 global diffmergeid ctext cflist nextupdate mergemax
4248 global difffilestart mdifffd
4250 set n [gets $mdf line]
4251 if {$n < 0} {
4252 if {[eof $mdf]} {
4253 close $mdf
4255 return
4257 if {![info exists diffmergeid] || $id != $diffmergeid
4258 || $mdf != $mdifffd($id)} {
4259 return
4261 $ctext conf -state normal
4262 if {[regexp {^diff --cc (.*)} $line match fname]} {
4263 # start of a new file
4264 $ctext insert end "\n"
4265 set here [$ctext index "end - 1c"]
4266 lappend difffilestart $here
4267 add_flist [list $fname]
4268 set l [expr {(78 - [string length $fname]) / 2}]
4269 set pad [string range "----------------------------------------" 1 $l]
4270 $ctext insert end "$pad $fname $pad\n" filesep
4271 } elseif {[regexp {^@@} $line]} {
4272 $ctext insert end "$line\n" hunksep
4273 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4274 # do nothing
4275 } else {
4276 # parse the prefix - one ' ', '-' or '+' for each parent
4277 set spaces {}
4278 set minuses {}
4279 set pluses {}
4280 set isbad 0
4281 for {set j 0} {$j < $np} {incr j} {
4282 set c [string range $line $j $j]
4283 if {$c == " "} {
4284 lappend spaces $j
4285 } elseif {$c == "-"} {
4286 lappend minuses $j
4287 } elseif {$c == "+"} {
4288 lappend pluses $j
4289 } else {
4290 set isbad 1
4291 break
4294 set tags {}
4295 set num {}
4296 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4297 # line doesn't appear in result, parents in $minuses have the line
4298 set num [lindex $minuses 0]
4299 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4300 # line appears in result, parents in $pluses don't have the line
4301 lappend tags mresult
4302 set num [lindex $spaces 0]
4304 if {$num ne {}} {
4305 if {$num >= $mergemax} {
4306 set num "max"
4308 lappend tags m$num
4310 $ctext insert end "$line\n" $tags
4312 $ctext conf -state disabled
4313 if {[clock clicks -milliseconds] >= $nextupdate} {
4314 incr nextupdate 100
4315 fileevent $mdf readable {}
4316 update
4317 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4321 proc startdiff {ids} {
4322 global treediffs diffids treepending diffmergeid
4324 set diffids $ids
4325 catch {unset diffmergeid}
4326 if {![info exists treediffs($ids)]} {
4327 if {![info exists treepending]} {
4328 gettreediffs $ids
4330 } else {
4331 addtocflist $ids
4335 proc addtocflist {ids} {
4336 global treediffs cflist
4337 add_flist $treediffs($ids)
4338 getblobdiffs $ids
4341 proc gettreediffs {ids} {
4342 global treediff treepending
4343 set treepending $ids
4344 set treediff {}
4345 if {[catch \
4346 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4347 ]} return
4348 fconfigure $gdtf -blocking 0
4349 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4352 proc gettreediffline {gdtf ids} {
4353 global treediff treediffs treepending diffids diffmergeid
4354 global cmitmode
4356 set n [gets $gdtf line]
4357 if {$n < 0} {
4358 if {![eof $gdtf]} return
4359 close $gdtf
4360 set treediffs($ids) $treediff
4361 unset treepending
4362 if {$cmitmode eq "tree"} {
4363 gettree $diffids
4364 } elseif {$ids != $diffids} {
4365 if {![info exists diffmergeid]} {
4366 gettreediffs $diffids
4368 } else {
4369 addtocflist $ids
4371 return
4373 set file [lindex $line 5]
4374 lappend treediff $file
4377 proc getblobdiffs {ids} {
4378 global diffopts blobdifffd diffids env curdifftag curtagstart
4379 global nextupdate diffinhdr treediffs
4381 set env(GIT_DIFF_OPTS) $diffopts
4382 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4383 if {[catch {set bdf [open $cmd r]} err]} {
4384 puts "error getting diffs: $err"
4385 return
4387 set diffinhdr 0
4388 fconfigure $bdf -blocking 0
4389 set blobdifffd($ids) $bdf
4390 set curdifftag Comments
4391 set curtagstart 0.0
4392 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4393 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4396 proc setinlist {var i val} {
4397 global $var
4399 while {[llength [set $var]] < $i} {
4400 lappend $var {}
4402 if {[llength [set $var]] == $i} {
4403 lappend $var $val
4404 } else {
4405 lset $var $i $val
4409 proc getblobdiffline {bdf ids} {
4410 global diffids blobdifffd ctext curdifftag curtagstart
4411 global diffnexthead diffnextnote difffilestart
4412 global nextupdate diffinhdr treediffs
4414 set n [gets $bdf line]
4415 if {$n < 0} {
4416 if {[eof $bdf]} {
4417 close $bdf
4418 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4419 $ctext tag add $curdifftag $curtagstart end
4422 return
4424 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4425 return
4427 $ctext conf -state normal
4428 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4429 # start of a new file
4430 $ctext insert end "\n"
4431 $ctext tag add $curdifftag $curtagstart end
4432 set here [$ctext index "end - 1c"]
4433 set curtagstart $here
4434 set header $newname
4435 set i [lsearch -exact $treediffs($ids) $fname]
4436 if {$i >= 0} {
4437 setinlist difffilestart $i $here
4439 if {$newname ne $fname} {
4440 set i [lsearch -exact $treediffs($ids) $newname]
4441 if {$i >= 0} {
4442 setinlist difffilestart $i $here
4445 set curdifftag "f:$fname"
4446 $ctext tag delete $curdifftag
4447 set l [expr {(78 - [string length $header]) / 2}]
4448 set pad [string range "----------------------------------------" 1 $l]
4449 $ctext insert end "$pad $header $pad\n" filesep
4450 set diffinhdr 1
4451 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4452 # do nothing
4453 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4454 set diffinhdr 0
4455 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4456 $line match f1l f1c f2l f2c rest]} {
4457 $ctext insert end "$line\n" hunksep
4458 set diffinhdr 0
4459 } else {
4460 set x [string range $line 0 0]
4461 if {$x == "-" || $x == "+"} {
4462 set tag [expr {$x == "+"}]
4463 $ctext insert end "$line\n" d$tag
4464 } elseif {$x == " "} {
4465 $ctext insert end "$line\n"
4466 } elseif {$diffinhdr || $x == "\\"} {
4467 # e.g. "\ No newline at end of file"
4468 $ctext insert end "$line\n" filesep
4469 } else {
4470 # Something else we don't recognize
4471 if {$curdifftag != "Comments"} {
4472 $ctext insert end "\n"
4473 $ctext tag add $curdifftag $curtagstart end
4474 set curtagstart [$ctext index "end - 1c"]
4475 set curdifftag Comments
4477 $ctext insert end "$line\n" filesep
4480 $ctext conf -state disabled
4481 if {[clock clicks -milliseconds] >= $nextupdate} {
4482 incr nextupdate 100
4483 fileevent $bdf readable {}
4484 update
4485 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4489 proc prevfile {} {
4490 global difffilestart ctext
4491 set prev [lindex $difffilestart 0]
4492 set here [$ctext index @0,0]
4493 foreach loc $difffilestart {
4494 if {[$ctext compare $loc >= $here]} {
4495 $ctext yview $prev
4496 return
4498 set prev $loc
4500 $ctext yview $prev
4503 proc nextfile {} {
4504 global difffilestart ctext
4505 set here [$ctext index @0,0]
4506 foreach loc $difffilestart {
4507 if {[$ctext compare $loc > $here]} {
4508 $ctext yview $loc
4509 return
4514 proc clear_ctext {{first 1.0}} {
4515 global ctext smarktop smarkbot
4517 set l [lindex [split $first .] 0]
4518 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4519 set smarktop $l
4521 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4522 set smarkbot $l
4524 $ctext delete $first end
4527 proc incrsearch {name ix op} {
4528 global ctext searchstring searchdirn
4530 $ctext tag remove found 1.0 end
4531 if {[catch {$ctext index anchor}]} {
4532 # no anchor set, use start of selection, or of visible area
4533 set sel [$ctext tag ranges sel]
4534 if {$sel ne {}} {
4535 $ctext mark set anchor [lindex $sel 0]
4536 } elseif {$searchdirn eq "-forwards"} {
4537 $ctext mark set anchor @0,0
4538 } else {
4539 $ctext mark set anchor @0,[winfo height $ctext]
4542 if {$searchstring ne {}} {
4543 set here [$ctext search $searchdirn -- $searchstring anchor]
4544 if {$here ne {}} {
4545 $ctext see $here
4547 searchmarkvisible 1
4551 proc dosearch {} {
4552 global sstring ctext searchstring searchdirn
4554 focus $sstring
4555 $sstring icursor end
4556 set searchdirn -forwards
4557 if {$searchstring ne {}} {
4558 set sel [$ctext tag ranges sel]
4559 if {$sel ne {}} {
4560 set start "[lindex $sel 0] + 1c"
4561 } elseif {[catch {set start [$ctext index anchor]}]} {
4562 set start "@0,0"
4564 set match [$ctext search -count mlen -- $searchstring $start]
4565 $ctext tag remove sel 1.0 end
4566 if {$match eq {}} {
4567 bell
4568 return
4570 $ctext see $match
4571 set mend "$match + $mlen c"
4572 $ctext tag add sel $match $mend
4573 $ctext mark unset anchor
4577 proc dosearchback {} {
4578 global sstring ctext searchstring searchdirn
4580 focus $sstring
4581 $sstring icursor end
4582 set searchdirn -backwards
4583 if {$searchstring ne {}} {
4584 set sel [$ctext tag ranges sel]
4585 if {$sel ne {}} {
4586 set start [lindex $sel 0]
4587 } elseif {[catch {set start [$ctext index anchor]}]} {
4588 set start @0,[winfo height $ctext]
4590 set match [$ctext search -backwards -count ml -- $searchstring $start]
4591 $ctext tag remove sel 1.0 end
4592 if {$match eq {}} {
4593 bell
4594 return
4596 $ctext see $match
4597 set mend "$match + $ml c"
4598 $ctext tag add sel $match $mend
4599 $ctext mark unset anchor
4603 proc searchmark {first last} {
4604 global ctext searchstring
4606 set mend $first.0
4607 while {1} {
4608 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4609 if {$match eq {}} break
4610 set mend "$match + $mlen c"
4611 $ctext tag add found $match $mend
4615 proc searchmarkvisible {doall} {
4616 global ctext smarktop smarkbot
4618 set topline [lindex [split [$ctext index @0,0] .] 0]
4619 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4620 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4621 # no overlap with previous
4622 searchmark $topline $botline
4623 set smarktop $topline
4624 set smarkbot $botline
4625 } else {
4626 if {$topline < $smarktop} {
4627 searchmark $topline [expr {$smarktop-1}]
4628 set smarktop $topline
4630 if {$botline > $smarkbot} {
4631 searchmark [expr {$smarkbot+1}] $botline
4632 set smarkbot $botline
4637 proc scrolltext {f0 f1} {
4638 global searchstring
4640 .bleft.sb set $f0 $f1
4641 if {$searchstring ne {}} {
4642 searchmarkvisible 0
4646 proc setcoords {} {
4647 global linespc charspc canvx0 canvy0 mainfont
4648 global xspc1 xspc2 lthickness
4650 set linespc [font metrics $mainfont -linespace]
4651 set charspc [font measure $mainfont "m"]
4652 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4653 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4654 set lthickness [expr {int($linespc / 9) + 1}]
4655 set xspc1(0) $linespc
4656 set xspc2 $linespc
4659 proc redisplay {} {
4660 global canv
4661 global selectedline
4663 set ymax [lindex [$canv cget -scrollregion] 3]
4664 if {$ymax eq {} || $ymax == 0} return
4665 set span [$canv yview]
4666 clear_display
4667 setcanvscroll
4668 allcanvs yview moveto [lindex $span 0]
4669 drawvisible
4670 if {[info exists selectedline]} {
4671 selectline $selectedline 0
4672 allcanvs yview moveto [lindex $span 0]
4676 proc incrfont {inc} {
4677 global mainfont textfont ctext canv phase
4678 global stopped entries
4679 unmarkmatches
4680 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4681 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4682 setcoords
4683 $ctext conf -font $textfont
4684 $ctext tag conf filesep -font [concat $textfont bold]
4685 foreach e $entries {
4686 $e conf -font $mainfont
4688 if {$phase eq "getcommits"} {
4689 $canv itemconf textitems -font $mainfont
4691 redisplay
4694 proc clearsha1 {} {
4695 global sha1entry sha1string
4696 if {[string length $sha1string] == 40} {
4697 $sha1entry delete 0 end
4701 proc sha1change {n1 n2 op} {
4702 global sha1string currentid sha1but
4703 if {$sha1string == {}
4704 || ([info exists currentid] && $sha1string == $currentid)} {
4705 set state disabled
4706 } else {
4707 set state normal
4709 if {[$sha1but cget -state] == $state} return
4710 if {$state == "normal"} {
4711 $sha1but conf -state normal -relief raised -text "Goto: "
4712 } else {
4713 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4717 proc gotocommit {} {
4718 global sha1string currentid commitrow tagids headids
4719 global displayorder numcommits curview
4721 if {$sha1string == {}
4722 || ([info exists currentid] && $sha1string == $currentid)} return
4723 if {[info exists tagids($sha1string)]} {
4724 set id $tagids($sha1string)
4725 } elseif {[info exists headids($sha1string)]} {
4726 set id $headids($sha1string)
4727 } else {
4728 set id [string tolower $sha1string]
4729 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4730 set matches {}
4731 foreach i $displayorder {
4732 if {[string match $id* $i]} {
4733 lappend matches $i
4736 if {$matches ne {}} {
4737 if {[llength $matches] > 1} {
4738 error_popup "Short SHA1 id $id is ambiguous"
4739 return
4741 set id [lindex $matches 0]
4745 if {[info exists commitrow($curview,$id)]} {
4746 selectline $commitrow($curview,$id) 1
4747 return
4749 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4750 set type "SHA1 id"
4751 } else {
4752 set type "Tag/Head"
4754 error_popup "$type $sha1string is not known"
4757 proc lineenter {x y id} {
4758 global hoverx hovery hoverid hovertimer
4759 global commitinfo canv
4761 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4762 set hoverx $x
4763 set hovery $y
4764 set hoverid $id
4765 if {[info exists hovertimer]} {
4766 after cancel $hovertimer
4768 set hovertimer [after 500 linehover]
4769 $canv delete hover
4772 proc linemotion {x y id} {
4773 global hoverx hovery hoverid hovertimer
4775 if {[info exists hoverid] && $id == $hoverid} {
4776 set hoverx $x
4777 set hovery $y
4778 if {[info exists hovertimer]} {
4779 after cancel $hovertimer
4781 set hovertimer [after 500 linehover]
4785 proc lineleave {id} {
4786 global hoverid hovertimer canv
4788 if {[info exists hoverid] && $id == $hoverid} {
4789 $canv delete hover
4790 if {[info exists hovertimer]} {
4791 after cancel $hovertimer
4792 unset hovertimer
4794 unset hoverid
4798 proc linehover {} {
4799 global hoverx hovery hoverid hovertimer
4800 global canv linespc lthickness
4801 global commitinfo mainfont
4803 set text [lindex $commitinfo($hoverid) 0]
4804 set ymax [lindex [$canv cget -scrollregion] 3]
4805 if {$ymax == {}} return
4806 set yfrac [lindex [$canv yview] 0]
4807 set x [expr {$hoverx + 2 * $linespc}]
4808 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4809 set x0 [expr {$x - 2 * $lthickness}]
4810 set y0 [expr {$y - 2 * $lthickness}]
4811 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4812 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4813 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4814 -fill \#ffff80 -outline black -width 1 -tags hover]
4815 $canv raise $t
4816 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4817 -font $mainfont]
4818 $canv raise $t
4821 proc clickisonarrow {id y} {
4822 global lthickness
4824 set ranges [rowranges $id]
4825 set thresh [expr {2 * $lthickness + 6}]
4826 set n [expr {[llength $ranges] - 1}]
4827 for {set i 1} {$i < $n} {incr i} {
4828 set row [lindex $ranges $i]
4829 if {abs([yc $row] - $y) < $thresh} {
4830 return $i
4833 return {}
4836 proc arrowjump {id n y} {
4837 global canv
4839 # 1 <-> 2, 3 <-> 4, etc...
4840 set n [expr {(($n - 1) ^ 1) + 1}]
4841 set row [lindex [rowranges $id] $n]
4842 set yt [yc $row]
4843 set ymax [lindex [$canv cget -scrollregion] 3]
4844 if {$ymax eq {} || $ymax <= 0} return
4845 set view [$canv yview]
4846 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4847 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4848 if {$yfrac < 0} {
4849 set yfrac 0
4851 allcanvs yview moveto $yfrac
4854 proc lineclick {x y id isnew} {
4855 global ctext commitinfo children canv thickerline curview
4857 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4858 unmarkmatches
4859 unselectline
4860 normalline
4861 $canv delete hover
4862 # draw this line thicker than normal
4863 set thickerline $id
4864 drawlines $id
4865 if {$isnew} {
4866 set ymax [lindex [$canv cget -scrollregion] 3]
4867 if {$ymax eq {}} return
4868 set yfrac [lindex [$canv yview] 0]
4869 set y [expr {$y + $yfrac * $ymax}]
4871 set dirn [clickisonarrow $id $y]
4872 if {$dirn ne {}} {
4873 arrowjump $id $dirn $y
4874 return
4877 if {$isnew} {
4878 addtohistory [list lineclick $x $y $id 0]
4880 # fill the details pane with info about this line
4881 $ctext conf -state normal
4882 clear_ctext
4883 $ctext tag conf link -foreground blue -underline 1
4884 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4885 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4886 $ctext insert end "Parent:\t"
4887 $ctext insert end $id [list link link0]
4888 $ctext tag bind link0 <1> [list selbyid $id]
4889 set info $commitinfo($id)
4890 $ctext insert end "\n\t[lindex $info 0]\n"
4891 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4892 set date [formatdate [lindex $info 2]]
4893 $ctext insert end "\tDate:\t$date\n"
4894 set kids $children($curview,$id)
4895 if {$kids ne {}} {
4896 $ctext insert end "\nChildren:"
4897 set i 0
4898 foreach child $kids {
4899 incr i
4900 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4901 set info $commitinfo($child)
4902 $ctext insert end "\n\t"
4903 $ctext insert end $child [list link link$i]
4904 $ctext tag bind link$i <1> [list selbyid $child]
4905 $ctext insert end "\n\t[lindex $info 0]"
4906 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4907 set date [formatdate [lindex $info 2]]
4908 $ctext insert end "\n\tDate:\t$date\n"
4911 $ctext conf -state disabled
4912 init_flist {}
4915 proc normalline {} {
4916 global thickerline
4917 if {[info exists thickerline]} {
4918 set id $thickerline
4919 unset thickerline
4920 drawlines $id
4924 proc selbyid {id} {
4925 global commitrow curview
4926 if {[info exists commitrow($curview,$id)]} {
4927 selectline $commitrow($curview,$id) 1
4931 proc mstime {} {
4932 global startmstime
4933 if {![info exists startmstime]} {
4934 set startmstime [clock clicks -milliseconds]
4936 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4939 proc rowmenu {x y id} {
4940 global rowctxmenu commitrow selectedline rowmenuid curview
4942 if {![info exists selectedline]
4943 || $commitrow($curview,$id) eq $selectedline} {
4944 set state disabled
4945 } else {
4946 set state normal
4948 $rowctxmenu entryconfigure "Diff this*" -state $state
4949 $rowctxmenu entryconfigure "Diff selected*" -state $state
4950 $rowctxmenu entryconfigure "Make patch" -state $state
4951 set rowmenuid $id
4952 tk_popup $rowctxmenu $x $y
4955 proc diffvssel {dirn} {
4956 global rowmenuid selectedline displayorder
4958 if {![info exists selectedline]} return
4959 if {$dirn} {
4960 set oldid [lindex $displayorder $selectedline]
4961 set newid $rowmenuid
4962 } else {
4963 set oldid $rowmenuid
4964 set newid [lindex $displayorder $selectedline]
4966 addtohistory [list doseldiff $oldid $newid]
4967 doseldiff $oldid $newid
4970 proc doseldiff {oldid newid} {
4971 global ctext
4972 global commitinfo
4974 $ctext conf -state normal
4975 clear_ctext
4976 init_flist "Top"
4977 $ctext insert end "From "
4978 $ctext tag conf link -foreground blue -underline 1
4979 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4980 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4981 $ctext tag bind link0 <1> [list selbyid $oldid]
4982 $ctext insert end $oldid [list link link0]
4983 $ctext insert end "\n "
4984 $ctext insert end [lindex $commitinfo($oldid) 0]
4985 $ctext insert end "\n\nTo "
4986 $ctext tag bind link1 <1> [list selbyid $newid]
4987 $ctext insert end $newid [list link link1]
4988 $ctext insert end "\n "
4989 $ctext insert end [lindex $commitinfo($newid) 0]
4990 $ctext insert end "\n"
4991 $ctext conf -state disabled
4992 $ctext tag delete Comments
4993 $ctext tag remove found 1.0 end
4994 startdiff [list $oldid $newid]
4997 proc mkpatch {} {
4998 global rowmenuid currentid commitinfo patchtop patchnum
5000 if {![info exists currentid]} return
5001 set oldid $currentid
5002 set oldhead [lindex $commitinfo($oldid) 0]
5003 set newid $rowmenuid
5004 set newhead [lindex $commitinfo($newid) 0]
5005 set top .patch
5006 set patchtop $top
5007 catch {destroy $top}
5008 toplevel $top
5009 label $top.title -text "Generate patch"
5010 grid $top.title - -pady 10
5011 label $top.from -text "From:"
5012 entry $top.fromsha1 -width 40 -relief flat
5013 $top.fromsha1 insert 0 $oldid
5014 $top.fromsha1 conf -state readonly
5015 grid $top.from $top.fromsha1 -sticky w
5016 entry $top.fromhead -width 60 -relief flat
5017 $top.fromhead insert 0 $oldhead
5018 $top.fromhead conf -state readonly
5019 grid x $top.fromhead -sticky w
5020 label $top.to -text "To:"
5021 entry $top.tosha1 -width 40 -relief flat
5022 $top.tosha1 insert 0 $newid
5023 $top.tosha1 conf -state readonly
5024 grid $top.to $top.tosha1 -sticky w
5025 entry $top.tohead -width 60 -relief flat
5026 $top.tohead insert 0 $newhead
5027 $top.tohead conf -state readonly
5028 grid x $top.tohead -sticky w
5029 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5030 grid $top.rev x -pady 10
5031 label $top.flab -text "Output file:"
5032 entry $top.fname -width 60
5033 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5034 incr patchnum
5035 grid $top.flab $top.fname -sticky w
5036 frame $top.buts
5037 button $top.buts.gen -text "Generate" -command mkpatchgo
5038 button $top.buts.can -text "Cancel" -command mkpatchcan
5039 grid $top.buts.gen $top.buts.can
5040 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5041 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5042 grid $top.buts - -pady 10 -sticky ew
5043 focus $top.fname
5046 proc mkpatchrev {} {
5047 global patchtop
5049 set oldid [$patchtop.fromsha1 get]
5050 set oldhead [$patchtop.fromhead get]
5051 set newid [$patchtop.tosha1 get]
5052 set newhead [$patchtop.tohead get]
5053 foreach e [list fromsha1 fromhead tosha1 tohead] \
5054 v [list $newid $newhead $oldid $oldhead] {
5055 $patchtop.$e conf -state normal
5056 $patchtop.$e delete 0 end
5057 $patchtop.$e insert 0 $v
5058 $patchtop.$e conf -state readonly
5062 proc mkpatchgo {} {
5063 global patchtop
5065 set oldid [$patchtop.fromsha1 get]
5066 set newid [$patchtop.tosha1 get]
5067 set fname [$patchtop.fname get]
5068 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5069 error_popup "Error creating patch: $err"
5071 catch {destroy $patchtop}
5072 unset patchtop
5075 proc mkpatchcan {} {
5076 global patchtop
5078 catch {destroy $patchtop}
5079 unset patchtop
5082 proc mktag {} {
5083 global rowmenuid mktagtop commitinfo
5085 set top .maketag
5086 set mktagtop $top
5087 catch {destroy $top}
5088 toplevel $top
5089 label $top.title -text "Create tag"
5090 grid $top.title - -pady 10
5091 label $top.id -text "ID:"
5092 entry $top.sha1 -width 40 -relief flat
5093 $top.sha1 insert 0 $rowmenuid
5094 $top.sha1 conf -state readonly
5095 grid $top.id $top.sha1 -sticky w
5096 entry $top.head -width 60 -relief flat
5097 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5098 $top.head conf -state readonly
5099 grid x $top.head -sticky w
5100 label $top.tlab -text "Tag name:"
5101 entry $top.tag -width 60
5102 grid $top.tlab $top.tag -sticky w
5103 frame $top.buts
5104 button $top.buts.gen -text "Create" -command mktaggo
5105 button $top.buts.can -text "Cancel" -command mktagcan
5106 grid $top.buts.gen $top.buts.can
5107 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5108 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5109 grid $top.buts - -pady 10 -sticky ew
5110 focus $top.tag
5113 proc domktag {} {
5114 global mktagtop env tagids idtags
5116 set id [$mktagtop.sha1 get]
5117 set tag [$mktagtop.tag get]
5118 if {$tag == {}} {
5119 error_popup "No tag name specified"
5120 return
5122 if {[info exists tagids($tag)]} {
5123 error_popup "Tag \"$tag\" already exists"
5124 return
5126 if {[catch {
5127 set dir [gitdir]
5128 set fname [file join $dir "refs/tags" $tag]
5129 set f [open $fname w]
5130 puts $f $id
5131 close $f
5132 } err]} {
5133 error_popup "Error creating tag: $err"
5134 return
5137 set tagids($tag) $id
5138 lappend idtags($id) $tag
5139 redrawtags $id
5140 addedtag $id
5143 proc redrawtags {id} {
5144 global canv linehtag commitrow idpos selectedline curview
5145 global mainfont canvxmax
5147 if {![info exists commitrow($curview,$id)]} return
5148 drawcmitrow $commitrow($curview,$id)
5149 $canv delete tag.$id
5150 set xt [eval drawtags $id $idpos($id)]
5151 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5152 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5153 set xr [expr {$xt + [font measure $mainfont $text]}]
5154 if {$xr > $canvxmax} {
5155 set canvxmax $xr
5156 setcanvscroll
5158 if {[info exists selectedline]
5159 && $selectedline == $commitrow($curview,$id)} {
5160 selectline $selectedline 0
5164 proc mktagcan {} {
5165 global mktagtop
5167 catch {destroy $mktagtop}
5168 unset mktagtop
5171 proc mktaggo {} {
5172 domktag
5173 mktagcan
5176 proc writecommit {} {
5177 global rowmenuid wrcomtop commitinfo wrcomcmd
5179 set top .writecommit
5180 set wrcomtop $top
5181 catch {destroy $top}
5182 toplevel $top
5183 label $top.title -text "Write commit to file"
5184 grid $top.title - -pady 10
5185 label $top.id -text "ID:"
5186 entry $top.sha1 -width 40 -relief flat
5187 $top.sha1 insert 0 $rowmenuid
5188 $top.sha1 conf -state readonly
5189 grid $top.id $top.sha1 -sticky w
5190 entry $top.head -width 60 -relief flat
5191 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5192 $top.head conf -state readonly
5193 grid x $top.head -sticky w
5194 label $top.clab -text "Command:"
5195 entry $top.cmd -width 60 -textvariable wrcomcmd
5196 grid $top.clab $top.cmd -sticky w -pady 10
5197 label $top.flab -text "Output file:"
5198 entry $top.fname -width 60
5199 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5200 grid $top.flab $top.fname -sticky w
5201 frame $top.buts
5202 button $top.buts.gen -text "Write" -command wrcomgo
5203 button $top.buts.can -text "Cancel" -command wrcomcan
5204 grid $top.buts.gen $top.buts.can
5205 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5206 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5207 grid $top.buts - -pady 10 -sticky ew
5208 focus $top.fname
5211 proc wrcomgo {} {
5212 global wrcomtop
5214 set id [$wrcomtop.sha1 get]
5215 set cmd "echo $id | [$wrcomtop.cmd get]"
5216 set fname [$wrcomtop.fname get]
5217 if {[catch {exec sh -c $cmd >$fname &} err]} {
5218 error_popup "Error writing commit: $err"
5220 catch {destroy $wrcomtop}
5221 unset wrcomtop
5224 proc wrcomcan {} {
5225 global wrcomtop
5227 catch {destroy $wrcomtop}
5228 unset wrcomtop
5231 proc mkbranch {} {
5232 global rowmenuid mkbrtop
5234 set top .makebranch
5235 catch {destroy $top}
5236 toplevel $top
5237 label $top.title -text "Create new branch"
5238 grid $top.title - -pady 10
5239 label $top.id -text "ID:"
5240 entry $top.sha1 -width 40 -relief flat
5241 $top.sha1 insert 0 $rowmenuid
5242 $top.sha1 conf -state readonly
5243 grid $top.id $top.sha1 -sticky w
5244 label $top.nlab -text "Name:"
5245 entry $top.name -width 40
5246 grid $top.nlab $top.name -sticky w
5247 frame $top.buts
5248 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5249 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5250 grid $top.buts.go $top.buts.can
5251 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5252 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5253 grid $top.buts - -pady 10 -sticky ew
5254 focus $top.name
5257 proc mkbrgo {top} {
5258 global headids idheads
5260 set name [$top.name get]
5261 set id [$top.sha1 get]
5262 if {$name eq {}} {
5263 error_popup "Please specify a name for the new branch"
5264 return
5266 catch {destroy $top}
5267 nowbusy newbranch
5268 update
5269 if {[catch {
5270 exec git branch $name $id
5271 } err]} {
5272 notbusy newbranch
5273 error_popup $err
5274 } else {
5275 addedhead $id $name
5276 # XXX should update list of heads displayed for selected commit
5277 notbusy newbranch
5278 redrawtags $id
5282 proc cherrypick {} {
5283 global rowmenuid curview commitrow
5284 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5286 if {[info exists desc_heads($rowmenuid)]
5287 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5288 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5289 included in branch $mainhead -- really re-apply it?"]
5290 if {!$ok} return
5292 nowbusy cherrypick
5293 update
5294 set oldhead [exec git rev-parse HEAD]
5295 # Unfortunately git-cherry-pick writes stuff to stderr even when
5296 # no error occurs, and exec takes that as an indication of error...
5297 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5298 notbusy cherrypick
5299 error_popup $err
5300 return
5302 set newhead [exec git rev-parse HEAD]
5303 if {$newhead eq $oldhead} {
5304 notbusy cherrypick
5305 error_popup "No changes committed"
5306 return
5308 set allparents($newhead) $oldhead
5309 lappend allchildren($oldhead) $newhead
5310 set desc_heads($newhead) $mainhead
5311 if {[info exists anc_tags($oldhead)]} {
5312 set anc_tags($newhead) $anc_tags($oldhead)
5314 set desc_tags($newhead) {}
5315 if {[info exists commitrow($curview,$oldhead)]} {
5316 insertrow $commitrow($curview,$oldhead) $newhead
5317 if {$mainhead ne {}} {
5318 movedhead $newhead $mainhead
5320 redrawtags $oldhead
5321 redrawtags $newhead
5323 notbusy cherrypick
5326 # context menu for a head
5327 proc headmenu {x y id head} {
5328 global headmenuid headmenuhead headctxmenu
5330 set headmenuid $id
5331 set headmenuhead $head
5332 tk_popup $headctxmenu $x $y
5335 proc cobranch {} {
5336 global headmenuid headmenuhead mainhead headids
5338 # check the tree is clean first??
5339 set oldmainhead $mainhead
5340 nowbusy checkout
5341 update
5342 if {[catch {
5343 exec git checkout $headmenuhead
5344 } err]} {
5345 notbusy checkout
5346 error_popup $err
5347 } else {
5348 notbusy checkout
5349 set mainhead $headmenuhead
5350 if {[info exists headids($oldmainhead)]} {
5351 redrawtags $headids($oldmainhead)
5353 redrawtags $headmenuid
5357 proc rmbranch {} {
5358 global desc_heads headmenuid headmenuhead mainhead
5359 global headids idheads
5361 set head $headmenuhead
5362 set id $headmenuid
5363 if {$head eq $mainhead} {
5364 error_popup "Cannot delete the currently checked-out branch"
5365 return
5367 if {$desc_heads($id) eq $head} {
5368 # the stuff on this branch isn't on any other branch
5369 if {![confirm_popup "The commits on branch $head aren't on any other\
5370 branch.\nReally delete branch $head?"]} return
5372 nowbusy rmbranch
5373 update
5374 if {[catch {exec git branch -D $head} err]} {
5375 notbusy rmbranch
5376 error_popup $err
5377 return
5379 removedhead $id $head
5380 redrawtags $id
5381 notbusy rmbranch
5384 # Stuff for finding nearby tags
5385 proc getallcommits {} {
5386 global allcstart allcommits allcfd allids
5388 set allids {}
5389 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5390 set allcfd $fd
5391 fconfigure $fd -blocking 0
5392 set allcommits "reading"
5393 nowbusy allcommits
5394 restartgetall $fd
5397 proc discardallcommits {} {
5398 global allparents allchildren allcommits allcfd
5399 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5401 if {![info exists allcommits]} return
5402 if {$allcommits eq "reading"} {
5403 catch {close $allcfd}
5405 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5406 alldtags tagisdesc desc_heads} {
5407 catch {unset $v}
5411 proc restartgetall {fd} {
5412 global allcstart
5414 fileevent $fd readable [list getallclines $fd]
5415 set allcstart [clock clicks -milliseconds]
5418 proc combine_dtags {l1 l2} {
5419 global tagisdesc notfirstd
5421 set res [lsort -unique [concat $l1 $l2]]
5422 for {set i 0} {$i < [llength $res]} {incr i} {
5423 set x [lindex $res $i]
5424 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5425 set y [lindex $res $j]
5426 if {[info exists tagisdesc($x,$y)]} {
5427 if {$tagisdesc($x,$y) > 0} {
5428 # x is a descendent of y, exclude x
5429 set res [lreplace $res $i $i]
5430 incr i -1
5431 break
5432 } else {
5433 # y is a descendent of x, exclude y
5434 set res [lreplace $res $j $j]
5436 } else {
5437 # no relation, keep going
5438 incr j
5442 return $res
5445 proc combine_atags {l1 l2} {
5446 global tagisdesc
5448 set res [lsort -unique [concat $l1 $l2]]
5449 for {set i 0} {$i < [llength $res]} {incr i} {
5450 set x [lindex $res $i]
5451 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5452 set y [lindex $res $j]
5453 if {[info exists tagisdesc($x,$y)]} {
5454 if {$tagisdesc($x,$y) < 0} {
5455 # x is an ancestor of y, exclude x
5456 set res [lreplace $res $i $i]
5457 incr i -1
5458 break
5459 } else {
5460 # y is an ancestor of x, exclude y
5461 set res [lreplace $res $j $j]
5463 } else {
5464 # no relation, keep going
5465 incr j
5469 return $res
5472 proc forward_pass {id children} {
5473 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5475 set dtags {}
5476 set dheads {}
5477 foreach child $children {
5478 if {[info exists idtags($child)]} {
5479 set ctags [list $child]
5480 } else {
5481 set ctags $desc_tags($child)
5483 if {$dtags eq {}} {
5484 set dtags $ctags
5485 } elseif {$ctags ne $dtags} {
5486 set dtags [combine_dtags $dtags $ctags]
5488 set cheads $desc_heads($child)
5489 if {$dheads eq {}} {
5490 set dheads $cheads
5491 } elseif {$cheads ne $dheads} {
5492 set dheads [lsort -unique [concat $dheads $cheads]]
5495 set desc_tags($id) $dtags
5496 if {[info exists idtags($id)]} {
5497 set adt $dtags
5498 foreach tag $dtags {
5499 set adt [concat $adt $alldtags($tag)]
5501 set adt [lsort -unique $adt]
5502 set alldtags($id) $adt
5503 foreach tag $adt {
5504 set tagisdesc($id,$tag) -1
5505 set tagisdesc($tag,$id) 1
5508 if {[info exists idheads($id)]} {
5509 set dheads [concat $dheads $idheads($id)]
5511 set desc_heads($id) $dheads
5514 proc getallclines {fd} {
5515 global allparents allchildren allcommits allcstart
5516 global desc_tags anc_tags idtags tagisdesc allids
5517 global idheads travindex
5519 while {[gets $fd line] >= 0} {
5520 set id [lindex $line 0]
5521 lappend allids $id
5522 set olds [lrange $line 1 end]
5523 set allparents($id) $olds
5524 if {![info exists allchildren($id)]} {
5525 set allchildren($id) {}
5527 foreach p $olds {
5528 lappend allchildren($p) $id
5530 # compute nearest tagged descendents as we go
5531 # also compute descendent heads
5532 forward_pass $id $allchildren($id)
5533 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5534 fileevent $fd readable {}
5535 after idle restartgetall $fd
5536 return
5539 if {[eof $fd]} {
5540 set travindex [llength $allids]
5541 set allcommits "traversing"
5542 after idle restartatags
5543 if {[catch {close $fd} err]} {
5544 error_popup "Error reading full commit graph: $err.\n\
5545 Results may be incomplete."
5550 # walk backward through the tree and compute nearest tagged ancestors
5551 proc restartatags {} {
5552 global allids allparents idtags anc_tags travindex
5554 set t0 [clock clicks -milliseconds]
5555 set i $travindex
5556 while {[incr i -1] >= 0} {
5557 set id [lindex $allids $i]
5558 set atags {}
5559 foreach p $allparents($id) {
5560 if {[info exists idtags($p)]} {
5561 set ptags [list $p]
5562 } else {
5563 set ptags $anc_tags($p)
5565 if {$atags eq {}} {
5566 set atags $ptags
5567 } elseif {$ptags ne $atags} {
5568 set atags [combine_atags $atags $ptags]
5571 set anc_tags($id) $atags
5572 if {[clock clicks -milliseconds] - $t0 >= 50} {
5573 set travindex $i
5574 after idle restartatags
5575 return
5578 set allcommits "done"
5579 set travindex 0
5580 notbusy allcommits
5581 dispneartags
5584 # update the desc_tags and anc_tags arrays for a new tag just added
5585 proc addedtag {id} {
5586 global desc_tags anc_tags allparents allchildren allcommits
5587 global idtags tagisdesc alldtags
5589 if {![info exists desc_tags($id)]} return
5590 set adt $desc_tags($id)
5591 foreach t $desc_tags($id) {
5592 set adt [concat $adt $alldtags($t)]
5594 set adt [lsort -unique $adt]
5595 set alldtags($id) $adt
5596 foreach t $adt {
5597 set tagisdesc($id,$t) -1
5598 set tagisdesc($t,$id) 1
5600 if {[info exists anc_tags($id)]} {
5601 set todo $anc_tags($id)
5602 while {$todo ne {}} {
5603 set do [lindex $todo 0]
5604 set todo [lrange $todo 1 end]
5605 if {[info exists tagisdesc($id,$do)]} continue
5606 set tagisdesc($do,$id) -1
5607 set tagisdesc($id,$do) 1
5608 if {[info exists anc_tags($do)]} {
5609 set todo [concat $todo $anc_tags($do)]
5614 set lastold $desc_tags($id)
5615 set lastnew [list $id]
5616 set nup 0
5617 set nch 0
5618 set todo $allparents($id)
5619 while {$todo ne {}} {
5620 set do [lindex $todo 0]
5621 set todo [lrange $todo 1 end]
5622 if {![info exists desc_tags($do)]} continue
5623 if {$desc_tags($do) ne $lastold} {
5624 set lastold $desc_tags($do)
5625 set lastnew [combine_dtags $lastold [list $id]]
5626 incr nch
5628 if {$lastold eq $lastnew} continue
5629 set desc_tags($do) $lastnew
5630 incr nup
5631 if {![info exists idtags($do)]} {
5632 set todo [concat $todo $allparents($do)]
5636 if {![info exists anc_tags($id)]} return
5637 set lastold $anc_tags($id)
5638 set lastnew [list $id]
5639 set nup 0
5640 set nch 0
5641 set todo $allchildren($id)
5642 while {$todo ne {}} {
5643 set do [lindex $todo 0]
5644 set todo [lrange $todo 1 end]
5645 if {![info exists anc_tags($do)]} continue
5646 if {$anc_tags($do) ne $lastold} {
5647 set lastold $anc_tags($do)
5648 set lastnew [combine_atags $lastold [list $id]]
5649 incr nch
5651 if {$lastold eq $lastnew} continue
5652 set anc_tags($do) $lastnew
5653 incr nup
5654 if {![info exists idtags($do)]} {
5655 set todo [concat $todo $allchildren($do)]
5660 # update the desc_heads array for a new head just added
5661 proc addedhead {hid head} {
5662 global desc_heads allparents headids idheads
5664 set headids($head) $hid
5665 lappend idheads($hid) $head
5667 set todo [list $hid]
5668 while {$todo ne {}} {
5669 set do [lindex $todo 0]
5670 set todo [lrange $todo 1 end]
5671 if {![info exists desc_heads($do)] ||
5672 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5673 set oldheads $desc_heads($do)
5674 lappend desc_heads($do) $head
5675 set heads $desc_heads($do)
5676 while {1} {
5677 set p $allparents($do)
5678 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5679 $desc_heads($p) ne $oldheads} break
5680 set do $p
5681 set desc_heads($do) $heads
5683 set todo [concat $todo $p]
5687 # update the desc_heads array for a head just removed
5688 proc removedhead {hid head} {
5689 global desc_heads allparents headids idheads
5691 unset headids($head)
5692 if {$idheads($hid) eq $head} {
5693 unset idheads($hid)
5694 } else {
5695 set i [lsearch -exact $idheads($hid) $head]
5696 if {$i >= 0} {
5697 set idheads($hid) [lreplace $idheads($hid) $i $i]
5701 set todo [list $hid]
5702 while {$todo ne {}} {
5703 set do [lindex $todo 0]
5704 set todo [lrange $todo 1 end]
5705 if {![info exists desc_heads($do)]} continue
5706 set i [lsearch -exact $desc_heads($do) $head]
5707 if {$i < 0} continue
5708 set oldheads $desc_heads($do)
5709 set heads [lreplace $desc_heads($do) $i $i]
5710 while {1} {
5711 set desc_heads($do) $heads
5712 set p $allparents($do)
5713 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5714 $desc_heads($p) ne $oldheads} break
5715 set do $p
5717 set todo [concat $todo $p]
5721 # update things for a head moved to a child of its previous location
5722 proc movedhead {id name} {
5723 global headids idheads
5725 set oldid $headids($name)
5726 set headids($name) $id
5727 if {$idheads($oldid) eq $name} {
5728 unset idheads($oldid)
5729 } else {
5730 set i [lsearch -exact $idheads($oldid) $name]
5731 if {$i >= 0} {
5732 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5735 lappend idheads($id) $name
5738 proc changedrefs {} {
5739 global desc_heads desc_tags anc_tags allcommits allids
5740 global allchildren allparents idtags travindex
5742 if {![info exists allcommits]} return
5743 catch {unset desc_heads}
5744 catch {unset desc_tags}
5745 catch {unset anc_tags}
5746 catch {unset alldtags}
5747 catch {unset tagisdesc}
5748 foreach id $allids {
5749 forward_pass $id $allchildren($id)
5751 if {$allcommits ne "reading"} {
5752 set travindex [llength $allids]
5753 if {$allcommits ne "traversing"} {
5754 set allcommits "traversing"
5755 after idle restartatags
5760 proc rereadrefs {} {
5761 global idtags idheads idotherrefs mainhead
5763 set refids [concat [array names idtags] \
5764 [array names idheads] [array names idotherrefs]]
5765 foreach id $refids {
5766 if {![info exists ref($id)]} {
5767 set ref($id) [listrefs $id]
5770 set oldmainhead $mainhead
5771 readrefs
5772 changedrefs
5773 set refids [lsort -unique [concat $refids [array names idtags] \
5774 [array names idheads] [array names idotherrefs]]]
5775 foreach id $refids {
5776 set v [listrefs $id]
5777 if {![info exists ref($id)] || $ref($id) != $v ||
5778 ($id eq $oldmainhead && $id ne $mainhead) ||
5779 ($id eq $mainhead && $id ne $oldmainhead)} {
5780 redrawtags $id
5785 proc listrefs {id} {
5786 global idtags idheads idotherrefs
5788 set x {}
5789 if {[info exists idtags($id)]} {
5790 set x $idtags($id)
5792 set y {}
5793 if {[info exists idheads($id)]} {
5794 set y $idheads($id)
5796 set z {}
5797 if {[info exists idotherrefs($id)]} {
5798 set z $idotherrefs($id)
5800 return [list $x $y $z]
5803 proc showtag {tag isnew} {
5804 global ctext tagcontents tagids linknum
5806 if {$isnew} {
5807 addtohistory [list showtag $tag 0]
5809 $ctext conf -state normal
5810 clear_ctext
5811 set linknum 0
5812 if {[info exists tagcontents($tag)]} {
5813 set text $tagcontents($tag)
5814 } else {
5815 set text "Tag: $tag\nId: $tagids($tag)"
5817 appendwithlinks $text {}
5818 $ctext conf -state disabled
5819 init_flist {}
5822 proc doquit {} {
5823 global stopped
5824 set stopped 100
5825 savestuff .
5826 destroy .
5829 proc doprefs {} {
5830 global maxwidth maxgraphpct diffopts
5831 global oldprefs prefstop showneartags
5832 global bgcolor fgcolor ctext diffcolors
5833 global uifont
5835 set top .gitkprefs
5836 set prefstop $top
5837 if {[winfo exists $top]} {
5838 raise $top
5839 return
5841 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5842 set oldprefs($v) [set $v]
5844 toplevel $top
5845 wm title $top "Gitk preferences"
5846 label $top.ldisp -text "Commit list display options"
5847 $top.ldisp configure -font $uifont
5848 grid $top.ldisp - -sticky w -pady 10
5849 label $top.spacer -text " "
5850 label $top.maxwidthl -text "Maximum graph width (lines)" \
5851 -font optionfont
5852 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5853 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5854 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5855 -font optionfont
5856 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5857 grid x $top.maxpctl $top.maxpct -sticky w
5859 label $top.ddisp -text "Diff display options"
5860 $top.ddisp configure -font $uifont
5861 grid $top.ddisp - -sticky w -pady 10
5862 label $top.diffoptl -text "Options for diff program" \
5863 -font optionfont
5864 entry $top.diffopt -width 20 -textvariable diffopts
5865 grid x $top.diffoptl $top.diffopt -sticky w
5866 frame $top.ntag
5867 label $top.ntag.l -text "Display nearby tags" -font optionfont
5868 checkbutton $top.ntag.b -variable showneartags
5869 pack $top.ntag.b $top.ntag.l -side left
5870 grid x $top.ntag -sticky w
5872 label $top.cdisp -text "Colors: press to choose"
5873 $top.cdisp configure -font $uifont
5874 grid $top.cdisp - -sticky w -pady 10
5875 label $top.bg -padx 40 -relief sunk -background $bgcolor
5876 button $top.bgbut -text "Background" -font optionfont \
5877 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5878 grid x $top.bgbut $top.bg -sticky w
5879 label $top.fg -padx 40 -relief sunk -background $fgcolor
5880 button $top.fgbut -text "Foreground" -font optionfont \
5881 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5882 grid x $top.fgbut $top.fg -sticky w
5883 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5884 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5885 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5886 [list $ctext tag conf d0 -foreground]]
5887 grid x $top.diffoldbut $top.diffold -sticky w
5888 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5889 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5890 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5891 [list $ctext tag conf d1 -foreground]]
5892 grid x $top.diffnewbut $top.diffnew -sticky w
5893 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5894 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5895 -command [list choosecolor diffcolors 2 $top.hunksep \
5896 "diff hunk header" \
5897 [list $ctext tag conf hunksep -foreground]]
5898 grid x $top.hunksepbut $top.hunksep -sticky w
5900 frame $top.buts
5901 button $top.buts.ok -text "OK" -command prefsok -default active
5902 $top.buts.ok configure -font $uifont
5903 button $top.buts.can -text "Cancel" -command prefscan -default normal
5904 $top.buts.can configure -font $uifont
5905 grid $top.buts.ok $top.buts.can
5906 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5907 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5908 grid $top.buts - - -pady 10 -sticky ew
5909 bind $top <Visibility> "focus $top.buts.ok"
5912 proc choosecolor {v vi w x cmd} {
5913 global $v
5915 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5916 -title "Gitk: choose color for $x"]
5917 if {$c eq {}} return
5918 $w conf -background $c
5919 lset $v $vi $c
5920 eval $cmd $c
5923 proc setbg {c} {
5924 global bglist
5926 foreach w $bglist {
5927 $w conf -background $c
5931 proc setfg {c} {
5932 global fglist canv
5934 foreach w $fglist {
5935 $w conf -foreground $c
5937 allcanvs itemconf text -fill $c
5938 $canv itemconf circle -outline $c
5941 proc prefscan {} {
5942 global maxwidth maxgraphpct diffopts
5943 global oldprefs prefstop showneartags
5945 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5946 set $v $oldprefs($v)
5948 catch {destroy $prefstop}
5949 unset prefstop
5952 proc prefsok {} {
5953 global maxwidth maxgraphpct
5954 global oldprefs prefstop showneartags
5956 catch {destroy $prefstop}
5957 unset prefstop
5958 if {$maxwidth != $oldprefs(maxwidth)
5959 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5960 redisplay
5961 } elseif {$showneartags != $oldprefs(showneartags)} {
5962 reselectline
5966 proc formatdate {d} {
5967 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5970 # This list of encoding names and aliases is distilled from
5971 # http://www.iana.org/assignments/character-sets.
5972 # Not all of them are supported by Tcl.
5973 set encoding_aliases {
5974 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5975 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5976 { ISO-10646-UTF-1 csISO10646UTF1 }
5977 { ISO_646.basic:1983 ref csISO646basic1983 }
5978 { INVARIANT csINVARIANT }
5979 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5980 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5981 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5982 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5983 { NATS-DANO iso-ir-9-1 csNATSDANO }
5984 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5985 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5986 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5987 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5988 { ISO-2022-KR csISO2022KR }
5989 { EUC-KR csEUCKR }
5990 { ISO-2022-JP csISO2022JP }
5991 { ISO-2022-JP-2 csISO2022JP2 }
5992 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5993 csISO13JISC6220jp }
5994 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5995 { IT iso-ir-15 ISO646-IT csISO15Italian }
5996 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5997 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5998 { greek7-old iso-ir-18 csISO18Greek7Old }
5999 { latin-greek iso-ir-19 csISO19LatinGreek }
6000 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6001 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6002 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6003 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6004 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6005 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6006 { INIS iso-ir-49 csISO49INIS }
6007 { INIS-8 iso-ir-50 csISO50INIS8 }
6008 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6009 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6010 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6011 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6012 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6013 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6014 csISO60Norwegian1 }
6015 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6016 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6017 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6018 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6019 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6020 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6021 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6022 { greek7 iso-ir-88 csISO88Greek7 }
6023 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6024 { iso-ir-90 csISO90 }
6025 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6026 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6027 csISO92JISC62991984b }
6028 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6029 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6030 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6031 csISO95JIS62291984handadd }
6032 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6033 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6034 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6035 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6036 CP819 csISOLatin1 }
6037 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6038 { T.61-7bit iso-ir-102 csISO102T617bit }
6039 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6040 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6041 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6042 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6043 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6044 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6045 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6046 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6047 arabic csISOLatinArabic }
6048 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6049 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6050 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6051 greek greek8 csISOLatinGreek }
6052 { T.101-G2 iso-ir-128 csISO128T101G2 }
6053 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6054 csISOLatinHebrew }
6055 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6056 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6057 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6058 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6059 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6060 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6061 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6062 csISOLatinCyrillic }
6063 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6064 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6065 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6066 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6067 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6068 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6069 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6070 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6071 { ISO_10367-box iso-ir-155 csISO10367Box }
6072 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6073 { latin-lap lap iso-ir-158 csISO158Lap }
6074 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6075 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6076 { us-dk csUSDK }
6077 { dk-us csDKUS }
6078 { JIS_X0201 X0201 csHalfWidthKatakana }
6079 { KSC5636 ISO646-KR csKSC5636 }
6080 { ISO-10646-UCS-2 csUnicode }
6081 { ISO-10646-UCS-4 csUCS4 }
6082 { DEC-MCS dec csDECMCS }
6083 { hp-roman8 roman8 r8 csHPRoman8 }
6084 { macintosh mac csMacintosh }
6085 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6086 csIBM037 }
6087 { IBM038 EBCDIC-INT cp038 csIBM038 }
6088 { IBM273 CP273 csIBM273 }
6089 { IBM274 EBCDIC-BE CP274 csIBM274 }
6090 { IBM275 EBCDIC-BR cp275 csIBM275 }
6091 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6092 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6093 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6094 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6095 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6096 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6097 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6098 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6099 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6100 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6101 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6102 { IBM437 cp437 437 csPC8CodePage437 }
6103 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6104 { IBM775 cp775 csPC775Baltic }
6105 { IBM850 cp850 850 csPC850Multilingual }
6106 { IBM851 cp851 851 csIBM851 }
6107 { IBM852 cp852 852 csPCp852 }
6108 { IBM855 cp855 855 csIBM855 }
6109 { IBM857 cp857 857 csIBM857 }
6110 { IBM860 cp860 860 csIBM860 }
6111 { IBM861 cp861 861 cp-is csIBM861 }
6112 { IBM862 cp862 862 csPC862LatinHebrew }
6113 { IBM863 cp863 863 csIBM863 }
6114 { IBM864 cp864 csIBM864 }
6115 { IBM865 cp865 865 csIBM865 }
6116 { IBM866 cp866 866 csIBM866 }
6117 { IBM868 CP868 cp-ar csIBM868 }
6118 { IBM869 cp869 869 cp-gr csIBM869 }
6119 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6120 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6121 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6122 { IBM891 cp891 csIBM891 }
6123 { IBM903 cp903 csIBM903 }
6124 { IBM904 cp904 904 csIBBM904 }
6125 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6126 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6127 { IBM1026 CP1026 csIBM1026 }
6128 { EBCDIC-AT-DE csIBMEBCDICATDE }
6129 { EBCDIC-AT-DE-A csEBCDICATDEA }
6130 { EBCDIC-CA-FR csEBCDICCAFR }
6131 { EBCDIC-DK-NO csEBCDICDKNO }
6132 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6133 { EBCDIC-FI-SE csEBCDICFISE }
6134 { EBCDIC-FI-SE-A csEBCDICFISEA }
6135 { EBCDIC-FR csEBCDICFR }
6136 { EBCDIC-IT csEBCDICIT }
6137 { EBCDIC-PT csEBCDICPT }
6138 { EBCDIC-ES csEBCDICES }
6139 { EBCDIC-ES-A csEBCDICESA }
6140 { EBCDIC-ES-S csEBCDICESS }
6141 { EBCDIC-UK csEBCDICUK }
6142 { EBCDIC-US csEBCDICUS }
6143 { UNKNOWN-8BIT csUnknown8BiT }
6144 { MNEMONIC csMnemonic }
6145 { MNEM csMnem }
6146 { VISCII csVISCII }
6147 { VIQR csVIQR }
6148 { KOI8-R csKOI8R }
6149 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6150 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6151 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6152 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6153 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6154 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6155 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6156 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6157 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6158 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6159 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6160 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6161 { IBM1047 IBM-1047 }
6162 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6163 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6164 { UNICODE-1-1 csUnicode11 }
6165 { CESU-8 csCESU-8 }
6166 { BOCU-1 csBOCU-1 }
6167 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6168 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6169 l8 }
6170 { ISO-8859-15 ISO_8859-15 Latin-9 }
6171 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6172 { GBK CP936 MS936 windows-936 }
6173 { JIS_Encoding csJISEncoding }
6174 { Shift_JIS MS_Kanji csShiftJIS }
6175 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6176 EUC-JP }
6177 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6178 { ISO-10646-UCS-Basic csUnicodeASCII }
6179 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6180 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6181 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6182 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6183 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6184 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6185 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6186 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6187 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6188 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6189 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6190 { Ventura-US csVenturaUS }
6191 { Ventura-International csVenturaInternational }
6192 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6193 { PC8-Turkish csPC8Turkish }
6194 { IBM-Symbols csIBMSymbols }
6195 { IBM-Thai csIBMThai }
6196 { HP-Legal csHPLegal }
6197 { HP-Pi-font csHPPiFont }
6198 { HP-Math8 csHPMath8 }
6199 { Adobe-Symbol-Encoding csHPPSMath }
6200 { HP-DeskTop csHPDesktop }
6201 { Ventura-Math csVenturaMath }
6202 { Microsoft-Publishing csMicrosoftPublishing }
6203 { Windows-31J csWindows31J }
6204 { GB2312 csGB2312 }
6205 { Big5 csBig5 }
6208 proc tcl_encoding {enc} {
6209 global encoding_aliases
6210 set names [encoding names]
6211 set lcnames [string tolower $names]
6212 set enc [string tolower $enc]
6213 set i [lsearch -exact $lcnames $enc]
6214 if {$i < 0} {
6215 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6216 if {[regsub {^iso[-_]} $enc iso encx]} {
6217 set i [lsearch -exact $lcnames $encx]
6220 if {$i < 0} {
6221 foreach l $encoding_aliases {
6222 set ll [string tolower $l]
6223 if {[lsearch -exact $ll $enc] < 0} continue
6224 # look through the aliases for one that tcl knows about
6225 foreach e $ll {
6226 set i [lsearch -exact $lcnames $e]
6227 if {$i < 0} {
6228 if {[regsub {^iso[-_]} $e iso ex]} {
6229 set i [lsearch -exact $lcnames $ex]
6232 if {$i >= 0} break
6234 break
6237 if {$i >= 0} {
6238 return [lindex $names $i]
6240 return {}
6243 # defaults...
6244 set datemode 0
6245 set diffopts "-U 5 -p"
6246 set wrcomcmd "git diff-tree --stdin -p --pretty"
6248 set gitencoding {}
6249 catch {
6250 set gitencoding [exec git config --get i18n.commitencoding]
6252 if {$gitencoding == ""} {
6253 set gitencoding "utf-8"
6255 set tclencoding [tcl_encoding $gitencoding]
6256 if {$tclencoding == {}} {
6257 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6260 set mainfont {Helvetica 9}
6261 set textfont {Courier 9}
6262 set uifont {Helvetica 9 bold}
6263 set findmergefiles 0
6264 set maxgraphpct 50
6265 set maxwidth 16
6266 set revlistorder 0
6267 set fastdate 0
6268 set uparrowlen 7
6269 set downarrowlen 7
6270 set mingaplen 30
6271 set cmitmode "patch"
6272 set wrapcomment "none"
6273 set showneartags 1
6275 set colors {green red blue magenta darkgrey brown orange}
6276 set bgcolor white
6277 set fgcolor black
6278 set diffcolors {red "#00a000" blue}
6280 catch {source ~/.gitk}
6282 font create optionfont -family sans-serif -size -12
6284 set revtreeargs {}
6285 foreach arg $argv {
6286 switch -regexp -- $arg {
6287 "^$" { }
6288 "^-d" { set datemode 1 }
6289 default {
6290 lappend revtreeargs $arg
6295 # check that we can find a .git directory somewhere...
6296 set gitdir [gitdir]
6297 if {![file isdirectory $gitdir]} {
6298 show_error {} . "Cannot find the git directory \"$gitdir\"."
6299 exit 1
6302 set cmdline_files {}
6303 set i [lsearch -exact $revtreeargs "--"]
6304 if {$i >= 0} {
6305 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6306 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6307 } elseif {$revtreeargs ne {}} {
6308 if {[catch {
6309 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6310 set cmdline_files [split $f "\n"]
6311 set n [llength $cmdline_files]
6312 set revtreeargs [lrange $revtreeargs 0 end-$n]
6313 } err]} {
6314 # unfortunately we get both stdout and stderr in $err,
6315 # so look for "fatal:".
6316 set i [string first "fatal:" $err]
6317 if {$i > 0} {
6318 set err [string range $err [expr {$i + 6}] end]
6320 show_error {} . "Bad arguments to gitk:\n$err"
6321 exit 1
6325 set history {}
6326 set historyindex 0
6327 set fh_serial 0
6328 set nhl_names {}
6329 set highlight_paths {}
6330 set searchdirn -forwards
6331 set boldrows {}
6332 set boldnamerows {}
6334 set optim_delay 16
6336 set nextviewnum 1
6337 set curview 0
6338 set selectedview 0
6339 set selectedhlview None
6340 set viewfiles(0) {}
6341 set viewperm(0) 0
6342 set viewargs(0) {}
6344 set cmdlineok 0
6345 set stopped 0
6346 set stuffsaved 0
6347 set patchnum 0
6348 setcoords
6349 makewindow
6350 wm title . "[file tail $argv0]: [file tail [pwd]]"
6351 readrefs
6353 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6354 # create a view for the files/dirs specified on the command line
6355 set curview 1
6356 set selectedview 1
6357 set nextviewnum 2
6358 set viewname(1) "Command line"
6359 set viewfiles(1) $cmdline_files
6360 set viewargs(1) $revtreeargs
6361 set viewperm(1) 0
6362 addviewmenu 1
6363 .bar.view entryconf Edit* -state normal
6364 .bar.view entryconf Delete* -state normal
6367 if {[info exists permviews]} {
6368 foreach v $permviews {
6369 set n $nextviewnum
6370 incr nextviewnum
6371 set viewname($n) [lindex $v 0]
6372 set viewfiles($n) [lindex $v 1]
6373 set viewargs($n) [lindex $v 2]
6374 set viewperm($n) 1
6375 addviewmenu $n
6378 getcommits