[PATCH] gitk: Update fontsize in patch / tree list
[git/mingw.git] / gitk
blob8e41d56897f2e20611fce6eada9f8165809c869b
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 selectbgcolor
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 -selectbackground $selectbgcolor \
461 -background $bgcolor -bd 0 \
462 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
463 .tf.histframe.pwclist add $canv
464 set canv2 .tf.histframe.pwclist.canv2
465 canvas $canv2 \
466 -selectbackground $selectbgcolor \
467 -background $bgcolor -bd 0 -yscrollincr $linespc
468 .tf.histframe.pwclist add $canv2
469 set canv3 .tf.histframe.pwclist.canv3
470 canvas $canv3 \
471 -selectbackground $selectbgcolor \
472 -background $bgcolor -bd 0 -yscrollincr $linespc
473 .tf.histframe.pwclist add $canv3
474 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
475 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
477 # a scroll bar to rule them
478 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
479 pack $cscroll -side right -fill y
480 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
481 lappend bglist $canv $canv2 $canv3
482 pack .tf.histframe.pwclist -fill both -expand 1 -side left
484 # we have two button bars at bottom of top frame. Bar 1
485 frame .tf.bar
486 frame .tf.lbar -height 15
488 set sha1entry .tf.bar.sha1
489 set entries $sha1entry
490 set sha1but .tf.bar.sha1label
491 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
492 -command gotocommit -width 8 -font $uifont
493 $sha1but conf -disabledforeground [$sha1but cget -foreground]
494 pack .tf.bar.sha1label -side left
495 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
496 trace add variable sha1string write sha1change
497 pack $sha1entry -side left -pady 2
499 image create bitmap bm-left -data {
500 #define left_width 16
501 #define left_height 16
502 static unsigned char left_bits[] = {
503 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
504 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
505 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
507 image create bitmap bm-right -data {
508 #define right_width 16
509 #define right_height 16
510 static unsigned char right_bits[] = {
511 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
512 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
513 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
515 button .tf.bar.leftbut -image bm-left -command goback \
516 -state disabled -width 26
517 pack .tf.bar.leftbut -side left -fill y
518 button .tf.bar.rightbut -image bm-right -command goforw \
519 -state disabled -width 26
520 pack .tf.bar.rightbut -side left -fill y
522 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
523 pack .tf.bar.findbut -side left
524 set findstring {}
525 set fstring .tf.bar.findstring
526 lappend entries $fstring
527 entry $fstring -width 30 -font $textfont -textvariable findstring
528 trace add variable findstring write find_change
529 pack $fstring -side left -expand 1 -fill x -in .tf.bar
530 set findtype Exact
531 set findtypemenu [tk_optionMenu .tf.bar.findtype \
532 findtype Exact IgnCase Regexp]
533 trace add variable findtype write find_change
534 .tf.bar.findtype configure -font $uifont
535 .tf.bar.findtype.menu configure -font $uifont
536 set findloc "All fields"
537 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
538 Comments Author Committer
539 trace add variable findloc write find_change
540 .tf.bar.findloc configure -font $uifont
541 .tf.bar.findloc.menu configure -font $uifont
542 pack .tf.bar.findloc -side right
543 pack .tf.bar.findtype -side right
545 # build up the bottom bar of upper window
546 label .tf.lbar.flabel -text "Highlight: Commits " \
547 -font $uifont
548 pack .tf.lbar.flabel -side left -fill y
549 set gdttype "touching paths:"
550 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
551 "adding/removing string:"]
552 trace add variable gdttype write hfiles_change
553 $gm conf -font $uifont
554 .tf.lbar.gdttype conf -font $uifont
555 pack .tf.lbar.gdttype -side left -fill y
556 entry .tf.lbar.fent -width 25 -font $textfont \
557 -textvariable highlight_files
558 trace add variable highlight_files write hfiles_change
559 lappend entries .tf.lbar.fent
560 pack .tf.lbar.fent -side left -fill x -expand 1
561 label .tf.lbar.vlabel -text " OR in view" -font $uifont
562 pack .tf.lbar.vlabel -side left -fill y
563 global viewhlmenu selectedhlview
564 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
565 $viewhlmenu entryconf None -command delvhighlight
566 $viewhlmenu conf -font $uifont
567 .tf.lbar.vhl conf -font $uifont
568 pack .tf.lbar.vhl -side left -fill y
569 label .tf.lbar.rlabel -text " OR " -font $uifont
570 pack .tf.lbar.rlabel -side left -fill y
571 global highlight_related
572 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
573 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
574 $m conf -font $uifont
575 .tf.lbar.relm conf -font $uifont
576 trace add variable highlight_related write vrel_change
577 pack .tf.lbar.relm -side left -fill y
579 # Finish putting the upper half of the viewer together
580 pack .tf.lbar -in .tf -side bottom -fill x
581 pack .tf.bar -in .tf -side bottom -fill x
582 pack .tf.histframe -fill both -side top -expand 1
583 .ctop add .tf
584 .ctop paneconfigure .tf -height $geometry(topheight)
585 .ctop paneconfigure .tf -width $geometry(topwidth)
587 # now build up the bottom
588 panedwindow .pwbottom -orient horizontal
590 # lower left, a text box over search bar, scroll bar to the right
591 # if we know window height, then that will set the lower text height, otherwise
592 # we set lower text height which will drive window height
593 if {[info exists geometry(main)]} {
594 frame .bleft -width $geometry(botwidth)
595 } else {
596 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
598 frame .bleft.top
599 frame .bleft.mid
601 button .bleft.top.search -text "Search" -command dosearch \
602 -font $uifont
603 pack .bleft.top.search -side left -padx 5
604 set sstring .bleft.top.sstring
605 entry $sstring -width 20 -font $textfont -textvariable searchstring
606 lappend entries $sstring
607 trace add variable searchstring write incrsearch
608 pack $sstring -side left -expand 1 -fill x
609 radiobutton .bleft.mid.diff -text "Diff" \
610 -command changediffdisp -variable diffelide -value {0 0}
611 radiobutton .bleft.mid.old -text "Old version" \
612 -command changediffdisp -variable diffelide -value {0 1}
613 radiobutton .bleft.mid.new -text "New version" \
614 -command changediffdisp -variable diffelide -value {1 0}
615 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
616 set ctext .bleft.ctext
617 text $ctext -background $bgcolor -foreground $fgcolor \
618 -state disabled -font $textfont \
619 -yscrollcommand scrolltext -wrap none
620 scrollbar .bleft.sb -command "$ctext yview"
621 pack .bleft.top -side top -fill x
622 pack .bleft.mid -side top -fill x
623 pack .bleft.sb -side right -fill y
624 pack $ctext -side left -fill both -expand 1
625 lappend bglist $ctext
626 lappend fglist $ctext
628 $ctext tag conf comment -wrap $wrapcomment
629 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
630 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
631 $ctext tag conf d0 -fore [lindex $diffcolors 0]
632 $ctext tag conf d1 -fore [lindex $diffcolors 1]
633 $ctext tag conf m0 -fore red
634 $ctext tag conf m1 -fore blue
635 $ctext tag conf m2 -fore green
636 $ctext tag conf m3 -fore purple
637 $ctext tag conf m4 -fore brown
638 $ctext tag conf m5 -fore "#009090"
639 $ctext tag conf m6 -fore magenta
640 $ctext tag conf m7 -fore "#808000"
641 $ctext tag conf m8 -fore "#009000"
642 $ctext tag conf m9 -fore "#ff0080"
643 $ctext tag conf m10 -fore cyan
644 $ctext tag conf m11 -fore "#b07070"
645 $ctext tag conf m12 -fore "#70b0f0"
646 $ctext tag conf m13 -fore "#70f0b0"
647 $ctext tag conf m14 -fore "#f0b070"
648 $ctext tag conf m15 -fore "#ff70b0"
649 $ctext tag conf mmax -fore darkgrey
650 set mergemax 16
651 $ctext tag conf mresult -font [concat $textfont bold]
652 $ctext tag conf msep -font [concat $textfont bold]
653 $ctext tag conf found -back yellow
655 .pwbottom add .bleft
656 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
658 # lower right
659 frame .bright
660 frame .bright.mode
661 radiobutton .bright.mode.patch -text "Patch" \
662 -command reselectline -variable cmitmode -value "patch"
663 .bright.mode.patch configure -font $uifont
664 radiobutton .bright.mode.tree -text "Tree" \
665 -command reselectline -variable cmitmode -value "tree"
666 .bright.mode.tree configure -font $uifont
667 grid .bright.mode.patch .bright.mode.tree -sticky ew
668 pack .bright.mode -side top -fill x
669 set cflist .bright.cfiles
670 set indent [font measure $mainfont "nn"]
671 text $cflist \
672 -selectbackground $selectbgcolor \
673 -background $bgcolor -foreground $fgcolor \
674 -font $mainfont \
675 -tabs [list $indent [expr {2 * $indent}]] \
676 -yscrollcommand ".bright.sb set" \
677 -cursor [. cget -cursor] \
678 -spacing1 1 -spacing3 1
679 lappend bglist $cflist
680 lappend fglist $cflist
681 scrollbar .bright.sb -command "$cflist yview"
682 pack .bright.sb -side right -fill y
683 pack $cflist -side left -fill both -expand 1
684 $cflist tag configure highlight \
685 -background [$cflist cget -selectbackground]
686 $cflist tag configure bold -font [concat $mainfont bold]
688 .pwbottom add .bright
689 .ctop add .pwbottom
691 # restore window position if known
692 if {[info exists geometry(main)]} {
693 wm geometry . "$geometry(main)"
696 bind .pwbottom <Configure> {resizecdetpanes %W %w}
697 pack .ctop -fill both -expand 1
698 bindall <1> {selcanvline %W %x %y}
699 #bindall <B1-Motion> {selcanvline %W %x %y}
700 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
701 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
702 bindall <2> "canvscan mark %W %x %y"
703 bindall <B2-Motion> "canvscan dragto %W %x %y"
704 bindkey <Home> selfirstline
705 bindkey <End> sellastline
706 bind . <Key-Up> "selnextline -1"
707 bind . <Key-Down> "selnextline 1"
708 bind . <Shift-Key-Up> "next_highlight -1"
709 bind . <Shift-Key-Down> "next_highlight 1"
710 bindkey <Key-Right> "goforw"
711 bindkey <Key-Left> "goback"
712 bind . <Key-Prior> "selnextpage -1"
713 bind . <Key-Next> "selnextpage 1"
714 bind . <Control-Home> "allcanvs yview moveto 0.0"
715 bind . <Control-End> "allcanvs yview moveto 1.0"
716 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
717 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
718 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
719 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
720 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
721 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
722 bindkey <Key-space> "$ctext yview scroll 1 pages"
723 bindkey p "selnextline -1"
724 bindkey n "selnextline 1"
725 bindkey z "goback"
726 bindkey x "goforw"
727 bindkey i "selnextline -1"
728 bindkey k "selnextline 1"
729 bindkey j "goback"
730 bindkey l "goforw"
731 bindkey b "$ctext yview scroll -1 pages"
732 bindkey d "$ctext yview scroll 18 units"
733 bindkey u "$ctext yview scroll -18 units"
734 bindkey / {findnext 1}
735 bindkey <Key-Return> {findnext 0}
736 bindkey ? findprev
737 bindkey f nextfile
738 bindkey <F5> updatecommits
739 bind . <Control-q> doquit
740 bind . <Control-f> dofind
741 bind . <Control-g> {findnext 0}
742 bind . <Control-r> dosearchback
743 bind . <Control-s> dosearch
744 bind . <Control-equal> {incrfont 1}
745 bind . <Control-KP_Add> {incrfont 1}
746 bind . <Control-minus> {incrfont -1}
747 bind . <Control-KP_Subtract> {incrfont -1}
748 wm protocol . WM_DELETE_WINDOW doquit
749 bind . <Button-1> "click %W"
750 bind $fstring <Key-Return> dofind
751 bind $sha1entry <Key-Return> gotocommit
752 bind $sha1entry <<PasteSelection>> clearsha1
753 bind $cflist <1> {sel_flist %W %x %y; break}
754 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
755 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
757 set maincursor [. cget -cursor]
758 set textcursor [$ctext cget -cursor]
759 set curtextcursor $textcursor
761 set rowctxmenu .rowctxmenu
762 menu $rowctxmenu -tearoff 0
763 $rowctxmenu add command -label "Diff this -> selected" \
764 -command {diffvssel 0}
765 $rowctxmenu add command -label "Diff selected -> this" \
766 -command {diffvssel 1}
767 $rowctxmenu add command -label "Make patch" -command mkpatch
768 $rowctxmenu add command -label "Create tag" -command mktag
769 $rowctxmenu add command -label "Write commit to file" -command writecommit
770 $rowctxmenu add command -label "Create new branch" -command mkbranch
771 $rowctxmenu add command -label "Cherry-pick this commit" \
772 -command cherrypick
774 set headctxmenu .headctxmenu
775 menu $headctxmenu -tearoff 0
776 $headctxmenu add command -label "Check out this branch" \
777 -command cobranch
778 $headctxmenu add command -label "Remove this branch" \
779 -command rmbranch
782 # mouse-2 makes all windows scan vertically, but only the one
783 # the cursor is in scans horizontally
784 proc canvscan {op w x y} {
785 global canv canv2 canv3
786 foreach c [list $canv $canv2 $canv3] {
787 if {$c == $w} {
788 $c scan $op $x $y
789 } else {
790 $c scan $op 0 $y
795 proc scrollcanv {cscroll f0 f1} {
796 $cscroll set $f0 $f1
797 drawfrac $f0 $f1
798 flushhighlights
801 # when we make a key binding for the toplevel, make sure
802 # it doesn't get triggered when that key is pressed in the
803 # find string entry widget.
804 proc bindkey {ev script} {
805 global entries
806 bind . $ev $script
807 set escript [bind Entry $ev]
808 if {$escript == {}} {
809 set escript [bind Entry <Key>]
811 foreach e $entries {
812 bind $e $ev "$escript; break"
816 # set the focus back to the toplevel for any click outside
817 # the entry widgets
818 proc click {w} {
819 global entries
820 foreach e $entries {
821 if {$w == $e} return
823 focus .
826 proc savestuff {w} {
827 global canv canv2 canv3 ctext cflist mainfont textfont uifont
828 global stuffsaved findmergefiles maxgraphpct
829 global maxwidth showneartags
830 global viewname viewfiles viewargs viewperm nextviewnum
831 global cmitmode wrapcomment
832 global colors bgcolor fgcolor diffcolors selectbgcolor
834 if {$stuffsaved} return
835 if {![winfo viewable .]} return
836 catch {
837 set f [open "~/.gitk-new" w]
838 puts $f [list set mainfont $mainfont]
839 puts $f [list set textfont $textfont]
840 puts $f [list set uifont $uifont]
841 puts $f [list set findmergefiles $findmergefiles]
842 puts $f [list set maxgraphpct $maxgraphpct]
843 puts $f [list set maxwidth $maxwidth]
844 puts $f [list set cmitmode $cmitmode]
845 puts $f [list set wrapcomment $wrapcomment]
846 puts $f [list set showneartags $showneartags]
847 puts $f [list set bgcolor $bgcolor]
848 puts $f [list set fgcolor $fgcolor]
849 puts $f [list set colors $colors]
850 puts $f [list set diffcolors $diffcolors]
851 puts $f [list set selectbgcolor $selectbgcolor]
853 puts $f "set geometry(main) [wm geometry .]"
854 puts $f "set geometry(topwidth) [winfo width .tf]"
855 puts $f "set geometry(topheight) [winfo height .tf]"
856 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
857 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
858 puts $f "set geometry(botwidth) [winfo width .bleft]"
859 puts $f "set geometry(botheight) [winfo height .bleft]"
861 puts -nonewline $f "set permviews {"
862 for {set v 0} {$v < $nextviewnum} {incr v} {
863 if {$viewperm($v)} {
864 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
867 puts $f "}"
868 close $f
869 file rename -force "~/.gitk-new" "~/.gitk"
871 set stuffsaved 1
874 proc resizeclistpanes {win w} {
875 global oldwidth
876 if {[info exists oldwidth($win)]} {
877 set s0 [$win sash coord 0]
878 set s1 [$win sash coord 1]
879 if {$w < 60} {
880 set sash0 [expr {int($w/2 - 2)}]
881 set sash1 [expr {int($w*5/6 - 2)}]
882 } else {
883 set factor [expr {1.0 * $w / $oldwidth($win)}]
884 set sash0 [expr {int($factor * [lindex $s0 0])}]
885 set sash1 [expr {int($factor * [lindex $s1 0])}]
886 if {$sash0 < 30} {
887 set sash0 30
889 if {$sash1 < $sash0 + 20} {
890 set sash1 [expr {$sash0 + 20}]
892 if {$sash1 > $w - 10} {
893 set sash1 [expr {$w - 10}]
894 if {$sash0 > $sash1 - 20} {
895 set sash0 [expr {$sash1 - 20}]
899 $win sash place 0 $sash0 [lindex $s0 1]
900 $win sash place 1 $sash1 [lindex $s1 1]
902 set oldwidth($win) $w
905 proc resizecdetpanes {win w} {
906 global oldwidth
907 if {[info exists oldwidth($win)]} {
908 set s0 [$win sash coord 0]
909 if {$w < 60} {
910 set sash0 [expr {int($w*3/4 - 2)}]
911 } else {
912 set factor [expr {1.0 * $w / $oldwidth($win)}]
913 set sash0 [expr {int($factor * [lindex $s0 0])}]
914 if {$sash0 < 45} {
915 set sash0 45
917 if {$sash0 > $w - 15} {
918 set sash0 [expr {$w - 15}]
921 $win sash place 0 $sash0 [lindex $s0 1]
923 set oldwidth($win) $w
926 proc allcanvs args {
927 global canv canv2 canv3
928 eval $canv $args
929 eval $canv2 $args
930 eval $canv3 $args
933 proc bindall {event action} {
934 global canv canv2 canv3
935 bind $canv $event $action
936 bind $canv2 $event $action
937 bind $canv3 $event $action
940 proc about {} {
941 global uifont
942 set w .about
943 if {[winfo exists $w]} {
944 raise $w
945 return
947 toplevel $w
948 wm title $w "About gitk"
949 message $w.m -text {
950 Gitk - a commit viewer for git
952 Copyright © 2005-2006 Paul Mackerras
954 Use and redistribute under the terms of the GNU General Public License} \
955 -justify center -aspect 400 -border 2 -bg white -relief groove
956 pack $w.m -side top -fill x -padx 2 -pady 2
957 $w.m configure -font $uifont
958 button $w.ok -text Close -command "destroy $w" -default active
959 pack $w.ok -side bottom
960 $w.ok configure -font $uifont
961 bind $w <Visibility> "focus $w.ok"
962 bind $w <Key-Escape> "destroy $w"
963 bind $w <Key-Return> "destroy $w"
966 proc keys {} {
967 global uifont
968 set w .keys
969 if {[winfo exists $w]} {
970 raise $w
971 return
973 toplevel $w
974 wm title $w "Gitk key bindings"
975 message $w.m -text {
976 Gitk key bindings:
978 <Ctrl-Q> Quit
979 <Home> Move to first commit
980 <End> Move to last commit
981 <Up>, p, i Move up one commit
982 <Down>, n, k Move down one commit
983 <Left>, z, j Go back in history list
984 <Right>, x, l Go forward in history list
985 <PageUp> Move up one page in commit list
986 <PageDown> Move down one page in commit list
987 <Ctrl-Home> Scroll to top of commit list
988 <Ctrl-End> Scroll to bottom of commit list
989 <Ctrl-Up> Scroll commit list up one line
990 <Ctrl-Down> Scroll commit list down one line
991 <Ctrl-PageUp> Scroll commit list up one page
992 <Ctrl-PageDown> Scroll commit list down one page
993 <Shift-Up> Move to previous highlighted line
994 <Shift-Down> Move to next highlighted line
995 <Delete>, b Scroll diff view up one page
996 <Backspace> Scroll diff view up one page
997 <Space> Scroll diff view down one page
998 u Scroll diff view up 18 lines
999 d Scroll diff view down 18 lines
1000 <Ctrl-F> Find
1001 <Ctrl-G> Move to next find hit
1002 <Return> Move to next find hit
1003 / Move to next find hit, or redo find
1004 ? Move to previous find hit
1005 f Scroll diff view to next file
1006 <Ctrl-S> Search for next hit in diff view
1007 <Ctrl-R> Search for previous hit in diff view
1008 <Ctrl-KP+> Increase font size
1009 <Ctrl-plus> Increase font size
1010 <Ctrl-KP-> Decrease font size
1011 <Ctrl-minus> Decrease font size
1012 <F5> Update
1014 -justify left -bg white -border 2 -relief groove
1015 pack $w.m -side top -fill both -padx 2 -pady 2
1016 $w.m configure -font $uifont
1017 button $w.ok -text Close -command "destroy $w" -default active
1018 pack $w.ok -side bottom
1019 $w.ok configure -font $uifont
1020 bind $w <Visibility> "focus $w.ok"
1021 bind $w <Key-Escape> "destroy $w"
1022 bind $w <Key-Return> "destroy $w"
1025 # Procedures for manipulating the file list window at the
1026 # bottom right of the overall window.
1028 proc treeview {w l openlevs} {
1029 global treecontents treediropen treeheight treeparent treeindex
1031 set ix 0
1032 set treeindex() 0
1033 set lev 0
1034 set prefix {}
1035 set prefixend -1
1036 set prefendstack {}
1037 set htstack {}
1038 set ht 0
1039 set treecontents() {}
1040 $w conf -state normal
1041 foreach f $l {
1042 while {[string range $f 0 $prefixend] ne $prefix} {
1043 if {$lev <= $openlevs} {
1044 $w mark set e:$treeindex($prefix) "end -1c"
1045 $w mark gravity e:$treeindex($prefix) left
1047 set treeheight($prefix) $ht
1048 incr ht [lindex $htstack end]
1049 set htstack [lreplace $htstack end end]
1050 set prefixend [lindex $prefendstack end]
1051 set prefendstack [lreplace $prefendstack end end]
1052 set prefix [string range $prefix 0 $prefixend]
1053 incr lev -1
1055 set tail [string range $f [expr {$prefixend+1}] end]
1056 while {[set slash [string first "/" $tail]] >= 0} {
1057 lappend htstack $ht
1058 set ht 0
1059 lappend prefendstack $prefixend
1060 incr prefixend [expr {$slash + 1}]
1061 set d [string range $tail 0 $slash]
1062 lappend treecontents($prefix) $d
1063 set oldprefix $prefix
1064 append prefix $d
1065 set treecontents($prefix) {}
1066 set treeindex($prefix) [incr ix]
1067 set treeparent($prefix) $oldprefix
1068 set tail [string range $tail [expr {$slash+1}] end]
1069 if {$lev <= $openlevs} {
1070 set ht 1
1071 set treediropen($prefix) [expr {$lev < $openlevs}]
1072 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1073 $w mark set d:$ix "end -1c"
1074 $w mark gravity d:$ix left
1075 set str "\n"
1076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1077 $w insert end $str
1078 $w image create end -align center -image $bm -padx 1 \
1079 -name a:$ix
1080 $w insert end $d [highlight_tag $prefix]
1081 $w mark set s:$ix "end -1c"
1082 $w mark gravity s:$ix left
1084 incr lev
1086 if {$tail ne {}} {
1087 if {$lev <= $openlevs} {
1088 incr ht
1089 set str "\n"
1090 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1091 $w insert end $str
1092 $w insert end $tail [highlight_tag $f]
1094 lappend treecontents($prefix) $tail
1097 while {$htstack ne {}} {
1098 set treeheight($prefix) $ht
1099 incr ht [lindex $htstack end]
1100 set htstack [lreplace $htstack end end]
1102 $w conf -state disabled
1105 proc linetoelt {l} {
1106 global treeheight treecontents
1108 set y 2
1109 set prefix {}
1110 while {1} {
1111 foreach e $treecontents($prefix) {
1112 if {$y == $l} {
1113 return "$prefix$e"
1115 set n 1
1116 if {[string index $e end] eq "/"} {
1117 set n $treeheight($prefix$e)
1118 if {$y + $n > $l} {
1119 append prefix $e
1120 incr y
1121 break
1124 incr y $n
1129 proc highlight_tree {y prefix} {
1130 global treeheight treecontents cflist
1132 foreach e $treecontents($prefix) {
1133 set path $prefix$e
1134 if {[highlight_tag $path] ne {}} {
1135 $cflist tag add bold $y.0 "$y.0 lineend"
1137 incr y
1138 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1139 set y [highlight_tree $y $path]
1142 return $y
1145 proc treeclosedir {w dir} {
1146 global treediropen treeheight treeparent treeindex
1148 set ix $treeindex($dir)
1149 $w conf -state normal
1150 $w delete s:$ix e:$ix
1151 set treediropen($dir) 0
1152 $w image configure a:$ix -image tri-rt
1153 $w conf -state disabled
1154 set n [expr {1 - $treeheight($dir)}]
1155 while {$dir ne {}} {
1156 incr treeheight($dir) $n
1157 set dir $treeparent($dir)
1161 proc treeopendir {w dir} {
1162 global treediropen treeheight treeparent treecontents treeindex
1164 set ix $treeindex($dir)
1165 $w conf -state normal
1166 $w image configure a:$ix -image tri-dn
1167 $w mark set e:$ix s:$ix
1168 $w mark gravity e:$ix right
1169 set lev 0
1170 set str "\n"
1171 set n [llength $treecontents($dir)]
1172 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1173 incr lev
1174 append str "\t"
1175 incr treeheight($x) $n
1177 foreach e $treecontents($dir) {
1178 set de $dir$e
1179 if {[string index $e end] eq "/"} {
1180 set iy $treeindex($de)
1181 $w mark set d:$iy e:$ix
1182 $w mark gravity d:$iy left
1183 $w insert e:$ix $str
1184 set treediropen($de) 0
1185 $w image create e:$ix -align center -image tri-rt -padx 1 \
1186 -name a:$iy
1187 $w insert e:$ix $e [highlight_tag $de]
1188 $w mark set s:$iy e:$ix
1189 $w mark gravity s:$iy left
1190 set treeheight($de) 1
1191 } else {
1192 $w insert e:$ix $str
1193 $w insert e:$ix $e [highlight_tag $de]
1196 $w mark gravity e:$ix left
1197 $w conf -state disabled
1198 set treediropen($dir) 1
1199 set top [lindex [split [$w index @0,0] .] 0]
1200 set ht [$w cget -height]
1201 set l [lindex [split [$w index s:$ix] .] 0]
1202 if {$l < $top} {
1203 $w yview $l.0
1204 } elseif {$l + $n + 1 > $top + $ht} {
1205 set top [expr {$l + $n + 2 - $ht}]
1206 if {$l < $top} {
1207 set top $l
1209 $w yview $top.0
1213 proc treeclick {w x y} {
1214 global treediropen cmitmode ctext cflist cflist_top
1216 if {$cmitmode ne "tree"} return
1217 if {![info exists cflist_top]} return
1218 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1219 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1220 $cflist tag add highlight $l.0 "$l.0 lineend"
1221 set cflist_top $l
1222 if {$l == 1} {
1223 $ctext yview 1.0
1224 return
1226 set e [linetoelt $l]
1227 if {[string index $e end] ne "/"} {
1228 showfile $e
1229 } elseif {$treediropen($e)} {
1230 treeclosedir $w $e
1231 } else {
1232 treeopendir $w $e
1236 proc setfilelist {id} {
1237 global treefilelist cflist
1239 treeview $cflist $treefilelist($id) 0
1242 image create bitmap tri-rt -background black -foreground blue -data {
1243 #define tri-rt_width 13
1244 #define tri-rt_height 13
1245 static unsigned char tri-rt_bits[] = {
1246 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1247 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1248 0x00, 0x00};
1249 } -maskdata {
1250 #define tri-rt-mask_width 13
1251 #define tri-rt-mask_height 13
1252 static unsigned char tri-rt-mask_bits[] = {
1253 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1254 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1255 0x08, 0x00};
1257 image create bitmap tri-dn -background black -foreground blue -data {
1258 #define tri-dn_width 13
1259 #define tri-dn_height 13
1260 static unsigned char tri-dn_bits[] = {
1261 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1262 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1263 0x00, 0x00};
1264 } -maskdata {
1265 #define tri-dn-mask_width 13
1266 #define tri-dn-mask_height 13
1267 static unsigned char tri-dn-mask_bits[] = {
1268 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1269 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1270 0x00, 0x00};
1273 proc init_flist {first} {
1274 global cflist cflist_top selectedline difffilestart
1276 $cflist conf -state normal
1277 $cflist delete 0.0 end
1278 if {$first ne {}} {
1279 $cflist insert end $first
1280 set cflist_top 1
1281 $cflist tag add highlight 1.0 "1.0 lineend"
1282 } else {
1283 catch {unset cflist_top}
1285 $cflist conf -state disabled
1286 set difffilestart {}
1289 proc highlight_tag {f} {
1290 global highlight_paths
1292 foreach p $highlight_paths {
1293 if {[string match $p $f]} {
1294 return "bold"
1297 return {}
1300 proc highlight_filelist {} {
1301 global cmitmode cflist
1303 $cflist conf -state normal
1304 if {$cmitmode ne "tree"} {
1305 set end [lindex [split [$cflist index end] .] 0]
1306 for {set l 2} {$l < $end} {incr l} {
1307 set line [$cflist get $l.0 "$l.0 lineend"]
1308 if {[highlight_tag $line] ne {}} {
1309 $cflist tag add bold $l.0 "$l.0 lineend"
1312 } else {
1313 highlight_tree 2 {}
1315 $cflist conf -state disabled
1318 proc unhighlight_filelist {} {
1319 global cflist
1321 $cflist conf -state normal
1322 $cflist tag remove bold 1.0 end
1323 $cflist conf -state disabled
1326 proc add_flist {fl} {
1327 global cflist
1329 $cflist conf -state normal
1330 foreach f $fl {
1331 $cflist insert end "\n"
1332 $cflist insert end $f [highlight_tag $f]
1334 $cflist conf -state disabled
1337 proc sel_flist {w x y} {
1338 global ctext difffilestart cflist cflist_top cmitmode
1340 if {$cmitmode eq "tree"} return
1341 if {![info exists cflist_top]} return
1342 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1343 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1344 $cflist tag add highlight $l.0 "$l.0 lineend"
1345 set cflist_top $l
1346 if {$l == 1} {
1347 $ctext yview 1.0
1348 } else {
1349 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1353 # Functions for adding and removing shell-type quoting
1355 proc shellquote {str} {
1356 if {![string match "*\['\"\\ \t]*" $str]} {
1357 return $str
1359 if {![string match "*\['\"\\]*" $str]} {
1360 return "\"$str\""
1362 if {![string match "*'*" $str]} {
1363 return "'$str'"
1365 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1368 proc shellarglist {l} {
1369 set str {}
1370 foreach a $l {
1371 if {$str ne {}} {
1372 append str " "
1374 append str [shellquote $a]
1376 return $str
1379 proc shelldequote {str} {
1380 set ret {}
1381 set used -1
1382 while {1} {
1383 incr used
1384 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1385 append ret [string range $str $used end]
1386 set used [string length $str]
1387 break
1389 set first [lindex $first 0]
1390 set ch [string index $str $first]
1391 if {$first > $used} {
1392 append ret [string range $str $used [expr {$first - 1}]]
1393 set used $first
1395 if {$ch eq " " || $ch eq "\t"} break
1396 incr used
1397 if {$ch eq "'"} {
1398 set first [string first "'" $str $used]
1399 if {$first < 0} {
1400 error "unmatched single-quote"
1402 append ret [string range $str $used [expr {$first - 1}]]
1403 set used $first
1404 continue
1406 if {$ch eq "\\"} {
1407 if {$used >= [string length $str]} {
1408 error "trailing backslash"
1410 append ret [string index $str $used]
1411 continue
1413 # here ch == "\""
1414 while {1} {
1415 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1416 error "unmatched double-quote"
1418 set first [lindex $first 0]
1419 set ch [string index $str $first]
1420 if {$first > $used} {
1421 append ret [string range $str $used [expr {$first - 1}]]
1422 set used $first
1424 if {$ch eq "\""} break
1425 incr used
1426 append ret [string index $str $used]
1427 incr used
1430 return [list $used $ret]
1433 proc shellsplit {str} {
1434 set l {}
1435 while {1} {
1436 set str [string trimleft $str]
1437 if {$str eq {}} break
1438 set dq [shelldequote $str]
1439 set n [lindex $dq 0]
1440 set word [lindex $dq 1]
1441 set str [string range $str $n end]
1442 lappend l $word
1444 return $l
1447 # Code to implement multiple views
1449 proc newview {ishighlight} {
1450 global nextviewnum newviewname newviewperm uifont newishighlight
1451 global newviewargs revtreeargs
1453 set newishighlight $ishighlight
1454 set top .gitkview
1455 if {[winfo exists $top]} {
1456 raise $top
1457 return
1459 set newviewname($nextviewnum) "View $nextviewnum"
1460 set newviewperm($nextviewnum) 0
1461 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1462 vieweditor $top $nextviewnum "Gitk view definition"
1465 proc editview {} {
1466 global curview
1467 global viewname viewperm newviewname newviewperm
1468 global viewargs newviewargs
1470 set top .gitkvedit-$curview
1471 if {[winfo exists $top]} {
1472 raise $top
1473 return
1475 set newviewname($curview) $viewname($curview)
1476 set newviewperm($curview) $viewperm($curview)
1477 set newviewargs($curview) [shellarglist $viewargs($curview)]
1478 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1481 proc vieweditor {top n title} {
1482 global newviewname newviewperm viewfiles
1483 global uifont
1485 toplevel $top
1486 wm title $top $title
1487 label $top.nl -text "Name" -font $uifont
1488 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1489 grid $top.nl $top.name -sticky w -pady 5
1490 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1491 -font $uifont
1492 grid $top.perm - -pady 5 -sticky w
1493 message $top.al -aspect 1000 -font $uifont \
1494 -text "Commits to include (arguments to git rev-list):"
1495 grid $top.al - -sticky w -pady 5
1496 entry $top.args -width 50 -textvariable newviewargs($n) \
1497 -background white -font $uifont
1498 grid $top.args - -sticky ew -padx 5
1499 message $top.l -aspect 1000 -font $uifont \
1500 -text "Enter files and directories to include, one per line:"
1501 grid $top.l - -sticky w
1502 text $top.t -width 40 -height 10 -background white -font $uifont
1503 if {[info exists viewfiles($n)]} {
1504 foreach f $viewfiles($n) {
1505 $top.t insert end $f
1506 $top.t insert end "\n"
1508 $top.t delete {end - 1c} end
1509 $top.t mark set insert 0.0
1511 grid $top.t - -sticky ew -padx 5
1512 frame $top.buts
1513 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1514 -font $uifont
1515 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1516 -font $uifont
1517 grid $top.buts.ok $top.buts.can
1518 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1519 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1520 grid $top.buts - -pady 10 -sticky ew
1521 focus $top.t
1524 proc doviewmenu {m first cmd op argv} {
1525 set nmenu [$m index end]
1526 for {set i $first} {$i <= $nmenu} {incr i} {
1527 if {[$m entrycget $i -command] eq $cmd} {
1528 eval $m $op $i $argv
1529 break
1534 proc allviewmenus {n op args} {
1535 global viewhlmenu
1537 doviewmenu .bar.view 5 [list showview $n] $op $args
1538 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1541 proc newviewok {top n} {
1542 global nextviewnum newviewperm newviewname newishighlight
1543 global viewname viewfiles viewperm selectedview curview
1544 global viewargs newviewargs viewhlmenu
1546 if {[catch {
1547 set newargs [shellsplit $newviewargs($n)]
1548 } err]} {
1549 error_popup "Error in commit selection arguments: $err"
1550 wm raise $top
1551 focus $top
1552 return
1554 set files {}
1555 foreach f [split [$top.t get 0.0 end] "\n"] {
1556 set ft [string trim $f]
1557 if {$ft ne {}} {
1558 lappend files $ft
1561 if {![info exists viewfiles($n)]} {
1562 # creating a new view
1563 incr nextviewnum
1564 set viewname($n) $newviewname($n)
1565 set viewperm($n) $newviewperm($n)
1566 set viewfiles($n) $files
1567 set viewargs($n) $newargs
1568 addviewmenu $n
1569 if {!$newishighlight} {
1570 after idle showview $n
1571 } else {
1572 after idle addvhighlight $n
1574 } else {
1575 # editing an existing view
1576 set viewperm($n) $newviewperm($n)
1577 if {$newviewname($n) ne $viewname($n)} {
1578 set viewname($n) $newviewname($n)
1579 doviewmenu .bar.view 5 [list showview $n] \
1580 entryconf [list -label $viewname($n)]
1581 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1582 entryconf [list -label $viewname($n) -value $viewname($n)]
1584 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1585 set viewfiles($n) $files
1586 set viewargs($n) $newargs
1587 if {$curview == $n} {
1588 after idle updatecommits
1592 catch {destroy $top}
1595 proc delview {} {
1596 global curview viewdata viewperm hlview selectedhlview
1598 if {$curview == 0} return
1599 if {[info exists hlview] && $hlview == $curview} {
1600 set selectedhlview None
1601 unset hlview
1603 allviewmenus $curview delete
1604 set viewdata($curview) {}
1605 set viewperm($curview) 0
1606 showview 0
1609 proc addviewmenu {n} {
1610 global viewname viewhlmenu
1612 .bar.view add radiobutton -label $viewname($n) \
1613 -command [list showview $n] -variable selectedview -value $n
1614 $viewhlmenu add radiobutton -label $viewname($n) \
1615 -command [list addvhighlight $n] -variable selectedhlview
1618 proc flatten {var} {
1619 global $var
1621 set ret {}
1622 foreach i [array names $var] {
1623 lappend ret $i [set $var\($i\)]
1625 return $ret
1628 proc unflatten {var l} {
1629 global $var
1631 catch {unset $var}
1632 foreach {i v} $l {
1633 set $var\($i\) $v
1637 proc showview {n} {
1638 global curview viewdata viewfiles
1639 global displayorder parentlist childlist rowidlist rowoffsets
1640 global colormap rowtextx commitrow nextcolor canvxmax
1641 global numcommits rowrangelist commitlisted idrowranges
1642 global selectedline currentid canv canvy0
1643 global matchinglines treediffs
1644 global pending_select phase
1645 global commitidx rowlaidout rowoptim linesegends
1646 global commfd nextupdate
1647 global selectedview
1648 global vparentlist vchildlist vdisporder vcmitlisted
1649 global hlview selectedhlview
1651 if {$n == $curview} return
1652 set selid {}
1653 if {[info exists selectedline]} {
1654 set selid $currentid
1655 set y [yc $selectedline]
1656 set ymax [lindex [$canv cget -scrollregion] 3]
1657 set span [$canv yview]
1658 set ytop [expr {[lindex $span 0] * $ymax}]
1659 set ybot [expr {[lindex $span 1] * $ymax}]
1660 if {$ytop < $y && $y < $ybot} {
1661 set yscreen [expr {$y - $ytop}]
1662 } else {
1663 set yscreen [expr {($ybot - $ytop) / 2}]
1666 unselectline
1667 normalline
1668 stopfindproc
1669 if {$curview >= 0} {
1670 set vparentlist($curview) $parentlist
1671 set vchildlist($curview) $childlist
1672 set vdisporder($curview) $displayorder
1673 set vcmitlisted($curview) $commitlisted
1674 if {$phase ne {}} {
1675 set viewdata($curview) \
1676 [list $phase $rowidlist $rowoffsets $rowrangelist \
1677 [flatten idrowranges] [flatten idinlist] \
1678 $rowlaidout $rowoptim $numcommits $linesegends]
1679 } elseif {![info exists viewdata($curview)]
1680 || [lindex $viewdata($curview) 0] ne {}} {
1681 set viewdata($curview) \
1682 [list {} $rowidlist $rowoffsets $rowrangelist]
1685 catch {unset matchinglines}
1686 catch {unset treediffs}
1687 clear_display
1688 if {[info exists hlview] && $hlview == $n} {
1689 unset hlview
1690 set selectedhlview None
1693 set curview $n
1694 set selectedview $n
1695 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1696 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1698 if {![info exists viewdata($n)]} {
1699 set pending_select $selid
1700 getcommits
1701 return
1704 set v $viewdata($n)
1705 set phase [lindex $v 0]
1706 set displayorder $vdisporder($n)
1707 set parentlist $vparentlist($n)
1708 set childlist $vchildlist($n)
1709 set commitlisted $vcmitlisted($n)
1710 set rowidlist [lindex $v 1]
1711 set rowoffsets [lindex $v 2]
1712 set rowrangelist [lindex $v 3]
1713 if {$phase eq {}} {
1714 set numcommits [llength $displayorder]
1715 catch {unset idrowranges}
1716 } else {
1717 unflatten idrowranges [lindex $v 4]
1718 unflatten idinlist [lindex $v 5]
1719 set rowlaidout [lindex $v 6]
1720 set rowoptim [lindex $v 7]
1721 set numcommits [lindex $v 8]
1722 set linesegends [lindex $v 9]
1725 catch {unset colormap}
1726 catch {unset rowtextx}
1727 set nextcolor 0
1728 set canvxmax [$canv cget -width]
1729 set curview $n
1730 set row 0
1731 setcanvscroll
1732 set yf 0
1733 set row 0
1734 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1735 set row $commitrow($n,$selid)
1736 # try to get the selected row in the same position on the screen
1737 set ymax [lindex [$canv cget -scrollregion] 3]
1738 set ytop [expr {[yc $row] - $yscreen}]
1739 if {$ytop < 0} {
1740 set ytop 0
1742 set yf [expr {$ytop * 1.0 / $ymax}]
1744 allcanvs yview moveto $yf
1745 drawvisible
1746 selectline $row 0
1747 if {$phase ne {}} {
1748 if {$phase eq "getcommits"} {
1749 show_status "Reading commits..."
1751 if {[info exists commfd($n)]} {
1752 layoutmore {}
1753 } else {
1754 finishcommits
1756 } elseif {$numcommits == 0} {
1757 show_status "No commits selected"
1761 # Stuff relating to the highlighting facility
1763 proc ishighlighted {row} {
1764 global vhighlights fhighlights nhighlights rhighlights
1766 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1767 return $nhighlights($row)
1769 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1770 return $vhighlights($row)
1772 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1773 return $fhighlights($row)
1775 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1776 return $rhighlights($row)
1778 return 0
1781 proc bolden {row font} {
1782 global canv linehtag selectedline boldrows
1784 lappend boldrows $row
1785 $canv itemconf $linehtag($row) -font $font
1786 if {[info exists selectedline] && $row == $selectedline} {
1787 $canv delete secsel
1788 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1789 -outline {{}} -tags secsel \
1790 -fill [$canv cget -selectbackground]]
1791 $canv lower $t
1795 proc bolden_name {row font} {
1796 global canv2 linentag selectedline boldnamerows
1798 lappend boldnamerows $row
1799 $canv2 itemconf $linentag($row) -font $font
1800 if {[info exists selectedline] && $row == $selectedline} {
1801 $canv2 delete secsel
1802 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1803 -outline {{}} -tags secsel \
1804 -fill [$canv2 cget -selectbackground]]
1805 $canv2 lower $t
1809 proc unbolden {} {
1810 global mainfont boldrows
1812 set stillbold {}
1813 foreach row $boldrows {
1814 if {![ishighlighted $row]} {
1815 bolden $row $mainfont
1816 } else {
1817 lappend stillbold $row
1820 set boldrows $stillbold
1823 proc addvhighlight {n} {
1824 global hlview curview viewdata vhl_done vhighlights commitidx
1826 if {[info exists hlview]} {
1827 delvhighlight
1829 set hlview $n
1830 if {$n != $curview && ![info exists viewdata($n)]} {
1831 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1832 set vparentlist($n) {}
1833 set vchildlist($n) {}
1834 set vdisporder($n) {}
1835 set vcmitlisted($n) {}
1836 start_rev_list $n
1838 set vhl_done $commitidx($hlview)
1839 if {$vhl_done > 0} {
1840 drawvisible
1844 proc delvhighlight {} {
1845 global hlview vhighlights
1847 if {![info exists hlview]} return
1848 unset hlview
1849 catch {unset vhighlights}
1850 unbolden
1853 proc vhighlightmore {} {
1854 global hlview vhl_done commitidx vhighlights
1855 global displayorder vdisporder curview mainfont
1857 set font [concat $mainfont bold]
1858 set max $commitidx($hlview)
1859 if {$hlview == $curview} {
1860 set disp $displayorder
1861 } else {
1862 set disp $vdisporder($hlview)
1864 set vr [visiblerows]
1865 set r0 [lindex $vr 0]
1866 set r1 [lindex $vr 1]
1867 for {set i $vhl_done} {$i < $max} {incr i} {
1868 set id [lindex $disp $i]
1869 if {[info exists commitrow($curview,$id)]} {
1870 set row $commitrow($curview,$id)
1871 if {$r0 <= $row && $row <= $r1} {
1872 if {![highlighted $row]} {
1873 bolden $row $font
1875 set vhighlights($row) 1
1879 set vhl_done $max
1882 proc askvhighlight {row id} {
1883 global hlview vhighlights commitrow iddrawn mainfont
1885 if {[info exists commitrow($hlview,$id)]} {
1886 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1887 bolden $row [concat $mainfont bold]
1889 set vhighlights($row) 1
1890 } else {
1891 set vhighlights($row) 0
1895 proc hfiles_change {name ix op} {
1896 global highlight_files filehighlight fhighlights fh_serial
1897 global mainfont highlight_paths
1899 if {[info exists filehighlight]} {
1900 # delete previous highlights
1901 catch {close $filehighlight}
1902 unset filehighlight
1903 catch {unset fhighlights}
1904 unbolden
1905 unhighlight_filelist
1907 set highlight_paths {}
1908 after cancel do_file_hl $fh_serial
1909 incr fh_serial
1910 if {$highlight_files ne {}} {
1911 after 300 do_file_hl $fh_serial
1915 proc makepatterns {l} {
1916 set ret {}
1917 foreach e $l {
1918 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1919 if {[string index $ee end] eq "/"} {
1920 lappend ret "$ee*"
1921 } else {
1922 lappend ret $ee
1923 lappend ret "$ee/*"
1926 return $ret
1929 proc do_file_hl {serial} {
1930 global highlight_files filehighlight highlight_paths gdttype fhl_list
1932 if {$gdttype eq "touching paths:"} {
1933 if {[catch {set paths [shellsplit $highlight_files]}]} return
1934 set highlight_paths [makepatterns $paths]
1935 highlight_filelist
1936 set gdtargs [concat -- $paths]
1937 } else {
1938 set gdtargs [list "-S$highlight_files"]
1940 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1941 set filehighlight [open $cmd r+]
1942 fconfigure $filehighlight -blocking 0
1943 fileevent $filehighlight readable readfhighlight
1944 set fhl_list {}
1945 drawvisible
1946 flushhighlights
1949 proc flushhighlights {} {
1950 global filehighlight fhl_list
1952 if {[info exists filehighlight]} {
1953 lappend fhl_list {}
1954 puts $filehighlight ""
1955 flush $filehighlight
1959 proc askfilehighlight {row id} {
1960 global filehighlight fhighlights fhl_list
1962 lappend fhl_list $id
1963 set fhighlights($row) -1
1964 puts $filehighlight $id
1967 proc readfhighlight {} {
1968 global filehighlight fhighlights commitrow curview mainfont iddrawn
1969 global fhl_list
1971 while {[gets $filehighlight line] >= 0} {
1972 set line [string trim $line]
1973 set i [lsearch -exact $fhl_list $line]
1974 if {$i < 0} continue
1975 for {set j 0} {$j < $i} {incr j} {
1976 set id [lindex $fhl_list $j]
1977 if {[info exists commitrow($curview,$id)]} {
1978 set fhighlights($commitrow($curview,$id)) 0
1981 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1982 if {$line eq {}} continue
1983 if {![info exists commitrow($curview,$line)]} continue
1984 set row $commitrow($curview,$line)
1985 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1986 bolden $row [concat $mainfont bold]
1988 set fhighlights($row) 1
1990 if {[eof $filehighlight]} {
1991 # strange...
1992 puts "oops, git diff-tree died"
1993 catch {close $filehighlight}
1994 unset filehighlight
1996 next_hlcont
1999 proc find_change {name ix op} {
2000 global nhighlights mainfont boldnamerows
2001 global findstring findpattern findtype
2003 # delete previous highlights, if any
2004 foreach row $boldnamerows {
2005 bolden_name $row $mainfont
2007 set boldnamerows {}
2008 catch {unset nhighlights}
2009 unbolden
2010 if {$findtype ne "Regexp"} {
2011 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2012 $findstring]
2013 set findpattern "*$e*"
2015 drawvisible
2018 proc askfindhighlight {row id} {
2019 global nhighlights commitinfo iddrawn mainfont
2020 global findstring findtype findloc findpattern
2022 if {![info exists commitinfo($id)]} {
2023 getcommit $id
2025 set info $commitinfo($id)
2026 set isbold 0
2027 set fldtypes {Headline Author Date Committer CDate Comments}
2028 foreach f $info ty $fldtypes {
2029 if {$findloc ne "All fields" && $findloc ne $ty} {
2030 continue
2032 if {$findtype eq "Regexp"} {
2033 set doesmatch [regexp $findstring $f]
2034 } elseif {$findtype eq "IgnCase"} {
2035 set doesmatch [string match -nocase $findpattern $f]
2036 } else {
2037 set doesmatch [string match $findpattern $f]
2039 if {$doesmatch} {
2040 if {$ty eq "Author"} {
2041 set isbold 2
2042 } else {
2043 set isbold 1
2047 if {[info exists iddrawn($id)]} {
2048 if {$isbold && ![ishighlighted $row]} {
2049 bolden $row [concat $mainfont bold]
2051 if {$isbold >= 2} {
2052 bolden_name $row [concat $mainfont bold]
2055 set nhighlights($row) $isbold
2058 proc vrel_change {name ix op} {
2059 global highlight_related
2061 rhighlight_none
2062 if {$highlight_related ne "None"} {
2063 after idle drawvisible
2067 # prepare for testing whether commits are descendents or ancestors of a
2068 proc rhighlight_sel {a} {
2069 global descendent desc_todo ancestor anc_todo
2070 global highlight_related rhighlights
2072 catch {unset descendent}
2073 set desc_todo [list $a]
2074 catch {unset ancestor}
2075 set anc_todo [list $a]
2076 if {$highlight_related ne "None"} {
2077 rhighlight_none
2078 after idle drawvisible
2082 proc rhighlight_none {} {
2083 global rhighlights
2085 catch {unset rhighlights}
2086 unbolden
2089 proc is_descendent {a} {
2090 global curview children commitrow descendent desc_todo
2092 set v $curview
2093 set la $commitrow($v,$a)
2094 set todo $desc_todo
2095 set leftover {}
2096 set done 0
2097 for {set i 0} {$i < [llength $todo]} {incr i} {
2098 set do [lindex $todo $i]
2099 if {$commitrow($v,$do) < $la} {
2100 lappend leftover $do
2101 continue
2103 foreach nk $children($v,$do) {
2104 if {![info exists descendent($nk)]} {
2105 set descendent($nk) 1
2106 lappend todo $nk
2107 if {$nk eq $a} {
2108 set done 1
2112 if {$done} {
2113 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2114 return
2117 set descendent($a) 0
2118 set desc_todo $leftover
2121 proc is_ancestor {a} {
2122 global curview parentlist commitrow ancestor anc_todo
2124 set v $curview
2125 set la $commitrow($v,$a)
2126 set todo $anc_todo
2127 set leftover {}
2128 set done 0
2129 for {set i 0} {$i < [llength $todo]} {incr i} {
2130 set do [lindex $todo $i]
2131 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2132 lappend leftover $do
2133 continue
2135 foreach np [lindex $parentlist $commitrow($v,$do)] {
2136 if {![info exists ancestor($np)]} {
2137 set ancestor($np) 1
2138 lappend todo $np
2139 if {$np eq $a} {
2140 set done 1
2144 if {$done} {
2145 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2146 return
2149 set ancestor($a) 0
2150 set anc_todo $leftover
2153 proc askrelhighlight {row id} {
2154 global descendent highlight_related iddrawn mainfont rhighlights
2155 global selectedline ancestor
2157 if {![info exists selectedline]} return
2158 set isbold 0
2159 if {$highlight_related eq "Descendent" ||
2160 $highlight_related eq "Not descendent"} {
2161 if {![info exists descendent($id)]} {
2162 is_descendent $id
2164 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2165 set isbold 1
2167 } elseif {$highlight_related eq "Ancestor" ||
2168 $highlight_related eq "Not ancestor"} {
2169 if {![info exists ancestor($id)]} {
2170 is_ancestor $id
2172 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2173 set isbold 1
2176 if {[info exists iddrawn($id)]} {
2177 if {$isbold && ![ishighlighted $row]} {
2178 bolden $row [concat $mainfont bold]
2181 set rhighlights($row) $isbold
2184 proc next_hlcont {} {
2185 global fhl_row fhl_dirn displayorder numcommits
2186 global vhighlights fhighlights nhighlights rhighlights
2187 global hlview filehighlight findstring highlight_related
2189 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2190 set row $fhl_row
2191 while {1} {
2192 if {$row < 0 || $row >= $numcommits} {
2193 bell
2194 set fhl_dirn 0
2195 return
2197 set id [lindex $displayorder $row]
2198 if {[info exists hlview]} {
2199 if {![info exists vhighlights($row)]} {
2200 askvhighlight $row $id
2202 if {$vhighlights($row) > 0} break
2204 if {$findstring ne {}} {
2205 if {![info exists nhighlights($row)]} {
2206 askfindhighlight $row $id
2208 if {$nhighlights($row) > 0} break
2210 if {$highlight_related ne "None"} {
2211 if {![info exists rhighlights($row)]} {
2212 askrelhighlight $row $id
2214 if {$rhighlights($row) > 0} break
2216 if {[info exists filehighlight]} {
2217 if {![info exists fhighlights($row)]} {
2218 # ask for a few more while we're at it...
2219 set r $row
2220 for {set n 0} {$n < 100} {incr n} {
2221 if {![info exists fhighlights($r)]} {
2222 askfilehighlight $r [lindex $displayorder $r]
2224 incr r $fhl_dirn
2225 if {$r < 0 || $r >= $numcommits} break
2227 flushhighlights
2229 if {$fhighlights($row) < 0} {
2230 set fhl_row $row
2231 return
2233 if {$fhighlights($row) > 0} break
2235 incr row $fhl_dirn
2237 set fhl_dirn 0
2238 selectline $row 1
2241 proc next_highlight {dirn} {
2242 global selectedline fhl_row fhl_dirn
2243 global hlview filehighlight findstring highlight_related
2245 if {![info exists selectedline]} return
2246 if {!([info exists hlview] || $findstring ne {} ||
2247 $highlight_related ne "None" || [info exists filehighlight])} return
2248 set fhl_row [expr {$selectedline + $dirn}]
2249 set fhl_dirn $dirn
2250 next_hlcont
2253 proc cancel_next_highlight {} {
2254 global fhl_dirn
2256 set fhl_dirn 0
2259 # Graph layout functions
2261 proc shortids {ids} {
2262 set res {}
2263 foreach id $ids {
2264 if {[llength $id] > 1} {
2265 lappend res [shortids $id]
2266 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2267 lappend res [string range $id 0 7]
2268 } else {
2269 lappend res $id
2272 return $res
2275 proc incrange {l x o} {
2276 set n [llength $l]
2277 while {$x < $n} {
2278 set e [lindex $l $x]
2279 if {$e ne {}} {
2280 lset l $x [expr {$e + $o}]
2282 incr x
2284 return $l
2287 proc ntimes {n o} {
2288 set ret {}
2289 for {} {$n > 0} {incr n -1} {
2290 lappend ret $o
2292 return $ret
2295 proc usedinrange {id l1 l2} {
2296 global children commitrow childlist curview
2298 if {[info exists commitrow($curview,$id)]} {
2299 set r $commitrow($curview,$id)
2300 if {$l1 <= $r && $r <= $l2} {
2301 return [expr {$r - $l1 + 1}]
2303 set kids [lindex $childlist $r]
2304 } else {
2305 set kids $children($curview,$id)
2307 foreach c $kids {
2308 set r $commitrow($curview,$c)
2309 if {$l1 <= $r && $r <= $l2} {
2310 return [expr {$r - $l1 + 1}]
2313 return 0
2316 proc sanity {row {full 0}} {
2317 global rowidlist rowoffsets
2319 set col -1
2320 set ids [lindex $rowidlist $row]
2321 foreach id $ids {
2322 incr col
2323 if {$id eq {}} continue
2324 if {$col < [llength $ids] - 1 &&
2325 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2326 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2328 set o [lindex $rowoffsets $row $col]
2329 set y $row
2330 set x $col
2331 while {$o ne {}} {
2332 incr y -1
2333 incr x $o
2334 if {[lindex $rowidlist $y $x] != $id} {
2335 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2336 puts " id=[shortids $id] check started at row $row"
2337 for {set i $row} {$i >= $y} {incr i -1} {
2338 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2340 break
2342 if {!$full} break
2343 set o [lindex $rowoffsets $y $x]
2348 proc makeuparrow {oid x y z} {
2349 global rowidlist rowoffsets uparrowlen idrowranges
2351 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2352 incr y -1
2353 incr x $z
2354 set off0 [lindex $rowoffsets $y]
2355 for {set x0 $x} {1} {incr x0} {
2356 if {$x0 >= [llength $off0]} {
2357 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2358 break
2360 set z [lindex $off0 $x0]
2361 if {$z ne {}} {
2362 incr x0 $z
2363 break
2366 set z [expr {$x0 - $x}]
2367 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2368 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2370 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2371 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2372 lappend idrowranges($oid) $y
2375 proc initlayout {} {
2376 global rowidlist rowoffsets displayorder commitlisted
2377 global rowlaidout rowoptim
2378 global idinlist rowchk rowrangelist idrowranges
2379 global numcommits canvxmax canv
2380 global nextcolor
2381 global parentlist childlist children
2382 global colormap rowtextx
2383 global linesegends
2385 set numcommits 0
2386 set displayorder {}
2387 set commitlisted {}
2388 set parentlist {}
2389 set childlist {}
2390 set rowrangelist {}
2391 set nextcolor 0
2392 set rowidlist {{}}
2393 set rowoffsets {{}}
2394 catch {unset idinlist}
2395 catch {unset rowchk}
2396 set rowlaidout 0
2397 set rowoptim 0
2398 set canvxmax [$canv cget -width]
2399 catch {unset colormap}
2400 catch {unset rowtextx}
2401 catch {unset idrowranges}
2402 set linesegends {}
2405 proc setcanvscroll {} {
2406 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2408 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2409 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2410 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2411 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2414 proc visiblerows {} {
2415 global canv numcommits linespc
2417 set ymax [lindex [$canv cget -scrollregion] 3]
2418 if {$ymax eq {} || $ymax == 0} return
2419 set f [$canv yview]
2420 set y0 [expr {int([lindex $f 0] * $ymax)}]
2421 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2422 if {$r0 < 0} {
2423 set r0 0
2425 set y1 [expr {int([lindex $f 1] * $ymax)}]
2426 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2427 if {$r1 >= $numcommits} {
2428 set r1 [expr {$numcommits - 1}]
2430 return [list $r0 $r1]
2433 proc layoutmore {tmax} {
2434 global rowlaidout rowoptim commitidx numcommits optim_delay
2435 global uparrowlen curview
2437 while {1} {
2438 if {$rowoptim - $optim_delay > $numcommits} {
2439 showstuff [expr {$rowoptim - $optim_delay}]
2440 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2441 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2442 if {$nr > 100} {
2443 set nr 100
2445 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2446 incr rowoptim $nr
2447 } elseif {$commitidx($curview) > $rowlaidout} {
2448 set nr [expr {$commitidx($curview) - $rowlaidout}]
2449 # may need to increase this threshold if uparrowlen or
2450 # mingaplen are increased...
2451 if {$nr > 150} {
2452 set nr 150
2454 set row $rowlaidout
2455 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2456 if {$rowlaidout == $row} {
2457 return 0
2459 } else {
2460 return 0
2462 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2463 return 1
2468 proc showstuff {canshow} {
2469 global numcommits commitrow pending_select selectedline
2470 global linesegends idrowranges idrangedrawn curview
2472 if {$numcommits == 0} {
2473 global phase
2474 set phase "incrdraw"
2475 allcanvs delete all
2477 set row $numcommits
2478 set numcommits $canshow
2479 setcanvscroll
2480 set rows [visiblerows]
2481 set r0 [lindex $rows 0]
2482 set r1 [lindex $rows 1]
2483 set selrow -1
2484 for {set r $row} {$r < $canshow} {incr r} {
2485 foreach id [lindex $linesegends [expr {$r+1}]] {
2486 set i -1
2487 foreach {s e} [rowranges $id] {
2488 incr i
2489 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2490 && ![info exists idrangedrawn($id,$i)]} {
2491 drawlineseg $id $i
2492 set idrangedrawn($id,$i) 1
2497 if {$canshow > $r1} {
2498 set canshow $r1
2500 while {$row < $canshow} {
2501 drawcmitrow $row
2502 incr row
2504 if {[info exists pending_select] &&
2505 [info exists commitrow($curview,$pending_select)] &&
2506 $commitrow($curview,$pending_select) < $numcommits} {
2507 selectline $commitrow($curview,$pending_select) 1
2509 if {![info exists selectedline] && ![info exists pending_select]} {
2510 selectline 0 1
2514 proc layoutrows {row endrow last} {
2515 global rowidlist rowoffsets displayorder
2516 global uparrowlen downarrowlen maxwidth mingaplen
2517 global childlist parentlist
2518 global idrowranges linesegends
2519 global commitidx curview
2520 global idinlist rowchk rowrangelist
2522 set idlist [lindex $rowidlist $row]
2523 set offs [lindex $rowoffsets $row]
2524 while {$row < $endrow} {
2525 set id [lindex $displayorder $row]
2526 set oldolds {}
2527 set newolds {}
2528 foreach p [lindex $parentlist $row] {
2529 if {![info exists idinlist($p)]} {
2530 lappend newolds $p
2531 } elseif {!$idinlist($p)} {
2532 lappend oldolds $p
2535 set lse {}
2536 set nev [expr {[llength $idlist] + [llength $newolds]
2537 + [llength $oldolds] - $maxwidth + 1}]
2538 if {$nev > 0} {
2539 if {!$last &&
2540 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2541 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2542 set i [lindex $idlist $x]
2543 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2544 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2545 [expr {$row + $uparrowlen + $mingaplen}]]
2546 if {$r == 0} {
2547 set idlist [lreplace $idlist $x $x]
2548 set offs [lreplace $offs $x $x]
2549 set offs [incrange $offs $x 1]
2550 set idinlist($i) 0
2551 set rm1 [expr {$row - 1}]
2552 lappend lse $i
2553 lappend idrowranges($i) $rm1
2554 if {[incr nev -1] <= 0} break
2555 continue
2557 set rowchk($id) [expr {$row + $r}]
2560 lset rowidlist $row $idlist
2561 lset rowoffsets $row $offs
2563 lappend linesegends $lse
2564 set col [lsearch -exact $idlist $id]
2565 if {$col < 0} {
2566 set col [llength $idlist]
2567 lappend idlist $id
2568 lset rowidlist $row $idlist
2569 set z {}
2570 if {[lindex $childlist $row] ne {}} {
2571 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2572 unset idinlist($id)
2574 lappend offs $z
2575 lset rowoffsets $row $offs
2576 if {$z ne {}} {
2577 makeuparrow $id $col $row $z
2579 } else {
2580 unset idinlist($id)
2582 set ranges {}
2583 if {[info exists idrowranges($id)]} {
2584 set ranges $idrowranges($id)
2585 lappend ranges $row
2586 unset idrowranges($id)
2588 lappend rowrangelist $ranges
2589 incr row
2590 set offs [ntimes [llength $idlist] 0]
2591 set l [llength $newolds]
2592 set idlist [eval lreplace \$idlist $col $col $newolds]
2593 set o 0
2594 if {$l != 1} {
2595 set offs [lrange $offs 0 [expr {$col - 1}]]
2596 foreach x $newolds {
2597 lappend offs {}
2598 incr o -1
2600 incr o
2601 set tmp [expr {[llength $idlist] - [llength $offs]}]
2602 if {$tmp > 0} {
2603 set offs [concat $offs [ntimes $tmp $o]]
2605 } else {
2606 lset offs $col {}
2608 foreach i $newolds {
2609 set idinlist($i) 1
2610 set idrowranges($i) $row
2612 incr col $l
2613 foreach oid $oldolds {
2614 set idinlist($oid) 1
2615 set idlist [linsert $idlist $col $oid]
2616 set offs [linsert $offs $col $o]
2617 makeuparrow $oid $col $row $o
2618 incr col
2620 lappend rowidlist $idlist
2621 lappend rowoffsets $offs
2623 return $row
2626 proc addextraid {id row} {
2627 global displayorder commitrow commitinfo
2628 global commitidx commitlisted
2629 global parentlist childlist children curview
2631 incr commitidx($curview)
2632 lappend displayorder $id
2633 lappend commitlisted 0
2634 lappend parentlist {}
2635 set commitrow($curview,$id) $row
2636 readcommit $id
2637 if {![info exists commitinfo($id)]} {
2638 set commitinfo($id) {"No commit information available"}
2640 if {![info exists children($curview,$id)]} {
2641 set children($curview,$id) {}
2643 lappend childlist $children($curview,$id)
2646 proc layouttail {} {
2647 global rowidlist rowoffsets idinlist commitidx curview
2648 global idrowranges rowrangelist
2650 set row $commitidx($curview)
2651 set idlist [lindex $rowidlist $row]
2652 while {$idlist ne {}} {
2653 set col [expr {[llength $idlist] - 1}]
2654 set id [lindex $idlist $col]
2655 addextraid $id $row
2656 unset idinlist($id)
2657 lappend idrowranges($id) $row
2658 lappend rowrangelist $idrowranges($id)
2659 unset idrowranges($id)
2660 incr row
2661 set offs [ntimes $col 0]
2662 set idlist [lreplace $idlist $col $col]
2663 lappend rowidlist $idlist
2664 lappend rowoffsets $offs
2667 foreach id [array names idinlist] {
2668 addextraid $id $row
2669 lset rowidlist $row [list $id]
2670 lset rowoffsets $row 0
2671 makeuparrow $id 0 $row 0
2672 lappend idrowranges($id) $row
2673 lappend rowrangelist $idrowranges($id)
2674 unset idrowranges($id)
2675 incr row
2676 lappend rowidlist {}
2677 lappend rowoffsets {}
2681 proc insert_pad {row col npad} {
2682 global rowidlist rowoffsets
2684 set pad [ntimes $npad {}]
2685 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2686 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2687 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2690 proc optimize_rows {row col endrow} {
2691 global rowidlist rowoffsets idrowranges displayorder
2693 for {} {$row < $endrow} {incr row} {
2694 set idlist [lindex $rowidlist $row]
2695 set offs [lindex $rowoffsets $row]
2696 set haspad 0
2697 for {} {$col < [llength $offs]} {incr col} {
2698 if {[lindex $idlist $col] eq {}} {
2699 set haspad 1
2700 continue
2702 set z [lindex $offs $col]
2703 if {$z eq {}} continue
2704 set isarrow 0
2705 set x0 [expr {$col + $z}]
2706 set y0 [expr {$row - 1}]
2707 set z0 [lindex $rowoffsets $y0 $x0]
2708 if {$z0 eq {}} {
2709 set id [lindex $idlist $col]
2710 set ranges [rowranges $id]
2711 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2712 set isarrow 1
2715 if {$z < -1 || ($z < 0 && $isarrow)} {
2716 set npad [expr {-1 - $z + $isarrow}]
2717 set offs [incrange $offs $col $npad]
2718 insert_pad $y0 $x0 $npad
2719 if {$y0 > 0} {
2720 optimize_rows $y0 $x0 $row
2722 set z [lindex $offs $col]
2723 set x0 [expr {$col + $z}]
2724 set z0 [lindex $rowoffsets $y0 $x0]
2725 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2726 set npad [expr {$z - 1 + $isarrow}]
2727 set y1 [expr {$row + 1}]
2728 set offs2 [lindex $rowoffsets $y1]
2729 set x1 -1
2730 foreach z $offs2 {
2731 incr x1
2732 if {$z eq {} || $x1 + $z < $col} continue
2733 if {$x1 + $z > $col} {
2734 incr npad
2736 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2737 break
2739 set pad [ntimes $npad {}]
2740 set idlist [eval linsert \$idlist $col $pad]
2741 set tmp [eval linsert \$offs $col $pad]
2742 incr col $npad
2743 set offs [incrange $tmp $col [expr {-$npad}]]
2744 set z [lindex $offs $col]
2745 set haspad 1
2747 if {$z0 eq {} && !$isarrow} {
2748 # this line links to its first child on row $row-2
2749 set rm2 [expr {$row - 2}]
2750 set id [lindex $displayorder $rm2]
2751 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2752 if {$xc >= 0} {
2753 set z0 [expr {$xc - $x0}]
2756 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2757 insert_pad $y0 $x0 1
2758 set offs [incrange $offs $col 1]
2759 optimize_rows $y0 [expr {$x0 + 1}] $row
2762 if {!$haspad} {
2763 set o {}
2764 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2765 set o [lindex $offs $col]
2766 if {$o eq {}} {
2767 # check if this is the link to the first child
2768 set id [lindex $idlist $col]
2769 set ranges [rowranges $id]
2770 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2771 # it is, work out offset to child
2772 set y0 [expr {$row - 1}]
2773 set id [lindex $displayorder $y0]
2774 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2775 if {$x0 >= 0} {
2776 set o [expr {$x0 - $col}]
2780 if {$o eq {} || $o <= 0} break
2782 if {$o ne {} && [incr col] < [llength $idlist]} {
2783 set y1 [expr {$row + 1}]
2784 set offs2 [lindex $rowoffsets $y1]
2785 set x1 -1
2786 foreach z $offs2 {
2787 incr x1
2788 if {$z eq {} || $x1 + $z < $col} continue
2789 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2790 break
2792 set idlist [linsert $idlist $col {}]
2793 set tmp [linsert $offs $col {}]
2794 incr col
2795 set offs [incrange $tmp $col -1]
2798 lset rowidlist $row $idlist
2799 lset rowoffsets $row $offs
2800 set col 0
2804 proc xc {row col} {
2805 global canvx0 linespc
2806 return [expr {$canvx0 + $col * $linespc}]
2809 proc yc {row} {
2810 global canvy0 linespc
2811 return [expr {$canvy0 + $row * $linespc}]
2814 proc linewidth {id} {
2815 global thickerline lthickness
2817 set wid $lthickness
2818 if {[info exists thickerline] && $id eq $thickerline} {
2819 set wid [expr {2 * $lthickness}]
2821 return $wid
2824 proc rowranges {id} {
2825 global phase idrowranges commitrow rowlaidout rowrangelist curview
2827 set ranges {}
2828 if {$phase eq {} ||
2829 ([info exists commitrow($curview,$id)]
2830 && $commitrow($curview,$id) < $rowlaidout)} {
2831 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2832 } elseif {[info exists idrowranges($id)]} {
2833 set ranges $idrowranges($id)
2835 return $ranges
2838 proc drawlineseg {id i} {
2839 global rowoffsets rowidlist
2840 global displayorder
2841 global canv colormap linespc
2842 global numcommits commitrow curview
2844 set ranges [rowranges $id]
2845 set downarrow 1
2846 if {[info exists commitrow($curview,$id)]
2847 && $commitrow($curview,$id) < $numcommits} {
2848 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2849 } else {
2850 set downarrow 1
2852 set startrow [lindex $ranges [expr {2 * $i}]]
2853 set row [lindex $ranges [expr {2 * $i + 1}]]
2854 if {$startrow == $row} return
2855 assigncolor $id
2856 set coords {}
2857 set col [lsearch -exact [lindex $rowidlist $row] $id]
2858 if {$col < 0} {
2859 puts "oops: drawline: id $id not on row $row"
2860 return
2862 set lasto {}
2863 set ns 0
2864 while {1} {
2865 set o [lindex $rowoffsets $row $col]
2866 if {$o eq {}} break
2867 if {$o ne $lasto} {
2868 # changing direction
2869 set x [xc $row $col]
2870 set y [yc $row]
2871 lappend coords $x $y
2872 set lasto $o
2874 incr col $o
2875 incr row -1
2877 set x [xc $row $col]
2878 set y [yc $row]
2879 lappend coords $x $y
2880 if {$i == 0} {
2881 # draw the link to the first child as part of this line
2882 incr row -1
2883 set child [lindex $displayorder $row]
2884 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2885 if {$ccol >= 0} {
2886 set x [xc $row $ccol]
2887 set y [yc $row]
2888 if {$ccol < $col - 1} {
2889 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2890 } elseif {$ccol > $col + 1} {
2891 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2893 lappend coords $x $y
2896 if {[llength $coords] < 4} return
2897 if {$downarrow} {
2898 # This line has an arrow at the lower end: check if the arrow is
2899 # on a diagonal segment, and if so, work around the Tk 8.4
2900 # refusal to draw arrows on diagonal lines.
2901 set x0 [lindex $coords 0]
2902 set x1 [lindex $coords 2]
2903 if {$x0 != $x1} {
2904 set y0 [lindex $coords 1]
2905 set y1 [lindex $coords 3]
2906 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2907 # we have a nearby vertical segment, just trim off the diag bit
2908 set coords [lrange $coords 2 end]
2909 } else {
2910 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2911 set xi [expr {$x0 - $slope * $linespc / 2}]
2912 set yi [expr {$y0 - $linespc / 2}]
2913 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2917 set arrow [expr {2 * ($i > 0) + $downarrow}]
2918 set arrow [lindex {none first last both} $arrow]
2919 set t [$canv create line $coords -width [linewidth $id] \
2920 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2921 $canv lower $t
2922 bindline $t $id
2925 proc drawparentlinks {id row col olds} {
2926 global rowidlist canv colormap
2928 set row2 [expr {$row + 1}]
2929 set x [xc $row $col]
2930 set y [yc $row]
2931 set y2 [yc $row2]
2932 set ids [lindex $rowidlist $row2]
2933 # rmx = right-most X coord used
2934 set rmx 0
2935 foreach p $olds {
2936 set i [lsearch -exact $ids $p]
2937 if {$i < 0} {
2938 puts "oops, parent $p of $id not in list"
2939 continue
2941 set x2 [xc $row2 $i]
2942 if {$x2 > $rmx} {
2943 set rmx $x2
2945 set ranges [rowranges $p]
2946 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2947 && $row2 < [lindex $ranges 1]} {
2948 # drawlineseg will do this one for us
2949 continue
2951 assigncolor $p
2952 # should handle duplicated parents here...
2953 set coords [list $x $y]
2954 if {$i < $col - 1} {
2955 lappend coords [xc $row [expr {$i + 1}]] $y
2956 } elseif {$i > $col + 1} {
2957 lappend coords [xc $row [expr {$i - 1}]] $y
2959 lappend coords $x2 $y2
2960 set t [$canv create line $coords -width [linewidth $p] \
2961 -fill $colormap($p) -tags lines.$p]
2962 $canv lower $t
2963 bindline $t $p
2965 return $rmx
2968 proc drawlines {id} {
2969 global colormap canv
2970 global idrangedrawn
2971 global children iddrawn commitrow rowidlist curview
2973 $canv delete lines.$id
2974 set nr [expr {[llength [rowranges $id]] / 2}]
2975 for {set i 0} {$i < $nr} {incr i} {
2976 if {[info exists idrangedrawn($id,$i)]} {
2977 drawlineseg $id $i
2980 foreach child $children($curview,$id) {
2981 if {[info exists iddrawn($child)]} {
2982 set row $commitrow($curview,$child)
2983 set col [lsearch -exact [lindex $rowidlist $row] $child]
2984 if {$col >= 0} {
2985 drawparentlinks $child $row $col [list $id]
2991 proc drawcmittext {id row col rmx} {
2992 global linespc canv canv2 canv3 canvy0 fgcolor
2993 global commitlisted commitinfo rowidlist
2994 global rowtextx idpos idtags idheads idotherrefs
2995 global linehtag linentag linedtag
2996 global mainfont canvxmax boldrows boldnamerows fgcolor
2998 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2999 set x [xc $row $col]
3000 set y [yc $row]
3001 set orad [expr {$linespc / 3}]
3002 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3003 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3004 -fill $ofill -outline $fgcolor -width 1 -tags circle]
3005 $canv raise $t
3006 $canv bind $t <1> {selcanvline {} %x %y}
3007 set xt [xc $row [llength [lindex $rowidlist $row]]]
3008 if {$xt < $rmx} {
3009 set xt $rmx
3011 set rowtextx($row) $xt
3012 set idpos($id) [list $x $xt $y]
3013 if {[info exists idtags($id)] || [info exists idheads($id)]
3014 || [info exists idotherrefs($id)]} {
3015 set xt [drawtags $id $x $xt $y]
3017 set headline [lindex $commitinfo($id) 0]
3018 set name [lindex $commitinfo($id) 1]
3019 set date [lindex $commitinfo($id) 2]
3020 set date [formatdate $date]
3021 set font $mainfont
3022 set nfont $mainfont
3023 set isbold [ishighlighted $row]
3024 if {$isbold > 0} {
3025 lappend boldrows $row
3026 lappend font bold
3027 if {$isbold > 1} {
3028 lappend boldnamerows $row
3029 lappend nfont bold
3032 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3033 -text $headline -font $font -tags text]
3034 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3035 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3036 -text $name -font $nfont -tags text]
3037 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3038 -text $date -font $mainfont -tags text]
3039 set xr [expr {$xt + [font measure $mainfont $headline]}]
3040 if {$xr > $canvxmax} {
3041 set canvxmax $xr
3042 setcanvscroll
3046 proc drawcmitrow {row} {
3047 global displayorder rowidlist
3048 global idrangedrawn iddrawn
3049 global commitinfo parentlist numcommits
3050 global filehighlight fhighlights findstring nhighlights
3051 global hlview vhighlights
3052 global highlight_related rhighlights
3054 if {$row >= $numcommits} return
3055 foreach id [lindex $rowidlist $row] {
3056 if {$id eq {}} continue
3057 set i -1
3058 foreach {s e} [rowranges $id] {
3059 incr i
3060 if {$row < $s} continue
3061 if {$e eq {}} break
3062 if {$row <= $e} {
3063 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3064 drawlineseg $id $i
3065 set idrangedrawn($id,$i) 1
3067 break
3072 set id [lindex $displayorder $row]
3073 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3074 askvhighlight $row $id
3076 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3077 askfilehighlight $row $id
3079 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3080 askfindhighlight $row $id
3082 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3083 askrelhighlight $row $id
3085 if {[info exists iddrawn($id)]} return
3086 set col [lsearch -exact [lindex $rowidlist $row] $id]
3087 if {$col < 0} {
3088 puts "oops, row $row id $id not in list"
3089 return
3091 if {![info exists commitinfo($id)]} {
3092 getcommit $id
3094 assigncolor $id
3095 set olds [lindex $parentlist $row]
3096 if {$olds ne {}} {
3097 set rmx [drawparentlinks $id $row $col $olds]
3098 } else {
3099 set rmx 0
3101 drawcmittext $id $row $col $rmx
3102 set iddrawn($id) 1
3105 proc drawfrac {f0 f1} {
3106 global numcommits canv
3107 global linespc
3109 set ymax [lindex [$canv cget -scrollregion] 3]
3110 if {$ymax eq {} || $ymax == 0} return
3111 set y0 [expr {int($f0 * $ymax)}]
3112 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3113 if {$row < 0} {
3114 set row 0
3116 set y1 [expr {int($f1 * $ymax)}]
3117 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3118 if {$endrow >= $numcommits} {
3119 set endrow [expr {$numcommits - 1}]
3121 for {} {$row <= $endrow} {incr row} {
3122 drawcmitrow $row
3126 proc drawvisible {} {
3127 global canv
3128 eval drawfrac [$canv yview]
3131 proc clear_display {} {
3132 global iddrawn idrangedrawn
3133 global vhighlights fhighlights nhighlights rhighlights
3135 allcanvs delete all
3136 catch {unset iddrawn}
3137 catch {unset idrangedrawn}
3138 catch {unset vhighlights}
3139 catch {unset fhighlights}
3140 catch {unset nhighlights}
3141 catch {unset rhighlights}
3144 proc findcrossings {id} {
3145 global rowidlist parentlist numcommits rowoffsets displayorder
3147 set cross {}
3148 set ccross {}
3149 foreach {s e} [rowranges $id] {
3150 if {$e >= $numcommits} {
3151 set e [expr {$numcommits - 1}]
3153 if {$e <= $s} continue
3154 set x [lsearch -exact [lindex $rowidlist $e] $id]
3155 if {$x < 0} {
3156 puts "findcrossings: oops, no [shortids $id] in row $e"
3157 continue
3159 for {set row $e} {[incr row -1] >= $s} {} {
3160 set olds [lindex $parentlist $row]
3161 set kid [lindex $displayorder $row]
3162 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3163 if {$kidx < 0} continue
3164 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3165 foreach p $olds {
3166 set px [lsearch -exact $nextrow $p]
3167 if {$px < 0} continue
3168 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3169 if {[lsearch -exact $ccross $p] >= 0} continue
3170 if {$x == $px + ($kidx < $px? -1: 1)} {
3171 lappend ccross $p
3172 } elseif {[lsearch -exact $cross $p] < 0} {
3173 lappend cross $p
3177 set inc [lindex $rowoffsets $row $x]
3178 if {$inc eq {}} break
3179 incr x $inc
3182 return [concat $ccross {{}} $cross]
3185 proc assigncolor {id} {
3186 global colormap colors nextcolor
3187 global commitrow parentlist children children curview
3189 if {[info exists colormap($id)]} return
3190 set ncolors [llength $colors]
3191 if {[info exists children($curview,$id)]} {
3192 set kids $children($curview,$id)
3193 } else {
3194 set kids {}
3196 if {[llength $kids] == 1} {
3197 set child [lindex $kids 0]
3198 if {[info exists colormap($child)]
3199 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3200 set colormap($id) $colormap($child)
3201 return
3204 set badcolors {}
3205 set origbad {}
3206 foreach x [findcrossings $id] {
3207 if {$x eq {}} {
3208 # delimiter between corner crossings and other crossings
3209 if {[llength $badcolors] >= $ncolors - 1} break
3210 set origbad $badcolors
3212 if {[info exists colormap($x)]
3213 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3214 lappend badcolors $colormap($x)
3217 if {[llength $badcolors] >= $ncolors} {
3218 set badcolors $origbad
3220 set origbad $badcolors
3221 if {[llength $badcolors] < $ncolors - 1} {
3222 foreach child $kids {
3223 if {[info exists colormap($child)]
3224 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3225 lappend badcolors $colormap($child)
3227 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3228 if {[info exists colormap($p)]
3229 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3230 lappend badcolors $colormap($p)
3234 if {[llength $badcolors] >= $ncolors} {
3235 set badcolors $origbad
3238 for {set i 0} {$i <= $ncolors} {incr i} {
3239 set c [lindex $colors $nextcolor]
3240 if {[incr nextcolor] >= $ncolors} {
3241 set nextcolor 0
3243 if {[lsearch -exact $badcolors $c]} break
3245 set colormap($id) $c
3248 proc bindline {t id} {
3249 global canv
3251 $canv bind $t <Enter> "lineenter %x %y $id"
3252 $canv bind $t <Motion> "linemotion %x %y $id"
3253 $canv bind $t <Leave> "lineleave $id"
3254 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3257 proc drawtags {id x xt y1} {
3258 global idtags idheads idotherrefs mainhead
3259 global linespc lthickness
3260 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3262 set marks {}
3263 set ntags 0
3264 set nheads 0
3265 if {[info exists idtags($id)]} {
3266 set marks $idtags($id)
3267 set ntags [llength $marks]
3269 if {[info exists idheads($id)]} {
3270 set marks [concat $marks $idheads($id)]
3271 set nheads [llength $idheads($id)]
3273 if {[info exists idotherrefs($id)]} {
3274 set marks [concat $marks $idotherrefs($id)]
3276 if {$marks eq {}} {
3277 return $xt
3280 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3281 set yt [expr {$y1 - 0.5 * $linespc}]
3282 set yb [expr {$yt + $linespc - 1}]
3283 set xvals {}
3284 set wvals {}
3285 set i -1
3286 foreach tag $marks {
3287 incr i
3288 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3289 set wid [font measure [concat $mainfont bold] $tag]
3290 } else {
3291 set wid [font measure $mainfont $tag]
3293 lappend xvals $xt
3294 lappend wvals $wid
3295 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3297 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3298 -width $lthickness -fill black -tags tag.$id]
3299 $canv lower $t
3300 foreach tag $marks x $xvals wid $wvals {
3301 set xl [expr {$x + $delta}]
3302 set xr [expr {$x + $delta + $wid + $lthickness}]
3303 set font $mainfont
3304 if {[incr ntags -1] >= 0} {
3305 # draw a tag
3306 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3307 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3308 -width 1 -outline black -fill yellow -tags tag.$id]
3309 $canv bind $t <1> [list showtag $tag 1]
3310 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3311 } else {
3312 # draw a head or other ref
3313 if {[incr nheads -1] >= 0} {
3314 set col green
3315 if {$tag eq $mainhead} {
3316 lappend font bold
3318 } else {
3319 set col "#ddddff"
3321 set xl [expr {$xl - $delta/2}]
3322 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3323 -width 1 -outline black -fill $col -tags tag.$id
3324 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3325 set rwid [font measure $mainfont $remoteprefix]
3326 set xi [expr {$x + 1}]
3327 set yti [expr {$yt + 1}]
3328 set xri [expr {$x + $rwid}]
3329 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3330 -width 0 -fill "#ffddaa" -tags tag.$id
3333 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3334 -font $font -tags [list tag.$id text]]
3335 if {$ntags >= 0} {
3336 $canv bind $t <1> [list showtag $tag 1]
3337 } elseif {$nheads >= 0} {
3338 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3341 return $xt
3344 proc xcoord {i level ln} {
3345 global canvx0 xspc1 xspc2
3347 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3348 if {$i > 0 && $i == $level} {
3349 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3350 } elseif {$i > $level} {
3351 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3353 return $x
3356 proc show_status {msg} {
3357 global canv mainfont fgcolor
3359 clear_display
3360 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3361 -tags text -fill $fgcolor
3364 proc finishcommits {} {
3365 global commitidx phase curview
3366 global pending_select
3368 if {$commitidx($curview) > 0} {
3369 drawrest
3370 } else {
3371 show_status "No commits selected"
3373 set phase {}
3374 catch {unset pending_select}
3377 # Insert a new commit as the child of the commit on row $row.
3378 # The new commit will be displayed on row $row and the commits
3379 # on that row and below will move down one row.
3380 proc insertrow {row newcmit} {
3381 global displayorder parentlist childlist commitlisted
3382 global commitrow curview rowidlist rowoffsets numcommits
3383 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3384 global linesegends selectedline
3386 if {$row >= $numcommits} {
3387 puts "oops, inserting new row $row but only have $numcommits rows"
3388 return
3390 set p [lindex $displayorder $row]
3391 set displayorder [linsert $displayorder $row $newcmit]
3392 set parentlist [linsert $parentlist $row $p]
3393 set kids [lindex $childlist $row]
3394 lappend kids $newcmit
3395 lset childlist $row $kids
3396 set childlist [linsert $childlist $row {}]
3397 set commitlisted [linsert $commitlisted $row 1]
3398 set l [llength $displayorder]
3399 for {set r $row} {$r < $l} {incr r} {
3400 set id [lindex $displayorder $r]
3401 set commitrow($curview,$id) $r
3404 set idlist [lindex $rowidlist $row]
3405 set offs [lindex $rowoffsets $row]
3406 set newoffs {}
3407 foreach x $idlist {
3408 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3409 lappend newoffs {}
3410 } else {
3411 lappend newoffs 0
3414 if {[llength $kids] == 1} {
3415 set col [lsearch -exact $idlist $p]
3416 lset idlist $col $newcmit
3417 } else {
3418 set col [llength $idlist]
3419 lappend idlist $newcmit
3420 lappend offs {}
3421 lset rowoffsets $row $offs
3423 set rowidlist [linsert $rowidlist $row $idlist]
3424 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3426 set rowrangelist [linsert $rowrangelist $row {}]
3427 set l [llength $rowrangelist]
3428 for {set r 0} {$r < $l} {incr r} {
3429 set ranges [lindex $rowrangelist $r]
3430 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3431 set newranges {}
3432 foreach x $ranges {
3433 if {$x >= $row} {
3434 lappend newranges [expr {$x + 1}]
3435 } else {
3436 lappend newranges $x
3439 lset rowrangelist $r $newranges
3442 if {[llength $kids] > 1} {
3443 set rp1 [expr {$row + 1}]
3444 set ranges [lindex $rowrangelist $rp1]
3445 if {$ranges eq {}} {
3446 set ranges [list $row $rp1]
3447 } elseif {[lindex $ranges end-1] == $rp1} {
3448 lset ranges end-1 $row
3450 lset rowrangelist $rp1 $ranges
3452 foreach id [array names idrowranges] {
3453 set ranges $idrowranges($id)
3454 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3455 set newranges {}
3456 foreach x $ranges {
3457 if {$x >= $row} {
3458 lappend newranges [expr {$x + 1}]
3459 } else {
3460 lappend newranges $x
3463 set idrowranges($id) $newranges
3467 set linesegends [linsert $linesegends $row {}]
3469 incr rowlaidout
3470 incr rowoptim
3471 incr numcommits
3473 if {[info exists selectedline] && $selectedline >= $row} {
3474 incr selectedline
3476 redisplay
3479 # Don't change the text pane cursor if it is currently the hand cursor,
3480 # showing that we are over a sha1 ID link.
3481 proc settextcursor {c} {
3482 global ctext curtextcursor
3484 if {[$ctext cget -cursor] == $curtextcursor} {
3485 $ctext config -cursor $c
3487 set curtextcursor $c
3490 proc nowbusy {what} {
3491 global isbusy
3493 if {[array names isbusy] eq {}} {
3494 . config -cursor watch
3495 settextcursor watch
3497 set isbusy($what) 1
3500 proc notbusy {what} {
3501 global isbusy maincursor textcursor
3503 catch {unset isbusy($what)}
3504 if {[array names isbusy] eq {}} {
3505 . config -cursor $maincursor
3506 settextcursor $textcursor
3510 proc drawrest {} {
3511 global startmsecs
3512 global rowlaidout commitidx curview
3513 global pending_select
3515 set row $rowlaidout
3516 layoutrows $rowlaidout $commitidx($curview) 1
3517 layouttail
3518 optimize_rows $row 0 $commitidx($curview)
3519 showstuff $commitidx($curview)
3520 if {[info exists pending_select]} {
3521 selectline 0 1
3524 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3525 #global numcommits
3526 #puts "overall $drawmsecs ms for $numcommits commits"
3529 proc findmatches {f} {
3530 global findtype foundstring foundstrlen
3531 if {$findtype == "Regexp"} {
3532 set matches [regexp -indices -all -inline $foundstring $f]
3533 } else {
3534 if {$findtype == "IgnCase"} {
3535 set str [string tolower $f]
3536 } else {
3537 set str $f
3539 set matches {}
3540 set i 0
3541 while {[set j [string first $foundstring $str $i]] >= 0} {
3542 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3543 set i [expr {$j + $foundstrlen}]
3546 return $matches
3549 proc dofind {} {
3550 global findtype findloc findstring markedmatches commitinfo
3551 global numcommits displayorder linehtag linentag linedtag
3552 global mainfont canv canv2 canv3 selectedline
3553 global matchinglines foundstring foundstrlen matchstring
3554 global commitdata
3556 stopfindproc
3557 unmarkmatches
3558 cancel_next_highlight
3559 focus .
3560 set matchinglines {}
3561 if {$findtype == "IgnCase"} {
3562 set foundstring [string tolower $findstring]
3563 } else {
3564 set foundstring $findstring
3566 set foundstrlen [string length $findstring]
3567 if {$foundstrlen == 0} return
3568 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3569 set matchstring "*$matchstring*"
3570 if {![info exists selectedline]} {
3571 set oldsel -1
3572 } else {
3573 set oldsel $selectedline
3575 set didsel 0
3576 set fldtypes {Headline Author Date Committer CDate Comments}
3577 set l -1
3578 foreach id $displayorder {
3579 set d $commitdata($id)
3580 incr l
3581 if {$findtype == "Regexp"} {
3582 set doesmatch [regexp $foundstring $d]
3583 } elseif {$findtype == "IgnCase"} {
3584 set doesmatch [string match -nocase $matchstring $d]
3585 } else {
3586 set doesmatch [string match $matchstring $d]
3588 if {!$doesmatch} continue
3589 if {![info exists commitinfo($id)]} {
3590 getcommit $id
3592 set info $commitinfo($id)
3593 set doesmatch 0
3594 foreach f $info ty $fldtypes {
3595 if {$findloc != "All fields" && $findloc != $ty} {
3596 continue
3598 set matches [findmatches $f]
3599 if {$matches == {}} continue
3600 set doesmatch 1
3601 if {$ty == "Headline"} {
3602 drawcmitrow $l
3603 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3604 } elseif {$ty == "Author"} {
3605 drawcmitrow $l
3606 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3607 } elseif {$ty == "Date"} {
3608 drawcmitrow $l
3609 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3612 if {$doesmatch} {
3613 lappend matchinglines $l
3614 if {!$didsel && $l > $oldsel} {
3615 findselectline $l
3616 set didsel 1
3620 if {$matchinglines == {}} {
3621 bell
3622 } elseif {!$didsel} {
3623 findselectline [lindex $matchinglines 0]
3627 proc findselectline {l} {
3628 global findloc commentend ctext
3629 selectline $l 1
3630 if {$findloc == "All fields" || $findloc == "Comments"} {
3631 # highlight the matches in the comments
3632 set f [$ctext get 1.0 $commentend]
3633 set matches [findmatches $f]
3634 foreach match $matches {
3635 set start [lindex $match 0]
3636 set end [expr {[lindex $match 1] + 1}]
3637 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3642 proc findnext {restart} {
3643 global matchinglines selectedline
3644 if {![info exists matchinglines]} {
3645 if {$restart} {
3646 dofind
3648 return
3650 if {![info exists selectedline]} return
3651 foreach l $matchinglines {
3652 if {$l > $selectedline} {
3653 findselectline $l
3654 return
3657 bell
3660 proc findprev {} {
3661 global matchinglines selectedline
3662 if {![info exists matchinglines]} {
3663 dofind
3664 return
3666 if {![info exists selectedline]} return
3667 set prev {}
3668 foreach l $matchinglines {
3669 if {$l >= $selectedline} break
3670 set prev $l
3672 if {$prev != {}} {
3673 findselectline $prev
3674 } else {
3675 bell
3679 proc stopfindproc {{done 0}} {
3680 global findprocpid findprocfile findids
3681 global ctext findoldcursor phase maincursor textcursor
3682 global findinprogress
3684 catch {unset findids}
3685 if {[info exists findprocpid]} {
3686 if {!$done} {
3687 catch {exec kill $findprocpid}
3689 catch {close $findprocfile}
3690 unset findprocpid
3692 catch {unset findinprogress}
3693 notbusy find
3696 # mark a commit as matching by putting a yellow background
3697 # behind the headline
3698 proc markheadline {l id} {
3699 global canv mainfont linehtag
3701 drawcmitrow $l
3702 set bbox [$canv bbox $linehtag($l)]
3703 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3704 $canv lower $t
3707 # mark the bits of a headline, author or date that match a find string
3708 proc markmatches {canv l str tag matches font} {
3709 set bbox [$canv bbox $tag]
3710 set x0 [lindex $bbox 0]
3711 set y0 [lindex $bbox 1]
3712 set y1 [lindex $bbox 3]
3713 foreach match $matches {
3714 set start [lindex $match 0]
3715 set end [lindex $match 1]
3716 if {$start > $end} continue
3717 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3718 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3719 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3720 [expr {$x0+$xlen+2}] $y1 \
3721 -outline {} -tags matches -fill yellow]
3722 $canv lower $t
3726 proc unmarkmatches {} {
3727 global matchinglines findids
3728 allcanvs delete matches
3729 catch {unset matchinglines}
3730 catch {unset findids}
3733 proc selcanvline {w x y} {
3734 global canv canvy0 ctext linespc
3735 global rowtextx
3736 set ymax [lindex [$canv cget -scrollregion] 3]
3737 if {$ymax == {}} return
3738 set yfrac [lindex [$canv yview] 0]
3739 set y [expr {$y + $yfrac * $ymax}]
3740 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3741 if {$l < 0} {
3742 set l 0
3744 if {$w eq $canv} {
3745 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3747 unmarkmatches
3748 selectline $l 1
3751 proc commit_descriptor {p} {
3752 global commitinfo
3753 if {![info exists commitinfo($p)]} {
3754 getcommit $p
3756 set l "..."
3757 if {[llength $commitinfo($p)] > 1} {
3758 set l [lindex $commitinfo($p) 0]
3760 return "$p ($l)\n"
3763 # append some text to the ctext widget, and make any SHA1 ID
3764 # that we know about be a clickable link.
3765 proc appendwithlinks {text tags} {
3766 global ctext commitrow linknum curview
3768 set start [$ctext index "end - 1c"]
3769 $ctext insert end $text $tags
3770 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3771 foreach l $links {
3772 set s [lindex $l 0]
3773 set e [lindex $l 1]
3774 set linkid [string range $text $s $e]
3775 if {![info exists commitrow($curview,$linkid)]} continue
3776 incr e
3777 $ctext tag add link "$start + $s c" "$start + $e c"
3778 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3779 $ctext tag bind link$linknum <1> \
3780 [list selectline $commitrow($curview,$linkid) 1]
3781 incr linknum
3783 $ctext tag conf link -foreground blue -underline 1
3784 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3785 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3788 proc viewnextline {dir} {
3789 global canv linespc
3791 $canv delete hover
3792 set ymax [lindex [$canv cget -scrollregion] 3]
3793 set wnow [$canv yview]
3794 set wtop [expr {[lindex $wnow 0] * $ymax}]
3795 set newtop [expr {$wtop + $dir * $linespc}]
3796 if {$newtop < 0} {
3797 set newtop 0
3798 } elseif {$newtop > $ymax} {
3799 set newtop $ymax
3801 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3804 # add a list of tag or branch names at position pos
3805 # returns the number of names inserted
3806 proc appendrefs {pos tags var} {
3807 global ctext commitrow linknum curview $var
3809 if {[catch {$ctext index $pos}]} {
3810 return 0
3812 set tags [lsort $tags]
3813 set sep {}
3814 foreach tag $tags {
3815 set id [set $var\($tag\)]
3816 set lk link$linknum
3817 incr linknum
3818 $ctext insert $pos $sep
3819 $ctext insert $pos $tag $lk
3820 $ctext tag conf $lk -foreground blue
3821 if {[info exists commitrow($curview,$id)]} {
3822 $ctext tag bind $lk <1> \
3823 [list selectline $commitrow($curview,$id) 1]
3824 $ctext tag conf $lk -underline 1
3825 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3826 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3828 set sep ", "
3830 return [llength $tags]
3833 proc taglist {ids} {
3834 global idtags
3836 set tags {}
3837 foreach id $ids {
3838 foreach tag $idtags($id) {
3839 lappend tags $tag
3842 return $tags
3845 # called when we have finished computing the nearby tags
3846 proc dispneartags {} {
3847 global selectedline currentid ctext anc_tags desc_tags showneartags
3848 global desc_heads
3850 if {![info exists selectedline] || !$showneartags} return
3851 set id $currentid
3852 $ctext conf -state normal
3853 if {[info exists desc_heads($id)]} {
3854 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3855 $ctext insert "branch -2c" "es"
3858 if {[info exists anc_tags($id)]} {
3859 appendrefs follows [taglist $anc_tags($id)] tagids
3861 if {[info exists desc_tags($id)]} {
3862 appendrefs precedes [taglist $desc_tags($id)] tagids
3864 $ctext conf -state disabled
3867 proc selectline {l isnew} {
3868 global canv canv2 canv3 ctext commitinfo selectedline
3869 global displayorder linehtag linentag linedtag
3870 global canvy0 linespc parentlist childlist
3871 global currentid sha1entry
3872 global commentend idtags linknum
3873 global mergemax numcommits pending_select
3874 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3876 catch {unset pending_select}
3877 $canv delete hover
3878 normalline
3879 cancel_next_highlight
3880 if {$l < 0 || $l >= $numcommits} return
3881 set y [expr {$canvy0 + $l * $linespc}]
3882 set ymax [lindex [$canv cget -scrollregion] 3]
3883 set ytop [expr {$y - $linespc - 1}]
3884 set ybot [expr {$y + $linespc + 1}]
3885 set wnow [$canv yview]
3886 set wtop [expr {[lindex $wnow 0] * $ymax}]
3887 set wbot [expr {[lindex $wnow 1] * $ymax}]
3888 set wh [expr {$wbot - $wtop}]
3889 set newtop $wtop
3890 if {$ytop < $wtop} {
3891 if {$ybot < $wtop} {
3892 set newtop [expr {$y - $wh / 2.0}]
3893 } else {
3894 set newtop $ytop
3895 if {$newtop > $wtop - $linespc} {
3896 set newtop [expr {$wtop - $linespc}]
3899 } elseif {$ybot > $wbot} {
3900 if {$ytop > $wbot} {
3901 set newtop [expr {$y - $wh / 2.0}]
3902 } else {
3903 set newtop [expr {$ybot - $wh}]
3904 if {$newtop < $wtop + $linespc} {
3905 set newtop [expr {$wtop + $linespc}]
3909 if {$newtop != $wtop} {
3910 if {$newtop < 0} {
3911 set newtop 0
3913 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3914 drawvisible
3917 if {![info exists linehtag($l)]} return
3918 $canv delete secsel
3919 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3920 -tags secsel -fill [$canv cget -selectbackground]]
3921 $canv lower $t
3922 $canv2 delete secsel
3923 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3924 -tags secsel -fill [$canv2 cget -selectbackground]]
3925 $canv2 lower $t
3926 $canv3 delete secsel
3927 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3928 -tags secsel -fill [$canv3 cget -selectbackground]]
3929 $canv3 lower $t
3931 if {$isnew} {
3932 addtohistory [list selectline $l 0]
3935 set selectedline $l
3937 set id [lindex $displayorder $l]
3938 set currentid $id
3939 $sha1entry delete 0 end
3940 $sha1entry insert 0 $id
3941 $sha1entry selection from 0
3942 $sha1entry selection to end
3943 rhighlight_sel $id
3945 $ctext conf -state normal
3946 clear_ctext
3947 set linknum 0
3948 set info $commitinfo($id)
3949 set date [formatdate [lindex $info 2]]
3950 $ctext insert end "Author: [lindex $info 1] $date\n"
3951 set date [formatdate [lindex $info 4]]
3952 $ctext insert end "Committer: [lindex $info 3] $date\n"
3953 if {[info exists idtags($id)]} {
3954 $ctext insert end "Tags:"
3955 foreach tag $idtags($id) {
3956 $ctext insert end " $tag"
3958 $ctext insert end "\n"
3961 set headers {}
3962 set olds [lindex $parentlist $l]
3963 if {[llength $olds] > 1} {
3964 set np 0
3965 foreach p $olds {
3966 if {$np >= $mergemax} {
3967 set tag mmax
3968 } else {
3969 set tag m$np
3971 $ctext insert end "Parent: " $tag
3972 appendwithlinks [commit_descriptor $p] {}
3973 incr np
3975 } else {
3976 foreach p $olds {
3977 append headers "Parent: [commit_descriptor $p]"
3981 foreach c [lindex $childlist $l] {
3982 append headers "Child: [commit_descriptor $c]"
3985 # make anything that looks like a SHA1 ID be a clickable link
3986 appendwithlinks $headers {}
3987 if {$showneartags} {
3988 if {![info exists allcommits]} {
3989 getallcommits
3991 $ctext insert end "Branch: "
3992 $ctext mark set branch "end -1c"
3993 $ctext mark gravity branch left
3994 if {[info exists desc_heads($id)]} {
3995 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3996 # turn "Branch" into "Branches"
3997 $ctext insert "branch -2c" "es"
4000 $ctext insert end "\nFollows: "
4001 $ctext mark set follows "end -1c"
4002 $ctext mark gravity follows left
4003 if {[info exists anc_tags($id)]} {
4004 appendrefs follows [taglist $anc_tags($id)] tagids
4006 $ctext insert end "\nPrecedes: "
4007 $ctext mark set precedes "end -1c"
4008 $ctext mark gravity precedes left
4009 if {[info exists desc_tags($id)]} {
4010 appendrefs precedes [taglist $desc_tags($id)] tagids
4012 $ctext insert end "\n"
4014 $ctext insert end "\n"
4015 appendwithlinks [lindex $info 5] {comment}
4017 $ctext tag delete Comments
4018 $ctext tag remove found 1.0 end
4019 $ctext conf -state disabled
4020 set commentend [$ctext index "end - 1c"]
4022 init_flist "Comments"
4023 if {$cmitmode eq "tree"} {
4024 gettree $id
4025 } elseif {[llength $olds] <= 1} {
4026 startdiff $id
4027 } else {
4028 mergediff $id $l
4032 proc selfirstline {} {
4033 unmarkmatches
4034 selectline 0 1
4037 proc sellastline {} {
4038 global numcommits
4039 unmarkmatches
4040 set l [expr {$numcommits - 1}]
4041 selectline $l 1
4044 proc selnextline {dir} {
4045 global selectedline
4046 if {![info exists selectedline]} return
4047 set l [expr {$selectedline + $dir}]
4048 unmarkmatches
4049 selectline $l 1
4052 proc selnextpage {dir} {
4053 global canv linespc selectedline numcommits
4055 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4056 if {$lpp < 1} {
4057 set lpp 1
4059 allcanvs yview scroll [expr {$dir * $lpp}] units
4060 drawvisible
4061 if {![info exists selectedline]} return
4062 set l [expr {$selectedline + $dir * $lpp}]
4063 if {$l < 0} {
4064 set l 0
4065 } elseif {$l >= $numcommits} {
4066 set l [expr $numcommits - 1]
4068 unmarkmatches
4069 selectline $l 1
4072 proc unselectline {} {
4073 global selectedline currentid
4075 catch {unset selectedline}
4076 catch {unset currentid}
4077 allcanvs delete secsel
4078 rhighlight_none
4079 cancel_next_highlight
4082 proc reselectline {} {
4083 global selectedline
4085 if {[info exists selectedline]} {
4086 selectline $selectedline 0
4090 proc addtohistory {cmd} {
4091 global history historyindex curview
4093 set elt [list $curview $cmd]
4094 if {$historyindex > 0
4095 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4096 return
4099 if {$historyindex < [llength $history]} {
4100 set history [lreplace $history $historyindex end $elt]
4101 } else {
4102 lappend history $elt
4104 incr historyindex
4105 if {$historyindex > 1} {
4106 .tf.bar.leftbut conf -state normal
4107 } else {
4108 .tf.bar.leftbut conf -state disabled
4110 .tf.bar.rightbut conf -state disabled
4113 proc godo {elt} {
4114 global curview
4116 set view [lindex $elt 0]
4117 set cmd [lindex $elt 1]
4118 if {$curview != $view} {
4119 showview $view
4121 eval $cmd
4124 proc goback {} {
4125 global history historyindex
4127 if {$historyindex > 1} {
4128 incr historyindex -1
4129 godo [lindex $history [expr {$historyindex - 1}]]
4130 .tf.bar.rightbut conf -state normal
4132 if {$historyindex <= 1} {
4133 .tf.bar.leftbut conf -state disabled
4137 proc goforw {} {
4138 global history historyindex
4140 if {$historyindex < [llength $history]} {
4141 set cmd [lindex $history $historyindex]
4142 incr historyindex
4143 godo $cmd
4144 .tf.bar.leftbut conf -state normal
4146 if {$historyindex >= [llength $history]} {
4147 .tf.bar.rightbut conf -state disabled
4151 proc gettree {id} {
4152 global treefilelist treeidlist diffids diffmergeid treepending
4154 set diffids $id
4155 catch {unset diffmergeid}
4156 if {![info exists treefilelist($id)]} {
4157 if {![info exists treepending]} {
4158 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4159 return
4161 set treepending $id
4162 set treefilelist($id) {}
4163 set treeidlist($id) {}
4164 fconfigure $gtf -blocking 0
4165 fileevent $gtf readable [list gettreeline $gtf $id]
4167 } else {
4168 setfilelist $id
4172 proc gettreeline {gtf id} {
4173 global treefilelist treeidlist treepending cmitmode diffids
4175 while {[gets $gtf line] >= 0} {
4176 if {[lindex $line 1] ne "blob"} continue
4177 set sha1 [lindex $line 2]
4178 set fname [lindex $line 3]
4179 lappend treefilelist($id) $fname
4180 lappend treeidlist($id) $sha1
4182 if {![eof $gtf]} return
4183 close $gtf
4184 unset treepending
4185 if {$cmitmode ne "tree"} {
4186 if {![info exists diffmergeid]} {
4187 gettreediffs $diffids
4189 } elseif {$id ne $diffids} {
4190 gettree $diffids
4191 } else {
4192 setfilelist $id
4196 proc showfile {f} {
4197 global treefilelist treeidlist diffids
4198 global ctext commentend
4200 set i [lsearch -exact $treefilelist($diffids) $f]
4201 if {$i < 0} {
4202 puts "oops, $f not in list for id $diffids"
4203 return
4205 set blob [lindex $treeidlist($diffids) $i]
4206 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4207 puts "oops, error reading blob $blob: $err"
4208 return
4210 fconfigure $bf -blocking 0
4211 fileevent $bf readable [list getblobline $bf $diffids]
4212 $ctext config -state normal
4213 clear_ctext $commentend
4214 $ctext insert end "\n"
4215 $ctext insert end "$f\n" filesep
4216 $ctext config -state disabled
4217 $ctext yview $commentend
4220 proc getblobline {bf id} {
4221 global diffids cmitmode ctext
4223 if {$id ne $diffids || $cmitmode ne "tree"} {
4224 catch {close $bf}
4225 return
4227 $ctext config -state normal
4228 while {[gets $bf line] >= 0} {
4229 $ctext insert end "$line\n"
4231 if {[eof $bf]} {
4232 # delete last newline
4233 $ctext delete "end - 2c" "end - 1c"
4234 close $bf
4236 $ctext config -state disabled
4239 proc mergediff {id l} {
4240 global diffmergeid diffopts mdifffd
4241 global diffids
4242 global parentlist
4244 set diffmergeid $id
4245 set diffids $id
4246 # this doesn't seem to actually affect anything...
4247 set env(GIT_DIFF_OPTS) $diffopts
4248 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4249 if {[catch {set mdf [open $cmd r]} err]} {
4250 error_popup "Error getting merge diffs: $err"
4251 return
4253 fconfigure $mdf -blocking 0
4254 set mdifffd($id) $mdf
4255 set np [llength [lindex $parentlist $l]]
4256 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4257 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4260 proc getmergediffline {mdf id np} {
4261 global diffmergeid ctext cflist nextupdate mergemax
4262 global difffilestart mdifffd
4264 set n [gets $mdf line]
4265 if {$n < 0} {
4266 if {[eof $mdf]} {
4267 close $mdf
4269 return
4271 if {![info exists diffmergeid] || $id != $diffmergeid
4272 || $mdf != $mdifffd($id)} {
4273 return
4275 $ctext conf -state normal
4276 if {[regexp {^diff --cc (.*)} $line match fname]} {
4277 # start of a new file
4278 $ctext insert end "\n"
4279 set here [$ctext index "end - 1c"]
4280 lappend difffilestart $here
4281 add_flist [list $fname]
4282 set l [expr {(78 - [string length $fname]) / 2}]
4283 set pad [string range "----------------------------------------" 1 $l]
4284 $ctext insert end "$pad $fname $pad\n" filesep
4285 } elseif {[regexp {^@@} $line]} {
4286 $ctext insert end "$line\n" hunksep
4287 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4288 # do nothing
4289 } else {
4290 # parse the prefix - one ' ', '-' or '+' for each parent
4291 set spaces {}
4292 set minuses {}
4293 set pluses {}
4294 set isbad 0
4295 for {set j 0} {$j < $np} {incr j} {
4296 set c [string range $line $j $j]
4297 if {$c == " "} {
4298 lappend spaces $j
4299 } elseif {$c == "-"} {
4300 lappend minuses $j
4301 } elseif {$c == "+"} {
4302 lappend pluses $j
4303 } else {
4304 set isbad 1
4305 break
4308 set tags {}
4309 set num {}
4310 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4311 # line doesn't appear in result, parents in $minuses have the line
4312 set num [lindex $minuses 0]
4313 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4314 # line appears in result, parents in $pluses don't have the line
4315 lappend tags mresult
4316 set num [lindex $spaces 0]
4318 if {$num ne {}} {
4319 if {$num >= $mergemax} {
4320 set num "max"
4322 lappend tags m$num
4324 $ctext insert end "$line\n" $tags
4326 $ctext conf -state disabled
4327 if {[clock clicks -milliseconds] >= $nextupdate} {
4328 incr nextupdate 100
4329 fileevent $mdf readable {}
4330 update
4331 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4335 proc startdiff {ids} {
4336 global treediffs diffids treepending diffmergeid
4338 set diffids $ids
4339 catch {unset diffmergeid}
4340 if {![info exists treediffs($ids)]} {
4341 if {![info exists treepending]} {
4342 gettreediffs $ids
4344 } else {
4345 addtocflist $ids
4349 proc addtocflist {ids} {
4350 global treediffs cflist
4351 add_flist $treediffs($ids)
4352 getblobdiffs $ids
4355 proc gettreediffs {ids} {
4356 global treediff treepending
4357 set treepending $ids
4358 set treediff {}
4359 if {[catch \
4360 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4361 ]} return
4362 fconfigure $gdtf -blocking 0
4363 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4366 proc gettreediffline {gdtf ids} {
4367 global treediff treediffs treepending diffids diffmergeid
4368 global cmitmode
4370 set n [gets $gdtf line]
4371 if {$n < 0} {
4372 if {![eof $gdtf]} return
4373 close $gdtf
4374 set treediffs($ids) $treediff
4375 unset treepending
4376 if {$cmitmode eq "tree"} {
4377 gettree $diffids
4378 } elseif {$ids != $diffids} {
4379 if {![info exists diffmergeid]} {
4380 gettreediffs $diffids
4382 } else {
4383 addtocflist $ids
4385 return
4387 set file [lindex $line 5]
4388 lappend treediff $file
4391 proc getblobdiffs {ids} {
4392 global diffopts blobdifffd diffids env curdifftag curtagstart
4393 global nextupdate diffinhdr treediffs
4395 set env(GIT_DIFF_OPTS) $diffopts
4396 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4397 if {[catch {set bdf [open $cmd r]} err]} {
4398 puts "error getting diffs: $err"
4399 return
4401 set diffinhdr 0
4402 fconfigure $bdf -blocking 0
4403 set blobdifffd($ids) $bdf
4404 set curdifftag Comments
4405 set curtagstart 0.0
4406 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4407 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4410 proc setinlist {var i val} {
4411 global $var
4413 while {[llength [set $var]] < $i} {
4414 lappend $var {}
4416 if {[llength [set $var]] == $i} {
4417 lappend $var $val
4418 } else {
4419 lset $var $i $val
4423 proc getblobdiffline {bdf ids} {
4424 global diffids blobdifffd ctext curdifftag curtagstart
4425 global diffnexthead diffnextnote difffilestart
4426 global nextupdate diffinhdr treediffs
4428 set n [gets $bdf line]
4429 if {$n < 0} {
4430 if {[eof $bdf]} {
4431 close $bdf
4432 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4433 $ctext tag add $curdifftag $curtagstart end
4436 return
4438 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4439 return
4441 $ctext conf -state normal
4442 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4443 # start of a new file
4444 $ctext insert end "\n"
4445 $ctext tag add $curdifftag $curtagstart end
4446 set here [$ctext index "end - 1c"]
4447 set curtagstart $here
4448 set header $newname
4449 set i [lsearch -exact $treediffs($ids) $fname]
4450 if {$i >= 0} {
4451 setinlist difffilestart $i $here
4453 if {$newname ne $fname} {
4454 set i [lsearch -exact $treediffs($ids) $newname]
4455 if {$i >= 0} {
4456 setinlist difffilestart $i $here
4459 set curdifftag "f:$fname"
4460 $ctext tag delete $curdifftag
4461 set l [expr {(78 - [string length $header]) / 2}]
4462 set pad [string range "----------------------------------------" 1 $l]
4463 $ctext insert end "$pad $header $pad\n" filesep
4464 set diffinhdr 1
4465 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4466 # do nothing
4467 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4468 set diffinhdr 0
4469 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4470 $line match f1l f1c f2l f2c rest]} {
4471 $ctext insert end "$line\n" hunksep
4472 set diffinhdr 0
4473 } else {
4474 set x [string range $line 0 0]
4475 if {$x == "-" || $x == "+"} {
4476 set tag [expr {$x == "+"}]
4477 $ctext insert end "$line\n" d$tag
4478 } elseif {$x == " "} {
4479 $ctext insert end "$line\n"
4480 } elseif {$diffinhdr || $x == "\\"} {
4481 # e.g. "\ No newline at end of file"
4482 $ctext insert end "$line\n" filesep
4483 } else {
4484 # Something else we don't recognize
4485 if {$curdifftag != "Comments"} {
4486 $ctext insert end "\n"
4487 $ctext tag add $curdifftag $curtagstart end
4488 set curtagstart [$ctext index "end - 1c"]
4489 set curdifftag Comments
4491 $ctext insert end "$line\n" filesep
4494 $ctext conf -state disabled
4495 if {[clock clicks -milliseconds] >= $nextupdate} {
4496 incr nextupdate 100
4497 fileevent $bdf readable {}
4498 update
4499 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4503 proc changediffdisp {} {
4504 global ctext diffelide
4506 $ctext tag conf d0 -elide [lindex $diffelide 0]
4507 $ctext tag conf d1 -elide [lindex $diffelide 1]
4510 proc prevfile {} {
4511 global difffilestart ctext
4512 set prev [lindex $difffilestart 0]
4513 set here [$ctext index @0,0]
4514 foreach loc $difffilestart {
4515 if {[$ctext compare $loc >= $here]} {
4516 $ctext yview $prev
4517 return
4519 set prev $loc
4521 $ctext yview $prev
4524 proc nextfile {} {
4525 global difffilestart ctext
4526 set here [$ctext index @0,0]
4527 foreach loc $difffilestart {
4528 if {[$ctext compare $loc > $here]} {
4529 $ctext yview $loc
4530 return
4535 proc clear_ctext {{first 1.0}} {
4536 global ctext smarktop smarkbot
4538 set l [lindex [split $first .] 0]
4539 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4540 set smarktop $l
4542 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4543 set smarkbot $l
4545 $ctext delete $first end
4548 proc incrsearch {name ix op} {
4549 global ctext searchstring searchdirn
4551 $ctext tag remove found 1.0 end
4552 if {[catch {$ctext index anchor}]} {
4553 # no anchor set, use start of selection, or of visible area
4554 set sel [$ctext tag ranges sel]
4555 if {$sel ne {}} {
4556 $ctext mark set anchor [lindex $sel 0]
4557 } elseif {$searchdirn eq "-forwards"} {
4558 $ctext mark set anchor @0,0
4559 } else {
4560 $ctext mark set anchor @0,[winfo height $ctext]
4563 if {$searchstring ne {}} {
4564 set here [$ctext search $searchdirn -- $searchstring anchor]
4565 if {$here ne {}} {
4566 $ctext see $here
4568 searchmarkvisible 1
4572 proc dosearch {} {
4573 global sstring ctext searchstring searchdirn
4575 focus $sstring
4576 $sstring icursor end
4577 set searchdirn -forwards
4578 if {$searchstring ne {}} {
4579 set sel [$ctext tag ranges sel]
4580 if {$sel ne {}} {
4581 set start "[lindex $sel 0] + 1c"
4582 } elseif {[catch {set start [$ctext index anchor]}]} {
4583 set start "@0,0"
4585 set match [$ctext search -count mlen -- $searchstring $start]
4586 $ctext tag remove sel 1.0 end
4587 if {$match eq {}} {
4588 bell
4589 return
4591 $ctext see $match
4592 set mend "$match + $mlen c"
4593 $ctext tag add sel $match $mend
4594 $ctext mark unset anchor
4598 proc dosearchback {} {
4599 global sstring ctext searchstring searchdirn
4601 focus $sstring
4602 $sstring icursor end
4603 set searchdirn -backwards
4604 if {$searchstring ne {}} {
4605 set sel [$ctext tag ranges sel]
4606 if {$sel ne {}} {
4607 set start [lindex $sel 0]
4608 } elseif {[catch {set start [$ctext index anchor]}]} {
4609 set start @0,[winfo height $ctext]
4611 set match [$ctext search -backwards -count ml -- $searchstring $start]
4612 $ctext tag remove sel 1.0 end
4613 if {$match eq {}} {
4614 bell
4615 return
4617 $ctext see $match
4618 set mend "$match + $ml c"
4619 $ctext tag add sel $match $mend
4620 $ctext mark unset anchor
4624 proc searchmark {first last} {
4625 global ctext searchstring
4627 set mend $first.0
4628 while {1} {
4629 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4630 if {$match eq {}} break
4631 set mend "$match + $mlen c"
4632 $ctext tag add found $match $mend
4636 proc searchmarkvisible {doall} {
4637 global ctext smarktop smarkbot
4639 set topline [lindex [split [$ctext index @0,0] .] 0]
4640 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4641 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4642 # no overlap with previous
4643 searchmark $topline $botline
4644 set smarktop $topline
4645 set smarkbot $botline
4646 } else {
4647 if {$topline < $smarktop} {
4648 searchmark $topline [expr {$smarktop-1}]
4649 set smarktop $topline
4651 if {$botline > $smarkbot} {
4652 searchmark [expr {$smarkbot+1}] $botline
4653 set smarkbot $botline
4658 proc scrolltext {f0 f1} {
4659 global searchstring
4661 .bleft.sb set $f0 $f1
4662 if {$searchstring ne {}} {
4663 searchmarkvisible 0
4667 proc setcoords {} {
4668 global linespc charspc canvx0 canvy0 mainfont
4669 global xspc1 xspc2 lthickness
4671 set linespc [font metrics $mainfont -linespace]
4672 set charspc [font measure $mainfont "m"]
4673 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4674 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4675 set lthickness [expr {int($linespc / 9) + 1}]
4676 set xspc1(0) $linespc
4677 set xspc2 $linespc
4680 proc redisplay {} {
4681 global canv
4682 global selectedline
4684 set ymax [lindex [$canv cget -scrollregion] 3]
4685 if {$ymax eq {} || $ymax == 0} return
4686 set span [$canv yview]
4687 clear_display
4688 setcanvscroll
4689 allcanvs yview moveto [lindex $span 0]
4690 drawvisible
4691 if {[info exists selectedline]} {
4692 selectline $selectedline 0
4693 allcanvs yview moveto [lindex $span 0]
4697 proc incrfont {inc} {
4698 global mainfont textfont ctext canv phase cflist
4699 global stopped entries
4700 unmarkmatches
4701 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4702 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4703 setcoords
4704 $ctext conf -font $textfont
4705 $cflist conf -font $textfont
4706 $ctext tag conf filesep -font [concat $textfont bold]
4707 foreach e $entries {
4708 $e conf -font $mainfont
4710 if {$phase eq "getcommits"} {
4711 $canv itemconf textitems -font $mainfont
4713 redisplay
4716 proc clearsha1 {} {
4717 global sha1entry sha1string
4718 if {[string length $sha1string] == 40} {
4719 $sha1entry delete 0 end
4723 proc sha1change {n1 n2 op} {
4724 global sha1string currentid sha1but
4725 if {$sha1string == {}
4726 || ([info exists currentid] && $sha1string == $currentid)} {
4727 set state disabled
4728 } else {
4729 set state normal
4731 if {[$sha1but cget -state] == $state} return
4732 if {$state == "normal"} {
4733 $sha1but conf -state normal -relief raised -text "Goto: "
4734 } else {
4735 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4739 proc gotocommit {} {
4740 global sha1string currentid commitrow tagids headids
4741 global displayorder numcommits curview
4743 if {$sha1string == {}
4744 || ([info exists currentid] && $sha1string == $currentid)} return
4745 if {[info exists tagids($sha1string)]} {
4746 set id $tagids($sha1string)
4747 } elseif {[info exists headids($sha1string)]} {
4748 set id $headids($sha1string)
4749 } else {
4750 set id [string tolower $sha1string]
4751 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4752 set matches {}
4753 foreach i $displayorder {
4754 if {[string match $id* $i]} {
4755 lappend matches $i
4758 if {$matches ne {}} {
4759 if {[llength $matches] > 1} {
4760 error_popup "Short SHA1 id $id is ambiguous"
4761 return
4763 set id [lindex $matches 0]
4767 if {[info exists commitrow($curview,$id)]} {
4768 selectline $commitrow($curview,$id) 1
4769 return
4771 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4772 set type "SHA1 id"
4773 } else {
4774 set type "Tag/Head"
4776 error_popup "$type $sha1string is not known"
4779 proc lineenter {x y id} {
4780 global hoverx hovery hoverid hovertimer
4781 global commitinfo canv
4783 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4784 set hoverx $x
4785 set hovery $y
4786 set hoverid $id
4787 if {[info exists hovertimer]} {
4788 after cancel $hovertimer
4790 set hovertimer [after 500 linehover]
4791 $canv delete hover
4794 proc linemotion {x y id} {
4795 global hoverx hovery hoverid hovertimer
4797 if {[info exists hoverid] && $id == $hoverid} {
4798 set hoverx $x
4799 set hovery $y
4800 if {[info exists hovertimer]} {
4801 after cancel $hovertimer
4803 set hovertimer [after 500 linehover]
4807 proc lineleave {id} {
4808 global hoverid hovertimer canv
4810 if {[info exists hoverid] && $id == $hoverid} {
4811 $canv delete hover
4812 if {[info exists hovertimer]} {
4813 after cancel $hovertimer
4814 unset hovertimer
4816 unset hoverid
4820 proc linehover {} {
4821 global hoverx hovery hoverid hovertimer
4822 global canv linespc lthickness
4823 global commitinfo mainfont
4825 set text [lindex $commitinfo($hoverid) 0]
4826 set ymax [lindex [$canv cget -scrollregion] 3]
4827 if {$ymax == {}} return
4828 set yfrac [lindex [$canv yview] 0]
4829 set x [expr {$hoverx + 2 * $linespc}]
4830 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4831 set x0 [expr {$x - 2 * $lthickness}]
4832 set y0 [expr {$y - 2 * $lthickness}]
4833 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4834 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4835 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4836 -fill \#ffff80 -outline black -width 1 -tags hover]
4837 $canv raise $t
4838 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4839 -font $mainfont]
4840 $canv raise $t
4843 proc clickisonarrow {id y} {
4844 global lthickness
4846 set ranges [rowranges $id]
4847 set thresh [expr {2 * $lthickness + 6}]
4848 set n [expr {[llength $ranges] - 1}]
4849 for {set i 1} {$i < $n} {incr i} {
4850 set row [lindex $ranges $i]
4851 if {abs([yc $row] - $y) < $thresh} {
4852 return $i
4855 return {}
4858 proc arrowjump {id n y} {
4859 global canv
4861 # 1 <-> 2, 3 <-> 4, etc...
4862 set n [expr {(($n - 1) ^ 1) + 1}]
4863 set row [lindex [rowranges $id] $n]
4864 set yt [yc $row]
4865 set ymax [lindex [$canv cget -scrollregion] 3]
4866 if {$ymax eq {} || $ymax <= 0} return
4867 set view [$canv yview]
4868 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4869 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4870 if {$yfrac < 0} {
4871 set yfrac 0
4873 allcanvs yview moveto $yfrac
4876 proc lineclick {x y id isnew} {
4877 global ctext commitinfo children canv thickerline curview
4879 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4880 unmarkmatches
4881 unselectline
4882 normalline
4883 $canv delete hover
4884 # draw this line thicker than normal
4885 set thickerline $id
4886 drawlines $id
4887 if {$isnew} {
4888 set ymax [lindex [$canv cget -scrollregion] 3]
4889 if {$ymax eq {}} return
4890 set yfrac [lindex [$canv yview] 0]
4891 set y [expr {$y + $yfrac * $ymax}]
4893 set dirn [clickisonarrow $id $y]
4894 if {$dirn ne {}} {
4895 arrowjump $id $dirn $y
4896 return
4899 if {$isnew} {
4900 addtohistory [list lineclick $x $y $id 0]
4902 # fill the details pane with info about this line
4903 $ctext conf -state normal
4904 clear_ctext
4905 $ctext tag conf link -foreground blue -underline 1
4906 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4907 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4908 $ctext insert end "Parent:\t"
4909 $ctext insert end $id [list link link0]
4910 $ctext tag bind link0 <1> [list selbyid $id]
4911 set info $commitinfo($id)
4912 $ctext insert end "\n\t[lindex $info 0]\n"
4913 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4914 set date [formatdate [lindex $info 2]]
4915 $ctext insert end "\tDate:\t$date\n"
4916 set kids $children($curview,$id)
4917 if {$kids ne {}} {
4918 $ctext insert end "\nChildren:"
4919 set i 0
4920 foreach child $kids {
4921 incr i
4922 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4923 set info $commitinfo($child)
4924 $ctext insert end "\n\t"
4925 $ctext insert end $child [list link link$i]
4926 $ctext tag bind link$i <1> [list selbyid $child]
4927 $ctext insert end "\n\t[lindex $info 0]"
4928 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4929 set date [formatdate [lindex $info 2]]
4930 $ctext insert end "\n\tDate:\t$date\n"
4933 $ctext conf -state disabled
4934 init_flist {}
4937 proc normalline {} {
4938 global thickerline
4939 if {[info exists thickerline]} {
4940 set id $thickerline
4941 unset thickerline
4942 drawlines $id
4946 proc selbyid {id} {
4947 global commitrow curview
4948 if {[info exists commitrow($curview,$id)]} {
4949 selectline $commitrow($curview,$id) 1
4953 proc mstime {} {
4954 global startmstime
4955 if {![info exists startmstime]} {
4956 set startmstime [clock clicks -milliseconds]
4958 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4961 proc rowmenu {x y id} {
4962 global rowctxmenu commitrow selectedline rowmenuid curview
4964 if {![info exists selectedline]
4965 || $commitrow($curview,$id) eq $selectedline} {
4966 set state disabled
4967 } else {
4968 set state normal
4970 $rowctxmenu entryconfigure "Diff this*" -state $state
4971 $rowctxmenu entryconfigure "Diff selected*" -state $state
4972 $rowctxmenu entryconfigure "Make patch" -state $state
4973 set rowmenuid $id
4974 tk_popup $rowctxmenu $x $y
4977 proc diffvssel {dirn} {
4978 global rowmenuid selectedline displayorder
4980 if {![info exists selectedline]} return
4981 if {$dirn} {
4982 set oldid [lindex $displayorder $selectedline]
4983 set newid $rowmenuid
4984 } else {
4985 set oldid $rowmenuid
4986 set newid [lindex $displayorder $selectedline]
4988 addtohistory [list doseldiff $oldid $newid]
4989 doseldiff $oldid $newid
4992 proc doseldiff {oldid newid} {
4993 global ctext
4994 global commitinfo
4996 $ctext conf -state normal
4997 clear_ctext
4998 init_flist "Top"
4999 $ctext insert end "From "
5000 $ctext tag conf link -foreground blue -underline 1
5001 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5002 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5003 $ctext tag bind link0 <1> [list selbyid $oldid]
5004 $ctext insert end $oldid [list link link0]
5005 $ctext insert end "\n "
5006 $ctext insert end [lindex $commitinfo($oldid) 0]
5007 $ctext insert end "\n\nTo "
5008 $ctext tag bind link1 <1> [list selbyid $newid]
5009 $ctext insert end $newid [list link link1]
5010 $ctext insert end "\n "
5011 $ctext insert end [lindex $commitinfo($newid) 0]
5012 $ctext insert end "\n"
5013 $ctext conf -state disabled
5014 $ctext tag delete Comments
5015 $ctext tag remove found 1.0 end
5016 startdiff [list $oldid $newid]
5019 proc mkpatch {} {
5020 global rowmenuid currentid commitinfo patchtop patchnum
5022 if {![info exists currentid]} return
5023 set oldid $currentid
5024 set oldhead [lindex $commitinfo($oldid) 0]
5025 set newid $rowmenuid
5026 set newhead [lindex $commitinfo($newid) 0]
5027 set top .patch
5028 set patchtop $top
5029 catch {destroy $top}
5030 toplevel $top
5031 label $top.title -text "Generate patch"
5032 grid $top.title - -pady 10
5033 label $top.from -text "From:"
5034 entry $top.fromsha1 -width 40 -relief flat
5035 $top.fromsha1 insert 0 $oldid
5036 $top.fromsha1 conf -state readonly
5037 grid $top.from $top.fromsha1 -sticky w
5038 entry $top.fromhead -width 60 -relief flat
5039 $top.fromhead insert 0 $oldhead
5040 $top.fromhead conf -state readonly
5041 grid x $top.fromhead -sticky w
5042 label $top.to -text "To:"
5043 entry $top.tosha1 -width 40 -relief flat
5044 $top.tosha1 insert 0 $newid
5045 $top.tosha1 conf -state readonly
5046 grid $top.to $top.tosha1 -sticky w
5047 entry $top.tohead -width 60 -relief flat
5048 $top.tohead insert 0 $newhead
5049 $top.tohead conf -state readonly
5050 grid x $top.tohead -sticky w
5051 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5052 grid $top.rev x -pady 10
5053 label $top.flab -text "Output file:"
5054 entry $top.fname -width 60
5055 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5056 incr patchnum
5057 grid $top.flab $top.fname -sticky w
5058 frame $top.buts
5059 button $top.buts.gen -text "Generate" -command mkpatchgo
5060 button $top.buts.can -text "Cancel" -command mkpatchcan
5061 grid $top.buts.gen $top.buts.can
5062 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5063 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5064 grid $top.buts - -pady 10 -sticky ew
5065 focus $top.fname
5068 proc mkpatchrev {} {
5069 global patchtop
5071 set oldid [$patchtop.fromsha1 get]
5072 set oldhead [$patchtop.fromhead get]
5073 set newid [$patchtop.tosha1 get]
5074 set newhead [$patchtop.tohead get]
5075 foreach e [list fromsha1 fromhead tosha1 tohead] \
5076 v [list $newid $newhead $oldid $oldhead] {
5077 $patchtop.$e conf -state normal
5078 $patchtop.$e delete 0 end
5079 $patchtop.$e insert 0 $v
5080 $patchtop.$e conf -state readonly
5084 proc mkpatchgo {} {
5085 global patchtop
5087 set oldid [$patchtop.fromsha1 get]
5088 set newid [$patchtop.tosha1 get]
5089 set fname [$patchtop.fname get]
5090 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5091 error_popup "Error creating patch: $err"
5093 catch {destroy $patchtop}
5094 unset patchtop
5097 proc mkpatchcan {} {
5098 global patchtop
5100 catch {destroy $patchtop}
5101 unset patchtop
5104 proc mktag {} {
5105 global rowmenuid mktagtop commitinfo
5107 set top .maketag
5108 set mktagtop $top
5109 catch {destroy $top}
5110 toplevel $top
5111 label $top.title -text "Create tag"
5112 grid $top.title - -pady 10
5113 label $top.id -text "ID:"
5114 entry $top.sha1 -width 40 -relief flat
5115 $top.sha1 insert 0 $rowmenuid
5116 $top.sha1 conf -state readonly
5117 grid $top.id $top.sha1 -sticky w
5118 entry $top.head -width 60 -relief flat
5119 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5120 $top.head conf -state readonly
5121 grid x $top.head -sticky w
5122 label $top.tlab -text "Tag name:"
5123 entry $top.tag -width 60
5124 grid $top.tlab $top.tag -sticky w
5125 frame $top.buts
5126 button $top.buts.gen -text "Create" -command mktaggo
5127 button $top.buts.can -text "Cancel" -command mktagcan
5128 grid $top.buts.gen $top.buts.can
5129 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5130 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5131 grid $top.buts - -pady 10 -sticky ew
5132 focus $top.tag
5135 proc domktag {} {
5136 global mktagtop env tagids idtags
5138 set id [$mktagtop.sha1 get]
5139 set tag [$mktagtop.tag get]
5140 if {$tag == {}} {
5141 error_popup "No tag name specified"
5142 return
5144 if {[info exists tagids($tag)]} {
5145 error_popup "Tag \"$tag\" already exists"
5146 return
5148 if {[catch {
5149 set dir [gitdir]
5150 set fname [file join $dir "refs/tags" $tag]
5151 set f [open $fname w]
5152 puts $f $id
5153 close $f
5154 } err]} {
5155 error_popup "Error creating tag: $err"
5156 return
5159 set tagids($tag) $id
5160 lappend idtags($id) $tag
5161 redrawtags $id
5162 addedtag $id
5165 proc redrawtags {id} {
5166 global canv linehtag commitrow idpos selectedline curview
5167 global mainfont canvxmax
5169 if {![info exists commitrow($curview,$id)]} return
5170 drawcmitrow $commitrow($curview,$id)
5171 $canv delete tag.$id
5172 set xt [eval drawtags $id $idpos($id)]
5173 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5174 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5175 set xr [expr {$xt + [font measure $mainfont $text]}]
5176 if {$xr > $canvxmax} {
5177 set canvxmax $xr
5178 setcanvscroll
5180 if {[info exists selectedline]
5181 && $selectedline == $commitrow($curview,$id)} {
5182 selectline $selectedline 0
5186 proc mktagcan {} {
5187 global mktagtop
5189 catch {destroy $mktagtop}
5190 unset mktagtop
5193 proc mktaggo {} {
5194 domktag
5195 mktagcan
5198 proc writecommit {} {
5199 global rowmenuid wrcomtop commitinfo wrcomcmd
5201 set top .writecommit
5202 set wrcomtop $top
5203 catch {destroy $top}
5204 toplevel $top
5205 label $top.title -text "Write commit to file"
5206 grid $top.title - -pady 10
5207 label $top.id -text "ID:"
5208 entry $top.sha1 -width 40 -relief flat
5209 $top.sha1 insert 0 $rowmenuid
5210 $top.sha1 conf -state readonly
5211 grid $top.id $top.sha1 -sticky w
5212 entry $top.head -width 60 -relief flat
5213 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5214 $top.head conf -state readonly
5215 grid x $top.head -sticky w
5216 label $top.clab -text "Command:"
5217 entry $top.cmd -width 60 -textvariable wrcomcmd
5218 grid $top.clab $top.cmd -sticky w -pady 10
5219 label $top.flab -text "Output file:"
5220 entry $top.fname -width 60
5221 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5222 grid $top.flab $top.fname -sticky w
5223 frame $top.buts
5224 button $top.buts.gen -text "Write" -command wrcomgo
5225 button $top.buts.can -text "Cancel" -command wrcomcan
5226 grid $top.buts.gen $top.buts.can
5227 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5228 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5229 grid $top.buts - -pady 10 -sticky ew
5230 focus $top.fname
5233 proc wrcomgo {} {
5234 global wrcomtop
5236 set id [$wrcomtop.sha1 get]
5237 set cmd "echo $id | [$wrcomtop.cmd get]"
5238 set fname [$wrcomtop.fname get]
5239 if {[catch {exec sh -c $cmd >$fname &} err]} {
5240 error_popup "Error writing commit: $err"
5242 catch {destroy $wrcomtop}
5243 unset wrcomtop
5246 proc wrcomcan {} {
5247 global wrcomtop
5249 catch {destroy $wrcomtop}
5250 unset wrcomtop
5253 proc mkbranch {} {
5254 global rowmenuid mkbrtop
5256 set top .makebranch
5257 catch {destroy $top}
5258 toplevel $top
5259 label $top.title -text "Create new branch"
5260 grid $top.title - -pady 10
5261 label $top.id -text "ID:"
5262 entry $top.sha1 -width 40 -relief flat
5263 $top.sha1 insert 0 $rowmenuid
5264 $top.sha1 conf -state readonly
5265 grid $top.id $top.sha1 -sticky w
5266 label $top.nlab -text "Name:"
5267 entry $top.name -width 40
5268 grid $top.nlab $top.name -sticky w
5269 frame $top.buts
5270 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5271 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5272 grid $top.buts.go $top.buts.can
5273 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5274 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5275 grid $top.buts - -pady 10 -sticky ew
5276 focus $top.name
5279 proc mkbrgo {top} {
5280 global headids idheads
5282 set name [$top.name get]
5283 set id [$top.sha1 get]
5284 if {$name eq {}} {
5285 error_popup "Please specify a name for the new branch"
5286 return
5288 catch {destroy $top}
5289 nowbusy newbranch
5290 update
5291 if {[catch {
5292 exec git branch $name $id
5293 } err]} {
5294 notbusy newbranch
5295 error_popup $err
5296 } else {
5297 addedhead $id $name
5298 # XXX should update list of heads displayed for selected commit
5299 notbusy newbranch
5300 redrawtags $id
5304 proc cherrypick {} {
5305 global rowmenuid curview commitrow
5306 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5308 if {[info exists desc_heads($rowmenuid)]
5309 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5310 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5311 included in branch $mainhead -- really re-apply it?"]
5312 if {!$ok} return
5314 nowbusy cherrypick
5315 update
5316 set oldhead [exec git rev-parse HEAD]
5317 # Unfortunately git-cherry-pick writes stuff to stderr even when
5318 # no error occurs, and exec takes that as an indication of error...
5319 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5320 notbusy cherrypick
5321 error_popup $err
5322 return
5324 set newhead [exec git rev-parse HEAD]
5325 if {$newhead eq $oldhead} {
5326 notbusy cherrypick
5327 error_popup "No changes committed"
5328 return
5330 set allparents($newhead) $oldhead
5331 lappend allchildren($oldhead) $newhead
5332 set desc_heads($newhead) $mainhead
5333 if {[info exists anc_tags($oldhead)]} {
5334 set anc_tags($newhead) $anc_tags($oldhead)
5336 set desc_tags($newhead) {}
5337 if {[info exists commitrow($curview,$oldhead)]} {
5338 insertrow $commitrow($curview,$oldhead) $newhead
5339 if {$mainhead ne {}} {
5340 movedhead $newhead $mainhead
5342 redrawtags $oldhead
5343 redrawtags $newhead
5345 notbusy cherrypick
5348 # context menu for a head
5349 proc headmenu {x y id head} {
5350 global headmenuid headmenuhead headctxmenu
5352 set headmenuid $id
5353 set headmenuhead $head
5354 tk_popup $headctxmenu $x $y
5357 proc cobranch {} {
5358 global headmenuid headmenuhead mainhead headids
5360 # check the tree is clean first??
5361 set oldmainhead $mainhead
5362 nowbusy checkout
5363 update
5364 if {[catch {
5365 exec git checkout -q $headmenuhead
5366 } err]} {
5367 notbusy checkout
5368 error_popup $err
5369 } else {
5370 notbusy checkout
5371 set mainhead $headmenuhead
5372 if {[info exists headids($oldmainhead)]} {
5373 redrawtags $headids($oldmainhead)
5375 redrawtags $headmenuid
5379 proc rmbranch {} {
5380 global desc_heads headmenuid headmenuhead mainhead
5381 global headids idheads
5383 set head $headmenuhead
5384 set id $headmenuid
5385 if {$head eq $mainhead} {
5386 error_popup "Cannot delete the currently checked-out branch"
5387 return
5389 if {$desc_heads($id) eq $head} {
5390 # the stuff on this branch isn't on any other branch
5391 if {![confirm_popup "The commits on branch $head aren't on any other\
5392 branch.\nReally delete branch $head?"]} return
5394 nowbusy rmbranch
5395 update
5396 if {[catch {exec git branch -D $head} err]} {
5397 notbusy rmbranch
5398 error_popup $err
5399 return
5401 removedhead $id $head
5402 redrawtags $id
5403 notbusy rmbranch
5406 # Stuff for finding nearby tags
5407 proc getallcommits {} {
5408 global allcstart allcommits allcfd allids
5410 set allids {}
5411 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5412 set allcfd $fd
5413 fconfigure $fd -blocking 0
5414 set allcommits "reading"
5415 nowbusy allcommits
5416 restartgetall $fd
5419 proc discardallcommits {} {
5420 global allparents allchildren allcommits allcfd
5421 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5423 if {![info exists allcommits]} return
5424 if {$allcommits eq "reading"} {
5425 catch {close $allcfd}
5427 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5428 alldtags tagisdesc desc_heads} {
5429 catch {unset $v}
5433 proc restartgetall {fd} {
5434 global allcstart
5436 fileevent $fd readable [list getallclines $fd]
5437 set allcstart [clock clicks -milliseconds]
5440 proc combine_dtags {l1 l2} {
5441 global tagisdesc notfirstd
5443 set res [lsort -unique [concat $l1 $l2]]
5444 for {set i 0} {$i < [llength $res]} {incr i} {
5445 set x [lindex $res $i]
5446 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5447 set y [lindex $res $j]
5448 if {[info exists tagisdesc($x,$y)]} {
5449 if {$tagisdesc($x,$y) > 0} {
5450 # x is a descendent of y, exclude x
5451 set res [lreplace $res $i $i]
5452 incr i -1
5453 break
5454 } else {
5455 # y is a descendent of x, exclude y
5456 set res [lreplace $res $j $j]
5458 } else {
5459 # no relation, keep going
5460 incr j
5464 return $res
5467 proc combine_atags {l1 l2} {
5468 global tagisdesc
5470 set res [lsort -unique [concat $l1 $l2]]
5471 for {set i 0} {$i < [llength $res]} {incr i} {
5472 set x [lindex $res $i]
5473 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5474 set y [lindex $res $j]
5475 if {[info exists tagisdesc($x,$y)]} {
5476 if {$tagisdesc($x,$y) < 0} {
5477 # x is an ancestor of y, exclude x
5478 set res [lreplace $res $i $i]
5479 incr i -1
5480 break
5481 } else {
5482 # y is an ancestor of x, exclude y
5483 set res [lreplace $res $j $j]
5485 } else {
5486 # no relation, keep going
5487 incr j
5491 return $res
5494 proc forward_pass {id children} {
5495 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5497 set dtags {}
5498 set dheads {}
5499 foreach child $children {
5500 if {[info exists idtags($child)]} {
5501 set ctags [list $child]
5502 } else {
5503 set ctags $desc_tags($child)
5505 if {$dtags eq {}} {
5506 set dtags $ctags
5507 } elseif {$ctags ne $dtags} {
5508 set dtags [combine_dtags $dtags $ctags]
5510 set cheads $desc_heads($child)
5511 if {$dheads eq {}} {
5512 set dheads $cheads
5513 } elseif {$cheads ne $dheads} {
5514 set dheads [lsort -unique [concat $dheads $cheads]]
5517 set desc_tags($id) $dtags
5518 if {[info exists idtags($id)]} {
5519 set adt $dtags
5520 foreach tag $dtags {
5521 set adt [concat $adt $alldtags($tag)]
5523 set adt [lsort -unique $adt]
5524 set alldtags($id) $adt
5525 foreach tag $adt {
5526 set tagisdesc($id,$tag) -1
5527 set tagisdesc($tag,$id) 1
5530 if {[info exists idheads($id)]} {
5531 set dheads [concat $dheads $idheads($id)]
5533 set desc_heads($id) $dheads
5536 proc getallclines {fd} {
5537 global allparents allchildren allcommits allcstart
5538 global desc_tags anc_tags idtags tagisdesc allids
5539 global idheads travindex
5541 while {[gets $fd line] >= 0} {
5542 set id [lindex $line 0]
5543 lappend allids $id
5544 set olds [lrange $line 1 end]
5545 set allparents($id) $olds
5546 if {![info exists allchildren($id)]} {
5547 set allchildren($id) {}
5549 foreach p $olds {
5550 lappend allchildren($p) $id
5552 # compute nearest tagged descendents as we go
5553 # also compute descendent heads
5554 forward_pass $id $allchildren($id)
5555 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5556 fileevent $fd readable {}
5557 after idle restartgetall $fd
5558 return
5561 if {[eof $fd]} {
5562 set travindex [llength $allids]
5563 set allcommits "traversing"
5564 after idle restartatags
5565 if {[catch {close $fd} err]} {
5566 error_popup "Error reading full commit graph: $err.\n\
5567 Results may be incomplete."
5572 # walk backward through the tree and compute nearest tagged ancestors
5573 proc restartatags {} {
5574 global allids allparents idtags anc_tags travindex
5576 set t0 [clock clicks -milliseconds]
5577 set i $travindex
5578 while {[incr i -1] >= 0} {
5579 set id [lindex $allids $i]
5580 set atags {}
5581 foreach p $allparents($id) {
5582 if {[info exists idtags($p)]} {
5583 set ptags [list $p]
5584 } else {
5585 set ptags $anc_tags($p)
5587 if {$atags eq {}} {
5588 set atags $ptags
5589 } elseif {$ptags ne $atags} {
5590 set atags [combine_atags $atags $ptags]
5593 set anc_tags($id) $atags
5594 if {[clock clicks -milliseconds] - $t0 >= 50} {
5595 set travindex $i
5596 after idle restartatags
5597 return
5600 set allcommits "done"
5601 set travindex 0
5602 notbusy allcommits
5603 dispneartags
5606 # update the desc_tags and anc_tags arrays for a new tag just added
5607 proc addedtag {id} {
5608 global desc_tags anc_tags allparents allchildren allcommits
5609 global idtags tagisdesc alldtags
5611 if {![info exists desc_tags($id)]} return
5612 set adt $desc_tags($id)
5613 foreach t $desc_tags($id) {
5614 set adt [concat $adt $alldtags($t)]
5616 set adt [lsort -unique $adt]
5617 set alldtags($id) $adt
5618 foreach t $adt {
5619 set tagisdesc($id,$t) -1
5620 set tagisdesc($t,$id) 1
5622 if {[info exists anc_tags($id)]} {
5623 set todo $anc_tags($id)
5624 while {$todo ne {}} {
5625 set do [lindex $todo 0]
5626 set todo [lrange $todo 1 end]
5627 if {[info exists tagisdesc($id,$do)]} continue
5628 set tagisdesc($do,$id) -1
5629 set tagisdesc($id,$do) 1
5630 if {[info exists anc_tags($do)]} {
5631 set todo [concat $todo $anc_tags($do)]
5636 set lastold $desc_tags($id)
5637 set lastnew [list $id]
5638 set nup 0
5639 set nch 0
5640 set todo $allparents($id)
5641 while {$todo ne {}} {
5642 set do [lindex $todo 0]
5643 set todo [lrange $todo 1 end]
5644 if {![info exists desc_tags($do)]} continue
5645 if {$desc_tags($do) ne $lastold} {
5646 set lastold $desc_tags($do)
5647 set lastnew [combine_dtags $lastold [list $id]]
5648 incr nch
5650 if {$lastold eq $lastnew} continue
5651 set desc_tags($do) $lastnew
5652 incr nup
5653 if {![info exists idtags($do)]} {
5654 set todo [concat $todo $allparents($do)]
5658 if {![info exists anc_tags($id)]} return
5659 set lastold $anc_tags($id)
5660 set lastnew [list $id]
5661 set nup 0
5662 set nch 0
5663 set todo $allchildren($id)
5664 while {$todo ne {}} {
5665 set do [lindex $todo 0]
5666 set todo [lrange $todo 1 end]
5667 if {![info exists anc_tags($do)]} continue
5668 if {$anc_tags($do) ne $lastold} {
5669 set lastold $anc_tags($do)
5670 set lastnew [combine_atags $lastold [list $id]]
5671 incr nch
5673 if {$lastold eq $lastnew} continue
5674 set anc_tags($do) $lastnew
5675 incr nup
5676 if {![info exists idtags($do)]} {
5677 set todo [concat $todo $allchildren($do)]
5682 # update the desc_heads array for a new head just added
5683 proc addedhead {hid head} {
5684 global desc_heads allparents headids idheads
5686 set headids($head) $hid
5687 lappend idheads($hid) $head
5689 set todo [list $hid]
5690 while {$todo ne {}} {
5691 set do [lindex $todo 0]
5692 set todo [lrange $todo 1 end]
5693 if {![info exists desc_heads($do)] ||
5694 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5695 set oldheads $desc_heads($do)
5696 lappend desc_heads($do) $head
5697 set heads $desc_heads($do)
5698 while {1} {
5699 set p $allparents($do)
5700 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5701 $desc_heads($p) ne $oldheads} break
5702 set do $p
5703 set desc_heads($do) $heads
5705 set todo [concat $todo $p]
5709 # update the desc_heads array for a head just removed
5710 proc removedhead {hid head} {
5711 global desc_heads allparents headids idheads
5713 unset headids($head)
5714 if {$idheads($hid) eq $head} {
5715 unset idheads($hid)
5716 } else {
5717 set i [lsearch -exact $idheads($hid) $head]
5718 if {$i >= 0} {
5719 set idheads($hid) [lreplace $idheads($hid) $i $i]
5723 set todo [list $hid]
5724 while {$todo ne {}} {
5725 set do [lindex $todo 0]
5726 set todo [lrange $todo 1 end]
5727 if {![info exists desc_heads($do)]} continue
5728 set i [lsearch -exact $desc_heads($do) $head]
5729 if {$i < 0} continue
5730 set oldheads $desc_heads($do)
5731 set heads [lreplace $desc_heads($do) $i $i]
5732 while {1} {
5733 set desc_heads($do) $heads
5734 set p $allparents($do)
5735 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5736 $desc_heads($p) ne $oldheads} break
5737 set do $p
5739 set todo [concat $todo $p]
5743 # update things for a head moved to a child of its previous location
5744 proc movedhead {id name} {
5745 global headids idheads
5747 set oldid $headids($name)
5748 set headids($name) $id
5749 if {$idheads($oldid) eq $name} {
5750 unset idheads($oldid)
5751 } else {
5752 set i [lsearch -exact $idheads($oldid) $name]
5753 if {$i >= 0} {
5754 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5757 lappend idheads($id) $name
5760 proc changedrefs {} {
5761 global desc_heads desc_tags anc_tags allcommits allids
5762 global allchildren allparents idtags travindex
5764 if {![info exists allcommits]} return
5765 catch {unset desc_heads}
5766 catch {unset desc_tags}
5767 catch {unset anc_tags}
5768 catch {unset alldtags}
5769 catch {unset tagisdesc}
5770 foreach id $allids {
5771 forward_pass $id $allchildren($id)
5773 if {$allcommits ne "reading"} {
5774 set travindex [llength $allids]
5775 if {$allcommits ne "traversing"} {
5776 set allcommits "traversing"
5777 after idle restartatags
5782 proc rereadrefs {} {
5783 global idtags idheads idotherrefs mainhead
5785 set refids [concat [array names idtags] \
5786 [array names idheads] [array names idotherrefs]]
5787 foreach id $refids {
5788 if {![info exists ref($id)]} {
5789 set ref($id) [listrefs $id]
5792 set oldmainhead $mainhead
5793 readrefs
5794 changedrefs
5795 set refids [lsort -unique [concat $refids [array names idtags] \
5796 [array names idheads] [array names idotherrefs]]]
5797 foreach id $refids {
5798 set v [listrefs $id]
5799 if {![info exists ref($id)] || $ref($id) != $v ||
5800 ($id eq $oldmainhead && $id ne $mainhead) ||
5801 ($id eq $mainhead && $id ne $oldmainhead)} {
5802 redrawtags $id
5807 proc listrefs {id} {
5808 global idtags idheads idotherrefs
5810 set x {}
5811 if {[info exists idtags($id)]} {
5812 set x $idtags($id)
5814 set y {}
5815 if {[info exists idheads($id)]} {
5816 set y $idheads($id)
5818 set z {}
5819 if {[info exists idotherrefs($id)]} {
5820 set z $idotherrefs($id)
5822 return [list $x $y $z]
5825 proc showtag {tag isnew} {
5826 global ctext tagcontents tagids linknum
5828 if {$isnew} {
5829 addtohistory [list showtag $tag 0]
5831 $ctext conf -state normal
5832 clear_ctext
5833 set linknum 0
5834 if {[info exists tagcontents($tag)]} {
5835 set text $tagcontents($tag)
5836 } else {
5837 set text "Tag: $tag\nId: $tagids($tag)"
5839 appendwithlinks $text {}
5840 $ctext conf -state disabled
5841 init_flist {}
5844 proc doquit {} {
5845 global stopped
5846 set stopped 100
5847 savestuff .
5848 destroy .
5851 proc doprefs {} {
5852 global maxwidth maxgraphpct diffopts
5853 global oldprefs prefstop showneartags
5854 global bgcolor fgcolor ctext diffcolors selectbgcolor
5855 global uifont
5857 set top .gitkprefs
5858 set prefstop $top
5859 if {[winfo exists $top]} {
5860 raise $top
5861 return
5863 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5864 set oldprefs($v) [set $v]
5866 toplevel $top
5867 wm title $top "Gitk preferences"
5868 label $top.ldisp -text "Commit list display options"
5869 $top.ldisp configure -font $uifont
5870 grid $top.ldisp - -sticky w -pady 10
5871 label $top.spacer -text " "
5872 label $top.maxwidthl -text "Maximum graph width (lines)" \
5873 -font optionfont
5874 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5875 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5876 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5877 -font optionfont
5878 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5879 grid x $top.maxpctl $top.maxpct -sticky w
5881 label $top.ddisp -text "Diff display options"
5882 $top.ddisp configure -font $uifont
5883 grid $top.ddisp - -sticky w -pady 10
5884 label $top.diffoptl -text "Options for diff program" \
5885 -font optionfont
5886 entry $top.diffopt -width 20 -textvariable diffopts
5887 grid x $top.diffoptl $top.diffopt -sticky w
5888 frame $top.ntag
5889 label $top.ntag.l -text "Display nearby tags" -font optionfont
5890 checkbutton $top.ntag.b -variable showneartags
5891 pack $top.ntag.b $top.ntag.l -side left
5892 grid x $top.ntag -sticky w
5894 label $top.cdisp -text "Colors: press to choose"
5895 $top.cdisp configure -font $uifont
5896 grid $top.cdisp - -sticky w -pady 10
5897 label $top.bg -padx 40 -relief sunk -background $bgcolor
5898 button $top.bgbut -text "Background" -font optionfont \
5899 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5900 grid x $top.bgbut $top.bg -sticky w
5901 label $top.fg -padx 40 -relief sunk -background $fgcolor
5902 button $top.fgbut -text "Foreground" -font optionfont \
5903 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5904 grid x $top.fgbut $top.fg -sticky w
5905 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5906 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5907 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5908 [list $ctext tag conf d0 -foreground]]
5909 grid x $top.diffoldbut $top.diffold -sticky w
5910 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5911 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5912 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5913 [list $ctext tag conf d1 -foreground]]
5914 grid x $top.diffnewbut $top.diffnew -sticky w
5915 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5916 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5917 -command [list choosecolor diffcolors 2 $top.hunksep \
5918 "diff hunk header" \
5919 [list $ctext tag conf hunksep -foreground]]
5920 grid x $top.hunksepbut $top.hunksep -sticky w
5921 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
5922 button $top.selbgbut -text "Select bg" -font optionfont \
5923 -command [list choosecolor selectbgcolor 0 $top.bg background setselbg]
5924 grid x $top.selbgbut $top.selbgsep -sticky w
5926 frame $top.buts
5927 button $top.buts.ok -text "OK" -command prefsok -default active
5928 $top.buts.ok configure -font $uifont
5929 button $top.buts.can -text "Cancel" -command prefscan -default normal
5930 $top.buts.can configure -font $uifont
5931 grid $top.buts.ok $top.buts.can
5932 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5933 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5934 grid $top.buts - - -pady 10 -sticky ew
5935 bind $top <Visibility> "focus $top.buts.ok"
5938 proc choosecolor {v vi w x cmd} {
5939 global $v
5941 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5942 -title "Gitk: choose color for $x"]
5943 if {$c eq {}} return
5944 $w conf -background $c
5945 lset $v $vi $c
5946 eval $cmd $c
5949 proc setselbg {c} {
5950 global bglist cflist
5951 foreach w $bglist {
5952 $w configure -selectbackground $c
5954 $cflist tag configure highlight \
5955 -background [$cflist cget -selectbackground]
5956 allcanvs itemconf secsel -fill $c
5959 proc setbg {c} {
5960 global bglist
5962 foreach w $bglist {
5963 $w conf -background $c
5967 proc setfg {c} {
5968 global fglist canv
5970 foreach w $fglist {
5971 $w conf -foreground $c
5973 allcanvs itemconf text -fill $c
5974 $canv itemconf circle -outline $c
5977 proc prefscan {} {
5978 global maxwidth maxgraphpct diffopts
5979 global oldprefs prefstop showneartags
5981 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5982 set $v $oldprefs($v)
5984 catch {destroy $prefstop}
5985 unset prefstop
5988 proc prefsok {} {
5989 global maxwidth maxgraphpct
5990 global oldprefs prefstop showneartags
5992 catch {destroy $prefstop}
5993 unset prefstop
5994 if {$maxwidth != $oldprefs(maxwidth)
5995 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5996 redisplay
5997 } elseif {$showneartags != $oldprefs(showneartags)} {
5998 reselectline
6002 proc formatdate {d} {
6003 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
6006 # This list of encoding names and aliases is distilled from
6007 # http://www.iana.org/assignments/character-sets.
6008 # Not all of them are supported by Tcl.
6009 set encoding_aliases {
6010 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
6011 ISO646-US US-ASCII us IBM367 cp367 csASCII }
6012 { ISO-10646-UTF-1 csISO10646UTF1 }
6013 { ISO_646.basic:1983 ref csISO646basic1983 }
6014 { INVARIANT csINVARIANT }
6015 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
6016 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
6017 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
6018 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
6019 { NATS-DANO iso-ir-9-1 csNATSDANO }
6020 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
6021 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
6022 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
6023 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
6024 { ISO-2022-KR csISO2022KR }
6025 { EUC-KR csEUCKR }
6026 { ISO-2022-JP csISO2022JP }
6027 { ISO-2022-JP-2 csISO2022JP2 }
6028 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
6029 csISO13JISC6220jp }
6030 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
6031 { IT iso-ir-15 ISO646-IT csISO15Italian }
6032 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
6033 { ES iso-ir-17 ISO646-ES csISO17Spanish }
6034 { greek7-old iso-ir-18 csISO18Greek7Old }
6035 { latin-greek iso-ir-19 csISO19LatinGreek }
6036 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
6037 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
6038 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
6039 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
6040 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
6041 { BS_viewdata iso-ir-47 csISO47BSViewdata }
6042 { INIS iso-ir-49 csISO49INIS }
6043 { INIS-8 iso-ir-50 csISO50INIS8 }
6044 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
6045 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
6046 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
6047 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
6048 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
6049 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
6050 csISO60Norwegian1 }
6051 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
6052 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
6053 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
6054 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
6055 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
6056 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
6057 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
6058 { greek7 iso-ir-88 csISO88Greek7 }
6059 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
6060 { iso-ir-90 csISO90 }
6061 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6062 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6063 csISO92JISC62991984b }
6064 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6065 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6066 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6067 csISO95JIS62291984handadd }
6068 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6069 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6070 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6071 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6072 CP819 csISOLatin1 }
6073 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6074 { T.61-7bit iso-ir-102 csISO102T617bit }
6075 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6076 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6077 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6078 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6079 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6080 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6081 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6082 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6083 arabic csISOLatinArabic }
6084 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6085 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6086 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6087 greek greek8 csISOLatinGreek }
6088 { T.101-G2 iso-ir-128 csISO128T101G2 }
6089 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6090 csISOLatinHebrew }
6091 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6092 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6093 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6094 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6095 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6096 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6097 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6098 csISOLatinCyrillic }
6099 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6100 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6101 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6102 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6103 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6104 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6105 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6106 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6107 { ISO_10367-box iso-ir-155 csISO10367Box }
6108 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6109 { latin-lap lap iso-ir-158 csISO158Lap }
6110 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6111 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6112 { us-dk csUSDK }
6113 { dk-us csDKUS }
6114 { JIS_X0201 X0201 csHalfWidthKatakana }
6115 { KSC5636 ISO646-KR csKSC5636 }
6116 { ISO-10646-UCS-2 csUnicode }
6117 { ISO-10646-UCS-4 csUCS4 }
6118 { DEC-MCS dec csDECMCS }
6119 { hp-roman8 roman8 r8 csHPRoman8 }
6120 { macintosh mac csMacintosh }
6121 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6122 csIBM037 }
6123 { IBM038 EBCDIC-INT cp038 csIBM038 }
6124 { IBM273 CP273 csIBM273 }
6125 { IBM274 EBCDIC-BE CP274 csIBM274 }
6126 { IBM275 EBCDIC-BR cp275 csIBM275 }
6127 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6128 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6129 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6130 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6131 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6132 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6133 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6134 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6135 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6136 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6137 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6138 { IBM437 cp437 437 csPC8CodePage437 }
6139 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6140 { IBM775 cp775 csPC775Baltic }
6141 { IBM850 cp850 850 csPC850Multilingual }
6142 { IBM851 cp851 851 csIBM851 }
6143 { IBM852 cp852 852 csPCp852 }
6144 { IBM855 cp855 855 csIBM855 }
6145 { IBM857 cp857 857 csIBM857 }
6146 { IBM860 cp860 860 csIBM860 }
6147 { IBM861 cp861 861 cp-is csIBM861 }
6148 { IBM862 cp862 862 csPC862LatinHebrew }
6149 { IBM863 cp863 863 csIBM863 }
6150 { IBM864 cp864 csIBM864 }
6151 { IBM865 cp865 865 csIBM865 }
6152 { IBM866 cp866 866 csIBM866 }
6153 { IBM868 CP868 cp-ar csIBM868 }
6154 { IBM869 cp869 869 cp-gr csIBM869 }
6155 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6156 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6157 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6158 { IBM891 cp891 csIBM891 }
6159 { IBM903 cp903 csIBM903 }
6160 { IBM904 cp904 904 csIBBM904 }
6161 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6162 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6163 { IBM1026 CP1026 csIBM1026 }
6164 { EBCDIC-AT-DE csIBMEBCDICATDE }
6165 { EBCDIC-AT-DE-A csEBCDICATDEA }
6166 { EBCDIC-CA-FR csEBCDICCAFR }
6167 { EBCDIC-DK-NO csEBCDICDKNO }
6168 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6169 { EBCDIC-FI-SE csEBCDICFISE }
6170 { EBCDIC-FI-SE-A csEBCDICFISEA }
6171 { EBCDIC-FR csEBCDICFR }
6172 { EBCDIC-IT csEBCDICIT }
6173 { EBCDIC-PT csEBCDICPT }
6174 { EBCDIC-ES csEBCDICES }
6175 { EBCDIC-ES-A csEBCDICESA }
6176 { EBCDIC-ES-S csEBCDICESS }
6177 { EBCDIC-UK csEBCDICUK }
6178 { EBCDIC-US csEBCDICUS }
6179 { UNKNOWN-8BIT csUnknown8BiT }
6180 { MNEMONIC csMnemonic }
6181 { MNEM csMnem }
6182 { VISCII csVISCII }
6183 { VIQR csVIQR }
6184 { KOI8-R csKOI8R }
6185 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6186 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6187 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6188 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6189 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6190 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6191 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6192 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6193 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6194 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6195 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6196 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6197 { IBM1047 IBM-1047 }
6198 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6199 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6200 { UNICODE-1-1 csUnicode11 }
6201 { CESU-8 csCESU-8 }
6202 { BOCU-1 csBOCU-1 }
6203 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6204 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6205 l8 }
6206 { ISO-8859-15 ISO_8859-15 Latin-9 }
6207 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6208 { GBK CP936 MS936 windows-936 }
6209 { JIS_Encoding csJISEncoding }
6210 { Shift_JIS MS_Kanji csShiftJIS }
6211 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6212 EUC-JP }
6213 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6214 { ISO-10646-UCS-Basic csUnicodeASCII }
6215 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6216 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6217 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6218 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6219 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6220 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6221 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6222 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6223 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6224 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6225 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6226 { Ventura-US csVenturaUS }
6227 { Ventura-International csVenturaInternational }
6228 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6229 { PC8-Turkish csPC8Turkish }
6230 { IBM-Symbols csIBMSymbols }
6231 { IBM-Thai csIBMThai }
6232 { HP-Legal csHPLegal }
6233 { HP-Pi-font csHPPiFont }
6234 { HP-Math8 csHPMath8 }
6235 { Adobe-Symbol-Encoding csHPPSMath }
6236 { HP-DeskTop csHPDesktop }
6237 { Ventura-Math csVenturaMath }
6238 { Microsoft-Publishing csMicrosoftPublishing }
6239 { Windows-31J csWindows31J }
6240 { GB2312 csGB2312 }
6241 { Big5 csBig5 }
6244 proc tcl_encoding {enc} {
6245 global encoding_aliases
6246 set names [encoding names]
6247 set lcnames [string tolower $names]
6248 set enc [string tolower $enc]
6249 set i [lsearch -exact $lcnames $enc]
6250 if {$i < 0} {
6251 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6252 if {[regsub {^iso[-_]} $enc iso encx]} {
6253 set i [lsearch -exact $lcnames $encx]
6256 if {$i < 0} {
6257 foreach l $encoding_aliases {
6258 set ll [string tolower $l]
6259 if {[lsearch -exact $ll $enc] < 0} continue
6260 # look through the aliases for one that tcl knows about
6261 foreach e $ll {
6262 set i [lsearch -exact $lcnames $e]
6263 if {$i < 0} {
6264 if {[regsub {^iso[-_]} $e iso ex]} {
6265 set i [lsearch -exact $lcnames $ex]
6268 if {$i >= 0} break
6270 break
6273 if {$i >= 0} {
6274 return [lindex $names $i]
6276 return {}
6279 # defaults...
6280 set datemode 0
6281 set diffopts "-U 5 -p"
6282 set wrcomcmd "git diff-tree --stdin -p --pretty"
6284 set gitencoding {}
6285 catch {
6286 set gitencoding [exec git config --get i18n.commitencoding]
6288 if {$gitencoding == ""} {
6289 set gitencoding "utf-8"
6291 set tclencoding [tcl_encoding $gitencoding]
6292 if {$tclencoding == {}} {
6293 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6296 set mainfont {Helvetica 9}
6297 set textfont {Courier 9}
6298 set uifont {Helvetica 9 bold}
6299 set findmergefiles 0
6300 set maxgraphpct 50
6301 set maxwidth 16
6302 set revlistorder 0
6303 set fastdate 0
6304 set uparrowlen 7
6305 set downarrowlen 7
6306 set mingaplen 30
6307 set cmitmode "patch"
6308 set wrapcomment "none"
6309 set showneartags 1
6311 set colors {green red blue magenta darkgrey brown orange}
6312 set bgcolor white
6313 set fgcolor black
6314 set diffcolors {red "#00a000" blue}
6315 set selectbgcolor gray85
6317 catch {source ~/.gitk}
6319 font create optionfont -family sans-serif -size -12
6321 set revtreeargs {}
6322 foreach arg $argv {
6323 switch -regexp -- $arg {
6324 "^$" { }
6325 "^-d" { set datemode 1 }
6326 default {
6327 lappend revtreeargs $arg
6332 # check that we can find a .git directory somewhere...
6333 set gitdir [gitdir]
6334 if {![file isdirectory $gitdir]} {
6335 show_error {} . "Cannot find the git directory \"$gitdir\"."
6336 exit 1
6339 set cmdline_files {}
6340 set i [lsearch -exact $revtreeargs "--"]
6341 if {$i >= 0} {
6342 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6343 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6344 } elseif {$revtreeargs ne {}} {
6345 if {[catch {
6346 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6347 set cmdline_files [split $f "\n"]
6348 set n [llength $cmdline_files]
6349 set revtreeargs [lrange $revtreeargs 0 end-$n]
6350 } err]} {
6351 # unfortunately we get both stdout and stderr in $err,
6352 # so look for "fatal:".
6353 set i [string first "fatal:" $err]
6354 if {$i > 0} {
6355 set err [string range $err [expr {$i + 6}] end]
6357 show_error {} . "Bad arguments to gitk:\n$err"
6358 exit 1
6362 set history {}
6363 set historyindex 0
6364 set fh_serial 0
6365 set nhl_names {}
6366 set highlight_paths {}
6367 set searchdirn -forwards
6368 set boldrows {}
6369 set boldnamerows {}
6370 set diffelide {0 0}
6372 set optim_delay 16
6374 set nextviewnum 1
6375 set curview 0
6376 set selectedview 0
6377 set selectedhlview None
6378 set viewfiles(0) {}
6379 set viewperm(0) 0
6380 set viewargs(0) {}
6382 set cmdlineok 0
6383 set stopped 0
6384 set stuffsaved 0
6385 set patchnum 0
6386 setcoords
6387 makewindow
6388 wm title . "[file tail $argv0]: [file tail [pwd]]"
6389 readrefs
6391 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6392 # create a view for the files/dirs specified on the command line
6393 set curview 1
6394 set selectedview 1
6395 set nextviewnum 2
6396 set viewname(1) "Command line"
6397 set viewfiles(1) $cmdline_files
6398 set viewargs(1) $revtreeargs
6399 set viewperm(1) 0
6400 addviewmenu 1
6401 .bar.view entryconf Edit* -state normal
6402 .bar.view entryconf Delete* -state normal
6405 if {[info exists permviews]} {
6406 foreach v $permviews {
6407 set n $nextviewnum
6408 incr nextviewnum
6409 set viewname($n) [lindex $v 0]
6410 set viewfiles($n) [lindex $v 1]
6411 set viewargs($n) [lindex $v 2]
6412 set viewperm($n) 1
6413 addviewmenu $n
6416 getcommits