[PATCH] Improve look-and-feel of the gitk tool.
[git/git.git] / gitk
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
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.
9
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]
16 }
17 }
18
19 proc start_rev_list {view} {
20 global startmsecs nextupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
23
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)]
30 }
31 set order "--topo-order"
32 if {$datemode} {
33 set order "--date-order"
34 }
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
41 }
42 set commfd($view) $fd
43 set leftover($view) {}
44 fconfigure $fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $fd -encoding $tclencoding
47 }
48 fileevent $fd readable [list getcommitlines $fd $view]
49 nowbusy $view
50 }
51
52 proc stop_rev_list {} {
53 global commfd curview
54
55 if {![info exists commfd($curview)]} return
56 set fd $commfd($curview)
57 catch {
58 set pid [pid $fd]
59 exec kill $pid
60 }
61 catch {close $fd}
62 unset commfd($curview)
63 }
64
65 proc getcommits {} {
66 global phase canv mainfont curview
67
68 set phase getcommits
69 initlayout
70 start_rev_list $curview
71 show_status "Reading commits..."
72 }
73
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
80
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"
93 }
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.)"
101 }
102 } else {
103 set err "Error reading commits$fv: $err"
104 }
105 error_popup $err
106 }
107 if {$view == $curview} {
108 after idle finishcommits
109 }
110 return
111 }
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
119 }
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}]]
126 }
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]
136 }
137 set ok 1
138 foreach id $ids {
139 if {[string length $id] != 40} {
140 set ok 0
141 break
142 }
143 }
144 }
145 if {!$ok} {
146 set shortcmit $cmit
147 if {[string length $shortcmit] > 80} {
148 set shortcmit "[string range $shortcmit 0 80]..."
149 }
150 error_popup "Can't parse git rev-list output: {$shortcmit}"
151 exit 1
152 }
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
160 }
161 incr i
162 }
163 } else {
164 set olds {}
165 }
166 if {![info exists children($view,$id)]} {
167 set children($view,$id) {}
168 }
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
182 }
183 set gotsome 1
184 }
185 if {$gotsome} {
186 if {$view == $curview} {
187 while {[layoutmore $nextupdate]} doupdate
188 } elseif {[info exists hlview] && $view == $hlview} {
189 vhighlightmore
190 }
191 }
192 if {[clock clicks -milliseconds] >= $nextupdate} {
193 doupdate
194 }
195 }
196
197 proc doupdate {} {
198 global commfd nextupdate numcommits
199
200 foreach v [array names commfd] {
201 fileevent $commfd($v) readable {}
202 }
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]
208 }
209 }
210
211 proc readcommit {id} {
212 if {[catch {set contents [exec git cat-file commit $id]}]} return
213 parsecommit $id $contents 0
214 }
215
216 proc updatecommits {} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
219
220 if {$phase ne {}} {
221 stop_rev_list
222 set phase {}
223 }
224 set n $curview
225 foreach id $displayorder {
226 catch {unset children($n,$id)}
227 catch {unset commitrow($n,$id)}
228 }
229 set curview -1
230 catch {unset selectedline}
231 catch {unset thickerline}
232 catch {unset viewdata($n)}
233 discardallcommits
234 readrefs
235 showview $n
236 }
237
238 proc parsecommit {id contents listed} {
239 global commitinfo cdate
240
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]
252 }
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]
263 }
264 }
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
272 }
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"
281 }
282 set comment $newcomment
283 }
284 if {$comdate != {}} {
285 set cdate($id) $comdate
286 }
287 set commitinfo($id) [list $headline $auname $audate \
288 $comname $comdate $comment]
289 }
290
291 proc getcommit {id} {
292 global commitdata commitinfo
293
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"}
300 }
301 }
302 return 1
303 }
304
305 proc readrefs {} {
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs mainhead
308
309 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
310 catch {unset $v}
311 }
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
317 }
318 if {[regexp {^remotes/.*/HEAD$} $path match]} {
319 continue
320 }
321 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
322 set type others
323 set name $path
324 }
325 if {[regexp {^remotes/} $path match]} {
326 set type heads
327 }
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
339 }
340 }
341 catch {
342 set tagcontents($name) [exec git cat-file tag $id]
343 }
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
350 }
351 }
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]
358 }
359 }
360 }
361
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
370 }
371
372 proc error_popup msg {
373 set w .error
374 toplevel $w
375 wm transient $w .
376 show_error $w $w $msg
377 }
378
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
394 }
395
396 proc makewindow {} {
397 global canv canv2 canv3 linespc charspc ctext cflist
398 global textfont mainfont uifont
399 global findtype findtypemenu findloc findstring fstring geometry
400 global entries sha1entry sha1string sha1but
401 global maincursor textcursor curtextcursor
402 global rowctxmenu mergemax wrapcomment
403 global highlight_files gdttype
404 global searchstring sstring
405 global bgcolor fgcolor bglist fglist diffcolors
406 global headctxmenu
407
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
420
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
430
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
437
438 # the gui has upper and lower half, parts of a paned window.
439 panedwindow .ctop -orient vertical
440
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"
449 }
450
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
455
456 # create three canvases
457 set cscroll .tf.histframe.csb
458 set canv .tf.histframe.pwclist.canv
459 canvas $canv \
460 -background $bgcolor -bd 0 \
461 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
462 .tf.histframe.pwclist add $canv
463 set canv2 .tf.histframe.pwclist.canv2
464 canvas $canv2 \
465 -background $bgcolor -bd 0 -yscrollincr $linespc
466 .tf.histframe.pwclist add $canv2
467 set canv3 .tf.histframe.pwclist.canv3
468 canvas $canv3 \
469 -background $bgcolor -bd 0 -yscrollincr $linespc
470 .tf.histframe.pwclist add $canv3
471 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
472 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
473
474 # a scroll bar to rule them
475 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
476 pack $cscroll -side right -fill y
477 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
478 lappend bglist $canv $canv2 $canv3
479 pack .tf.histframe.pwclist -fill both -expand 1 -side left
480
481 # we have two button bars at bottom of top frame. Bar 1
482 frame .tf.bar
483 frame .tf.lbar -height 15
484
485 set sha1entry .tf.bar.sha1
486 set entries $sha1entry
487 set sha1but .tf.bar.sha1label
488 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
489 -command gotocommit -width 8 -font $uifont
490 $sha1but conf -disabledforeground [$sha1but cget -foreground]
491 pack .tf.bar.sha1label -side left
492 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
493 trace add variable sha1string write sha1change
494 pack $sha1entry -side left -pady 2
495
496 image create bitmap bm-left -data {
497 #define left_width 16
498 #define left_height 16
499 static unsigned char left_bits[] = {
500 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
501 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
502 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
503 }
504 image create bitmap bm-right -data {
505 #define right_width 16
506 #define right_height 16
507 static unsigned char right_bits[] = {
508 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
509 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
510 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
511 }
512 button .tf.bar.leftbut -image bm-left -command goback \
513 -state disabled -width 26
514 pack .tf.bar.leftbut -side left -fill y
515 button .tf.bar.rightbut -image bm-right -command goforw \
516 -state disabled -width 26
517 pack .tf.bar.rightbut -side left -fill y
518
519 button .tf.bar.findbut -text "Find" -command dofind -font $uifont
520 pack .tf.bar.findbut -side left
521 set findstring {}
522 set fstring .tf.bar.findstring
523 lappend entries $fstring
524 entry $fstring -width 30 -font $textfont -textvariable findstring
525 trace add variable findstring write find_change
526 pack $fstring -side left -expand 1 -fill x -in .tf.bar
527 set findtype Exact
528 set findtypemenu [tk_optionMenu .tf.bar.findtype \
529 findtype Exact IgnCase Regexp]
530 trace add variable findtype write find_change
531 .tf.bar.findtype configure -font $uifont
532 .tf.bar.findtype.menu configure -font $uifont
533 set findloc "All fields"
534 tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
535 Comments Author Committer
536 trace add variable findloc write find_change
537 .tf.bar.findloc configure -font $uifont
538 .tf.bar.findloc.menu configure -font $uifont
539 pack .tf.bar.findloc -side right
540 pack .tf.bar.findtype -side right
541
542 # build up the bottom bar of upper window
543 label .tf.lbar.flabel -text "Highlight: Commits " \
544 -font $uifont
545 pack .tf.lbar.flabel -side left -fill y
546 set gdttype "touching paths:"
547 set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
548 "adding/removing string:"]
549 trace add variable gdttype write hfiles_change
550 $gm conf -font $uifont
551 .tf.lbar.gdttype conf -font $uifont
552 pack .tf.lbar.gdttype -side left -fill y
553 entry .tf.lbar.fent -width 25 -font $textfont \
554 -textvariable highlight_files
555 trace add variable highlight_files write hfiles_change
556 lappend entries .tf.lbar.fent
557 pack .tf.lbar.fent -side left -fill x -expand 1
558 label .tf.lbar.vlabel -text " OR in view" -font $uifont
559 pack .tf.lbar.vlabel -side left -fill y
560 global viewhlmenu selectedhlview
561 set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
562 $viewhlmenu entryconf None -command delvhighlight
563 $viewhlmenu conf -font $uifont
564 .tf.lbar.vhl conf -font $uifont
565 pack .tf.lbar.vhl -side left -fill y
566 label .tf.lbar.rlabel -text " OR " -font $uifont
567 pack .tf.lbar.rlabel -side left -fill y
568 global highlight_related
569 set m [tk_optionMenu .tf.lbar.relm highlight_related None \
570 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
571 $m conf -font $uifont
572 .tf.lbar.relm conf -font $uifont
573 trace add variable highlight_related write vrel_change
574 pack .tf.lbar.relm -side left -fill y
575
576 # Finish putting the upper half of the viewer together
577 pack .tf.lbar -in .tf -side bottom -fill x
578 pack .tf.bar -in .tf -side bottom -fill x
579 pack .tf.histframe -fill both -side top -expand 1
580 .ctop add .tf
581 .ctop paneconfigure .tf -height $geometry(topheight)
582 .ctop paneconfigure .tf -width $geometry(topwidth)
583
584 # now build up the bottom
585 panedwindow .pwbottom -orient horizontal
586
587 # lower left, a text box over search bar, scroll bar to the right
588 # if we know window height, then that will set the lower text height, otherwise
589 # we set lower text height which will drive window height
590 if {[info exists geometry(main)]} {
591 frame .bleft -width $geometry(botwidth)
592 } else {
593 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
594 }
595 frame .bleft.top
596
597 button .bleft.top.search -text "Search" -command dosearch \
598 -font $uifont
599 pack .bleft.top.search -side left -padx 5
600 set sstring .bleft.top.sstring
601 entry $sstring -width 20 -font $textfont -textvariable searchstring
602 lappend entries $sstring
603 trace add variable searchstring write incrsearch
604 pack $sstring -side left -expand 1 -fill x
605 set ctext .bleft.ctext
606 text $ctext -background $bgcolor -foreground $fgcolor \
607 -state disabled -font $textfont \
608 -yscrollcommand scrolltext -wrap none
609 scrollbar .bleft.sb -command "$ctext yview"
610 pack .bleft.top -side top -fill x
611 pack .bleft.sb -side right -fill y
612 pack $ctext -side left -fill both -expand 1
613 lappend bglist $ctext
614 lappend fglist $ctext
615
616 $ctext tag conf comment -wrap $wrapcomment
617 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
618 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
619 $ctext tag conf d0 -fore [lindex $diffcolors 0]
620 $ctext tag conf d1 -fore [lindex $diffcolors 1]
621 $ctext tag conf m0 -fore red
622 $ctext tag conf m1 -fore blue
623 $ctext tag conf m2 -fore green
624 $ctext tag conf m3 -fore purple
625 $ctext tag conf m4 -fore brown
626 $ctext tag conf m5 -fore "#009090"
627 $ctext tag conf m6 -fore magenta
628 $ctext tag conf m7 -fore "#808000"
629 $ctext tag conf m8 -fore "#009000"
630 $ctext tag conf m9 -fore "#ff0080"
631 $ctext tag conf m10 -fore cyan
632 $ctext tag conf m11 -fore "#b07070"
633 $ctext tag conf m12 -fore "#70b0f0"
634 $ctext tag conf m13 -fore "#70f0b0"
635 $ctext tag conf m14 -fore "#f0b070"
636 $ctext tag conf m15 -fore "#ff70b0"
637 $ctext tag conf mmax -fore darkgrey
638 set mergemax 16
639 $ctext tag conf mresult -font [concat $textfont bold]
640 $ctext tag conf msep -font [concat $textfont bold]
641 $ctext tag conf found -back yellow
642
643 .pwbottom add .bleft
644 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
645
646 # lower right
647 frame .bright
648 frame .bright.mode
649 radiobutton .bright.mode.patch -text "Patch" \
650 -command reselectline -variable cmitmode -value "patch"
651 .bright.mode.patch configure -font $uifont
652 radiobutton .bright.mode.tree -text "Tree" \
653 -command reselectline -variable cmitmode -value "tree"
654 .bright.mode.tree configure -font $uifont
655 grid .bright.mode.patch .bright.mode.tree -sticky ew
656 pack .bright.mode -side top -fill x
657 set cflist .bright.cfiles
658 set indent [font measure $mainfont "nn"]
659 text $cflist \
660 -background $bgcolor -foreground $fgcolor \
661 -font $mainfont \
662 -tabs [list $indent [expr {2 * $indent}]] \
663 -yscrollcommand ".bright.sb set" \
664 -cursor [. cget -cursor] \
665 -spacing1 1 -spacing3 1
666 lappend bglist $cflist
667 lappend fglist $cflist
668 scrollbar .bright.sb -command "$cflist yview"
669 pack .bright.sb -side right -fill y
670 pack $cflist -side left -fill both -expand 1
671 $cflist tag configure highlight \
672 -background [$cflist cget -selectbackground]
673 $cflist tag configure bold -font [concat $mainfont bold]
674
675 .pwbottom add .bright
676 .ctop add .pwbottom
677
678 # restore window position if known
679 if {[info exists geometry(main)]} {
680 wm geometry . "$geometry(main)"
681 }
682
683 bind .pwbottom <Configure> {resizecdetpanes %W %w}
684 pack .ctop -fill both -expand 1
685 bindall <1> {selcanvline %W %x %y}
686 #bindall <B1-Motion> {selcanvline %W %x %y}
687 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
688 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
689 bindall <2> "canvscan mark %W %x %y"
690 bindall <B2-Motion> "canvscan dragto %W %x %y"
691 bindkey <Home> selfirstline
692 bindkey <End> sellastline
693 bind . <Key-Up> "selnextline -1"
694 bind . <Key-Down> "selnextline 1"
695 bind . <Shift-Key-Up> "next_highlight -1"
696 bind . <Shift-Key-Down> "next_highlight 1"
697 bindkey <Key-Right> "goforw"
698 bindkey <Key-Left> "goback"
699 bind . <Key-Prior> "selnextpage -1"
700 bind . <Key-Next> "selnextpage 1"
701 bind . <Control-Home> "allcanvs yview moveto 0.0"
702 bind . <Control-End> "allcanvs yview moveto 1.0"
703 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
704 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
705 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
706 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
707 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
708 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
709 bindkey <Key-space> "$ctext yview scroll 1 pages"
710 bindkey p "selnextline -1"
711 bindkey n "selnextline 1"
712 bindkey z "goback"
713 bindkey x "goforw"
714 bindkey i "selnextline -1"
715 bindkey k "selnextline 1"
716 bindkey j "goback"
717 bindkey l "goforw"
718 bindkey b "$ctext yview scroll -1 pages"
719 bindkey d "$ctext yview scroll 18 units"
720 bindkey u "$ctext yview scroll -18 units"
721 bindkey / {findnext 1}
722 bindkey <Key-Return> {findnext 0}
723 bindkey ? findprev
724 bindkey f nextfile
725 bindkey <F5> updatecommits
726 bind . <Control-q> doquit
727 bind . <Control-f> dofind
728 bind . <Control-g> {findnext 0}
729 bind . <Control-r> dosearchback
730 bind . <Control-s> dosearch
731 bind . <Control-equal> {incrfont 1}
732 bind . <Control-KP_Add> {incrfont 1}
733 bind . <Control-minus> {incrfont -1}
734 bind . <Control-KP_Subtract> {incrfont -1}
735 wm protocol . WM_DELETE_WINDOW doquit
736 bind . <Button-1> "click %W"
737 bind $fstring <Key-Return> dofind
738 bind $sha1entry <Key-Return> gotocommit
739 bind $sha1entry <<PasteSelection>> clearsha1
740 bind $cflist <1> {sel_flist %W %x %y; break}
741 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
742 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
743
744 set maincursor [. cget -cursor]
745 set textcursor [$ctext cget -cursor]
746 set curtextcursor $textcursor
747
748 set rowctxmenu .rowctxmenu
749 menu $rowctxmenu -tearoff 0
750 $rowctxmenu add command -label "Diff this -> selected" \
751 -command {diffvssel 0}
752 $rowctxmenu add command -label "Diff selected -> this" \
753 -command {diffvssel 1}
754 $rowctxmenu add command -label "Make patch" -command mkpatch
755 $rowctxmenu add command -label "Create tag" -command mktag
756 $rowctxmenu add command -label "Write commit to file" -command writecommit
757 $rowctxmenu add command -label "Create new branch" -command mkbranch
758 $rowctxmenu add command -label "Cherry-pick this commit" \
759 -command cherrypick
760
761 set headctxmenu .headctxmenu
762 menu $headctxmenu -tearoff 0
763 $headctxmenu add command -label "Check out this branch" \
764 -command cobranch
765 $headctxmenu add command -label "Remove this branch" \
766 -command rmbranch
767 }
768
769 # mouse-2 makes all windows scan vertically, but only the one
770 # the cursor is in scans horizontally
771 proc canvscan {op w x y} {
772 global canv canv2 canv3
773 foreach c [list $canv $canv2 $canv3] {
774 if {$c == $w} {
775 $c scan $op $x $y
776 } else {
777 $c scan $op 0 $y
778 }
779 }
780 }
781
782 proc scrollcanv {cscroll f0 f1} {
783 $cscroll set $f0 $f1
784 drawfrac $f0 $f1
785 flushhighlights
786 }
787
788 # when we make a key binding for the toplevel, make sure
789 # it doesn't get triggered when that key is pressed in the
790 # find string entry widget.
791 proc bindkey {ev script} {
792 global entries
793 bind . $ev $script
794 set escript [bind Entry $ev]
795 if {$escript == {}} {
796 set escript [bind Entry <Key>]
797 }
798 foreach e $entries {
799 bind $e $ev "$escript; break"
800 }
801 }
802
803 # set the focus back to the toplevel for any click outside
804 # the entry widgets
805 proc click {w} {
806 global entries
807 foreach e $entries {
808 if {$w == $e} return
809 }
810 focus .
811 }
812
813 proc savestuff {w} {
814 global canv canv2 canv3 ctext cflist mainfont textfont uifont
815 global stuffsaved findmergefiles maxgraphpct
816 global maxwidth showneartags
817 global viewname viewfiles viewargs viewperm nextviewnum
818 global cmitmode wrapcomment
819 global colors bgcolor fgcolor diffcolors
820
821 if {$stuffsaved} return
822 if {![winfo viewable .]} return
823 catch {
824 set f [open "~/.gitk-new" w]
825 puts $f [list set mainfont $mainfont]
826 puts $f [list set textfont $textfont]
827 puts $f [list set uifont $uifont]
828 puts $f [list set findmergefiles $findmergefiles]
829 puts $f [list set maxgraphpct $maxgraphpct]
830 puts $f [list set maxwidth $maxwidth]
831 puts $f [list set cmitmode $cmitmode]
832 puts $f [list set wrapcomment $wrapcomment]
833 puts $f [list set showneartags $showneartags]
834 puts $f [list set bgcolor $bgcolor]
835 puts $f [list set fgcolor $fgcolor]
836 puts $f [list set colors $colors]
837 puts $f [list set diffcolors $diffcolors]
838
839 puts $f "set geometry(main) [wm geometry .]"
840 puts $f "set geometry(topwidth) [winfo width .tf]"
841 puts $f "set geometry(topheight) [winfo height .tf]"
842 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
843 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
844 puts $f "set geometry(botwidth) [winfo width .bleft]"
845 puts $f "set geometry(botheight) [winfo height .bleft]"
846
847 puts -nonewline $f "set permviews {"
848 for {set v 0} {$v < $nextviewnum} {incr v} {
849 if {$viewperm($v)} {
850 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
851 }
852 }
853 puts $f "}"
854 close $f
855 file rename -force "~/.gitk-new" "~/.gitk"
856 }
857 set stuffsaved 1
858 }
859
860 proc resizeclistpanes {win w} {
861 global oldwidth
862 if {[info exists oldwidth($win)]} {
863 set s0 [$win sash coord 0]
864 set s1 [$win sash coord 1]
865 if {$w < 60} {
866 set sash0 [expr {int($w/2 - 2)}]
867 set sash1 [expr {int($w*5/6 - 2)}]
868 } else {
869 set factor [expr {1.0 * $w / $oldwidth($win)}]
870 set sash0 [expr {int($factor * [lindex $s0 0])}]
871 set sash1 [expr {int($factor * [lindex $s1 0])}]
872 if {$sash0 < 30} {
873 set sash0 30
874 }
875 if {$sash1 < $sash0 + 20} {
876 set sash1 [expr {$sash0 + 20}]
877 }
878 if {$sash1 > $w - 10} {
879 set sash1 [expr {$w - 10}]
880 if {$sash0 > $sash1 - 20} {
881 set sash0 [expr {$sash1 - 20}]
882 }
883 }
884 }
885 $win sash place 0 $sash0 [lindex $s0 1]
886 $win sash place 1 $sash1 [lindex $s1 1]
887 }
888 set oldwidth($win) $w
889 }
890
891 proc resizecdetpanes {win w} {
892 global oldwidth
893 if {[info exists oldwidth($win)]} {
894 set s0 [$win sash coord 0]
895 if {$w < 60} {
896 set sash0 [expr {int($w*3/4 - 2)}]
897 } else {
898 set factor [expr {1.0 * $w / $oldwidth($win)}]
899 set sash0 [expr {int($factor * [lindex $s0 0])}]
900 if {$sash0 < 45} {
901 set sash0 45
902 }
903 if {$sash0 > $w - 15} {
904 set sash0 [expr {$w - 15}]
905 }
906 }
907 $win sash place 0 $sash0 [lindex $s0 1]
908 }
909 set oldwidth($win) $w
910 }
911
912 proc allcanvs args {
913 global canv canv2 canv3
914 eval $canv $args
915 eval $canv2 $args
916 eval $canv3 $args
917 }
918
919 proc bindall {event action} {
920 global canv canv2 canv3
921 bind $canv $event $action
922 bind $canv2 $event $action
923 bind $canv3 $event $action
924 }
925
926 proc about {} {
927 global uifont
928 set w .about
929 if {[winfo exists $w]} {
930 raise $w
931 return
932 }
933 toplevel $w
934 wm title $w "About gitk"
935 message $w.m -text {
936 Gitk - a commit viewer for git
937
938 Copyright © 2005-2006 Paul Mackerras
939
940 Use and redistribute under the terms of the GNU General Public License} \
941 -justify center -aspect 400 -border 2 -bg white -relief groove
942 pack $w.m -side top -fill x -padx 2 -pady 2
943 $w.m configure -font $uifont
944 button $w.ok -text Close -command "destroy $w" -default active
945 pack $w.ok -side bottom
946 $w.ok configure -font $uifont
947 bind $w <Visibility> "focus $w.ok"
948 bind $w <Key-Escape> "destroy $w"
949 bind $w <Key-Return> "destroy $w"
950 }
951
952 proc keys {} {
953 global uifont
954 set w .keys
955 if {[winfo exists $w]} {
956 raise $w
957 return
958 }
959 toplevel $w
960 wm title $w "Gitk key bindings"
961 message $w.m -text {
962 Gitk key bindings:
963
964 <Ctrl-Q> Quit
965 <Home> Move to first commit
966 <End> Move to last commit
967 <Up>, p, i Move up one commit
968 <Down>, n, k Move down one commit
969 <Left>, z, j Go back in history list
970 <Right>, x, l Go forward in history list
971 <PageUp> Move up one page in commit list
972 <PageDown> Move down one page in commit list
973 <Ctrl-Home> Scroll to top of commit list
974 <Ctrl-End> Scroll to bottom of commit list
975 <Ctrl-Up> Scroll commit list up one line
976 <Ctrl-Down> Scroll commit list down one line
977 <Ctrl-PageUp> Scroll commit list up one page
978 <Ctrl-PageDown> Scroll commit list down one page
979 <Shift-Up> Move to previous highlighted line
980 <Shift-Down> Move to next highlighted line
981 <Delete>, b Scroll diff view up one page
982 <Backspace> Scroll diff view up one page
983 <Space> Scroll diff view down one page
984 u Scroll diff view up 18 lines
985 d Scroll diff view down 18 lines
986 <Ctrl-F> Find
987 <Ctrl-G> Move to next find hit
988 <Return> Move to next find hit
989 / Move to next find hit, or redo find
990 ? Move to previous find hit
991 f Scroll diff view to next file
992 <Ctrl-S> Search for next hit in diff view
993 <Ctrl-R> Search for previous hit in diff view
994 <Ctrl-KP+> Increase font size
995 <Ctrl-plus> Increase font size
996 <Ctrl-KP-> Decrease font size
997 <Ctrl-minus> Decrease font size
998 <F5> Update
999 } \
1000 -justify left -bg white -border 2 -relief groove
1001 pack $w.m -side top -fill both -padx 2 -pady 2
1002 $w.m configure -font $uifont
1003 button $w.ok -text Close -command "destroy $w" -default active
1004 pack $w.ok -side bottom
1005 $w.ok configure -font $uifont
1006 bind $w <Visibility> "focus $w.ok"
1007 bind $w <Key-Escape> "destroy $w"
1008 bind $w <Key-Return> "destroy $w"
1009 }
1010
1011 # Procedures for manipulating the file list window at the
1012 # bottom right of the overall window.
1013
1014 proc treeview {w l openlevs} {
1015 global treecontents treediropen treeheight treeparent treeindex
1016
1017 set ix 0
1018 set treeindex() 0
1019 set lev 0
1020 set prefix {}
1021 set prefixend -1
1022 set prefendstack {}
1023 set htstack {}
1024 set ht 0
1025 set treecontents() {}
1026 $w conf -state normal
1027 foreach f $l {
1028 while {[string range $f 0 $prefixend] ne $prefix} {
1029 if {$lev <= $openlevs} {
1030 $w mark set e:$treeindex($prefix) "end -1c"
1031 $w mark gravity e:$treeindex($prefix) left
1032 }
1033 set treeheight($prefix) $ht
1034 incr ht [lindex $htstack end]
1035 set htstack [lreplace $htstack end end]
1036 set prefixend [lindex $prefendstack end]
1037 set prefendstack [lreplace $prefendstack end end]
1038 set prefix [string range $prefix 0 $prefixend]
1039 incr lev -1
1040 }
1041 set tail [string range $f [expr {$prefixend+1}] end]
1042 while {[set slash [string first "/" $tail]] >= 0} {
1043 lappend htstack $ht
1044 set ht 0
1045 lappend prefendstack $prefixend
1046 incr prefixend [expr {$slash + 1}]
1047 set d [string range $tail 0 $slash]
1048 lappend treecontents($prefix) $d
1049 set oldprefix $prefix
1050 append prefix $d
1051 set treecontents($prefix) {}
1052 set treeindex($prefix) [incr ix]
1053 set treeparent($prefix) $oldprefix
1054 set tail [string range $tail [expr {$slash+1}] end]
1055 if {$lev <= $openlevs} {
1056 set ht 1
1057 set treediropen($prefix) [expr {$lev < $openlevs}]
1058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1059 $w mark set d:$ix "end -1c"
1060 $w mark gravity d:$ix left
1061 set str "\n"
1062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1063 $w insert end $str
1064 $w image create end -align center -image $bm -padx 1 \
1065 -name a:$ix
1066 $w insert end $d [highlight_tag $prefix]
1067 $w mark set s:$ix "end -1c"
1068 $w mark gravity s:$ix left
1069 }
1070 incr lev
1071 }
1072 if {$tail ne {}} {
1073 if {$lev <= $openlevs} {
1074 incr ht
1075 set str "\n"
1076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1077 $w insert end $str
1078 $w insert end $tail [highlight_tag $f]
1079 }
1080 lappend treecontents($prefix) $tail
1081 }
1082 }
1083 while {$htstack ne {}} {
1084 set treeheight($prefix) $ht
1085 incr ht [lindex $htstack end]
1086 set htstack [lreplace $htstack end end]
1087 }
1088 $w conf -state disabled
1089 }
1090
1091 proc linetoelt {l} {
1092 global treeheight treecontents
1093
1094 set y 2
1095 set prefix {}
1096 while {1} {
1097 foreach e $treecontents($prefix) {
1098 if {$y == $l} {
1099 return "$prefix$e"
1100 }
1101 set n 1
1102 if {[string index $e end] eq "/"} {
1103 set n $treeheight($prefix$e)
1104 if {$y + $n > $l} {
1105 append prefix $e
1106 incr y
1107 break
1108 }
1109 }
1110 incr y $n
1111 }
1112 }
1113 }
1114
1115 proc highlight_tree {y prefix} {
1116 global treeheight treecontents cflist
1117
1118 foreach e $treecontents($prefix) {
1119 set path $prefix$e
1120 if {[highlight_tag $path] ne {}} {
1121 $cflist tag add bold $y.0 "$y.0 lineend"
1122 }
1123 incr y
1124 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1125 set y [highlight_tree $y $path]
1126 }
1127 }
1128 return $y
1129 }
1130
1131 proc treeclosedir {w dir} {
1132 global treediropen treeheight treeparent treeindex
1133
1134 set ix $treeindex($dir)
1135 $w conf -state normal
1136 $w delete s:$ix e:$ix
1137 set treediropen($dir) 0
1138 $w image configure a:$ix -image tri-rt
1139 $w conf -state disabled
1140 set n [expr {1 - $treeheight($dir)}]
1141 while {$dir ne {}} {
1142 incr treeheight($dir) $n
1143 set dir $treeparent($dir)
1144 }
1145 }
1146
1147 proc treeopendir {w dir} {
1148 global treediropen treeheight treeparent treecontents treeindex
1149
1150 set ix $treeindex($dir)
1151 $w conf -state normal
1152 $w image configure a:$ix -image tri-dn
1153 $w mark set e:$ix s:$ix
1154 $w mark gravity e:$ix right
1155 set lev 0
1156 set str "\n"
1157 set n [llength $treecontents($dir)]
1158 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1159 incr lev
1160 append str "\t"
1161 incr treeheight($x) $n
1162 }
1163 foreach e $treecontents($dir) {
1164 set de $dir$e
1165 if {[string index $e end] eq "/"} {
1166 set iy $treeindex($de)
1167 $w mark set d:$iy e:$ix
1168 $w mark gravity d:$iy left
1169 $w insert e:$ix $str
1170 set treediropen($de) 0
1171 $w image create e:$ix -align center -image tri-rt -padx 1 \
1172 -name a:$iy
1173 $w insert e:$ix $e [highlight_tag $de]
1174 $w mark set s:$iy e:$ix
1175 $w mark gravity s:$iy left
1176 set treeheight($de) 1
1177 } else {
1178 $w insert e:$ix $str
1179 $w insert e:$ix $e [highlight_tag $de]
1180 }
1181 }
1182 $w mark gravity e:$ix left
1183 $w conf -state disabled
1184 set treediropen($dir) 1
1185 set top [lindex [split [$w index @0,0] .] 0]
1186 set ht [$w cget -height]
1187 set l [lindex [split [$w index s:$ix] .] 0]
1188 if {$l < $top} {
1189 $w yview $l.0
1190 } elseif {$l + $n + 1 > $top + $ht} {
1191 set top [expr {$l + $n + 2 - $ht}]
1192 if {$l < $top} {
1193 set top $l
1194 }
1195 $w yview $top.0
1196 }
1197 }
1198
1199 proc treeclick {w x y} {
1200 global treediropen cmitmode ctext cflist cflist_top
1201
1202 if {$cmitmode ne "tree"} return
1203 if {![info exists cflist_top]} return
1204 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1205 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1206 $cflist tag add highlight $l.0 "$l.0 lineend"
1207 set cflist_top $l
1208 if {$l == 1} {
1209 $ctext yview 1.0
1210 return
1211 }
1212 set e [linetoelt $l]
1213 if {[string index $e end] ne "/"} {
1214 showfile $e
1215 } elseif {$treediropen($e)} {
1216 treeclosedir $w $e
1217 } else {
1218 treeopendir $w $e
1219 }
1220 }
1221
1222 proc setfilelist {id} {
1223 global treefilelist cflist
1224
1225 treeview $cflist $treefilelist($id) 0
1226 }
1227
1228 image create bitmap tri-rt -background black -foreground blue -data {
1229 #define tri-rt_width 13
1230 #define tri-rt_height 13
1231 static unsigned char tri-rt_bits[] = {
1232 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1233 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1234 0x00, 0x00};
1235 } -maskdata {
1236 #define tri-rt-mask_width 13
1237 #define tri-rt-mask_height 13
1238 static unsigned char tri-rt-mask_bits[] = {
1239 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1240 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1241 0x08, 0x00};
1242 }
1243 image create bitmap tri-dn -background black -foreground blue -data {
1244 #define tri-dn_width 13
1245 #define tri-dn_height 13
1246 static unsigned char tri-dn_bits[] = {
1247 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1248 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1249 0x00, 0x00};
1250 } -maskdata {
1251 #define tri-dn-mask_width 13
1252 #define tri-dn-mask_height 13
1253 static unsigned char tri-dn-mask_bits[] = {
1254 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1255 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1256 0x00, 0x00};
1257 }
1258
1259 proc init_flist {first} {
1260 global cflist cflist_top selectedline difffilestart
1261
1262 $cflist conf -state normal
1263 $cflist delete 0.0 end
1264 if {$first ne {}} {
1265 $cflist insert end $first
1266 set cflist_top 1
1267 $cflist tag add highlight 1.0 "1.0 lineend"
1268 } else {
1269 catch {unset cflist_top}
1270 }
1271 $cflist conf -state disabled
1272 set difffilestart {}
1273 }
1274
1275 proc highlight_tag {f} {
1276 global highlight_paths
1277
1278 foreach p $highlight_paths {
1279 if {[string match $p $f]} {
1280 return "bold"
1281 }
1282 }
1283 return {}
1284 }
1285
1286 proc highlight_filelist {} {
1287 global cmitmode cflist
1288
1289 $cflist conf -state normal
1290 if {$cmitmode ne "tree"} {
1291 set end [lindex [split [$cflist index end] .] 0]
1292 for {set l 2} {$l < $end} {incr l} {
1293 set line [$cflist get $l.0 "$l.0 lineend"]
1294 if {[highlight_tag $line] ne {}} {
1295 $cflist tag add bold $l.0 "$l.0 lineend"
1296 }
1297 }
1298 } else {
1299 highlight_tree 2 {}
1300 }
1301 $cflist conf -state disabled
1302 }
1303
1304 proc unhighlight_filelist {} {
1305 global cflist
1306
1307 $cflist conf -state normal
1308 $cflist tag remove bold 1.0 end
1309 $cflist conf -state disabled
1310 }
1311
1312 proc add_flist {fl} {
1313 global cflist
1314
1315 $cflist conf -state normal
1316 foreach f $fl {
1317 $cflist insert end "\n"
1318 $cflist insert end $f [highlight_tag $f]
1319 }
1320 $cflist conf -state disabled
1321 }
1322
1323 proc sel_flist {w x y} {
1324 global ctext difffilestart cflist cflist_top cmitmode
1325
1326 if {$cmitmode eq "tree"} return
1327 if {![info exists cflist_top]} return
1328 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1329 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1330 $cflist tag add highlight $l.0 "$l.0 lineend"
1331 set cflist_top $l
1332 if {$l == 1} {
1333 $ctext yview 1.0
1334 } else {
1335 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1336 }
1337 }
1338
1339 # Functions for adding and removing shell-type quoting
1340
1341 proc shellquote {str} {
1342 if {![string match "*\['\"\\ \t]*" $str]} {
1343 return $str
1344 }
1345 if {![string match "*\['\"\\]*" $str]} {
1346 return "\"$str\""
1347 }
1348 if {![string match "*'*" $str]} {
1349 return "'$str'"
1350 }
1351 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1352 }
1353
1354 proc shellarglist {l} {
1355 set str {}
1356 foreach a $l {
1357 if {$str ne {}} {
1358 append str " "
1359 }
1360 append str [shellquote $a]
1361 }
1362 return $str
1363 }
1364
1365 proc shelldequote {str} {
1366 set ret {}
1367 set used -1
1368 while {1} {
1369 incr used
1370 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1371 append ret [string range $str $used end]
1372 set used [string length $str]
1373 break
1374 }
1375 set first [lindex $first 0]
1376 set ch [string index $str $first]
1377 if {$first > $used} {
1378 append ret [string range $str $used [expr {$first - 1}]]
1379 set used $first
1380 }
1381 if {$ch eq " " || $ch eq "\t"} break
1382 incr used
1383 if {$ch eq "'"} {
1384 set first [string first "'" $str $used]
1385 if {$first < 0} {
1386 error "unmatched single-quote"
1387 }
1388 append ret [string range $str $used [expr {$first - 1}]]
1389 set used $first
1390 continue
1391 }
1392 if {$ch eq "\\"} {
1393 if {$used >= [string length $str]} {
1394 error "trailing backslash"
1395 }
1396 append ret [string index $str $used]
1397 continue
1398 }
1399 # here ch == "\""
1400 while {1} {
1401 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1402 error "unmatched double-quote"
1403 }
1404 set first [lindex $first 0]
1405 set ch [string index $str $first]
1406 if {$first > $used} {
1407 append ret [string range $str $used [expr {$first - 1}]]
1408 set used $first
1409 }
1410 if {$ch eq "\""} break
1411 incr used
1412 append ret [string index $str $used]
1413 incr used
1414 }
1415 }
1416 return [list $used $ret]
1417 }
1418
1419 proc shellsplit {str} {
1420 set l {}
1421 while {1} {
1422 set str [string trimleft $str]
1423 if {$str eq {}} break
1424 set dq [shelldequote $str]
1425 set n [lindex $dq 0]
1426 set word [lindex $dq 1]
1427 set str [string range $str $n end]
1428 lappend l $word
1429 }
1430 return $l
1431 }
1432
1433 # Code to implement multiple views
1434
1435 proc newview {ishighlight} {
1436 global nextviewnum newviewname newviewperm uifont newishighlight
1437 global newviewargs revtreeargs
1438
1439 set newishighlight $ishighlight
1440 set top .gitkview
1441 if {[winfo exists $top]} {
1442 raise $top
1443 return
1444 }
1445 set newviewname($nextviewnum) "View $nextviewnum"
1446 set newviewperm($nextviewnum) 0
1447 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1448 vieweditor $top $nextviewnum "Gitk view definition"
1449 }
1450
1451 proc editview {} {
1452 global curview
1453 global viewname viewperm newviewname newviewperm
1454 global viewargs newviewargs
1455
1456 set top .gitkvedit-$curview
1457 if {[winfo exists $top]} {
1458 raise $top
1459 return
1460 }
1461 set newviewname($curview) $viewname($curview)
1462 set newviewperm($curview) $viewperm($curview)
1463 set newviewargs($curview) [shellarglist $viewargs($curview)]
1464 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1465 }
1466
1467 proc vieweditor {top n title} {
1468 global newviewname newviewperm viewfiles
1469 global uifont
1470
1471 toplevel $top
1472 wm title $top $title
1473 label $top.nl -text "Name" -font $uifont
1474 entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1475 grid $top.nl $top.name -sticky w -pady 5
1476 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1477 -font $uifont
1478 grid $top.perm - -pady 5 -sticky w
1479 message $top.al -aspect 1000 -font $uifont \
1480 -text "Commits to include (arguments to git rev-list):"
1481 grid $top.al - -sticky w -pady 5
1482 entry $top.args -width 50 -textvariable newviewargs($n) \
1483 -background white -font $uifont
1484 grid $top.args - -sticky ew -padx 5
1485 message $top.l -aspect 1000 -font $uifont \
1486 -text "Enter files and directories to include, one per line:"
1487 grid $top.l - -sticky w
1488 text $top.t -width 40 -height 10 -background white -font $uifont
1489 if {[info exists viewfiles($n)]} {
1490 foreach f $viewfiles($n) {
1491 $top.t insert end $f
1492 $top.t insert end "\n"
1493 }
1494 $top.t delete {end - 1c} end
1495 $top.t mark set insert 0.0
1496 }
1497 grid $top.t - -sticky ew -padx 5
1498 frame $top.buts
1499 button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1500 -font $uifont
1501 button $top.buts.can -text "Cancel" -command [list destroy $top] \
1502 -font $uifont
1503 grid $top.buts.ok $top.buts.can
1504 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1505 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1506 grid $top.buts - -pady 10 -sticky ew
1507 focus $top.t
1508 }
1509
1510 proc doviewmenu {m first cmd op argv} {
1511 set nmenu [$m index end]
1512 for {set i $first} {$i <= $nmenu} {incr i} {
1513 if {[$m entrycget $i -command] eq $cmd} {
1514 eval $m $op $i $argv
1515 break
1516 }
1517 }
1518 }
1519
1520 proc allviewmenus {n op args} {
1521 global viewhlmenu
1522
1523 doviewmenu .bar.view 5 [list showview $n] $op $args
1524 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1525 }
1526
1527 proc newviewok {top n} {
1528 global nextviewnum newviewperm newviewname newishighlight
1529 global viewname viewfiles viewperm selectedview curview
1530 global viewargs newviewargs viewhlmenu
1531
1532 if {[catch {
1533 set newargs [shellsplit $newviewargs($n)]
1534 } err]} {
1535 error_popup "Error in commit selection arguments: $err"
1536 wm raise $top
1537 focus $top
1538 return
1539 }
1540 set files {}
1541 foreach f [split [$top.t get 0.0 end] "\n"] {
1542 set ft [string trim $f]
1543 if {$ft ne {}} {
1544 lappend files $ft
1545 }
1546 }
1547 if {![info exists viewfiles($n)]} {
1548 # creating a new view
1549 incr nextviewnum
1550 set viewname($n) $newviewname($n)
1551 set viewperm($n) $newviewperm($n)
1552 set viewfiles($n) $files
1553 set viewargs($n) $newargs
1554 addviewmenu $n
1555 if {!$newishighlight} {
1556 after idle showview $n
1557 } else {
1558 after idle addvhighlight $n
1559 }
1560 } else {
1561 # editing an existing view
1562 set viewperm($n) $newviewperm($n)
1563 if {$newviewname($n) ne $viewname($n)} {
1564 set viewname($n) $newviewname($n)
1565 doviewmenu .bar.view 5 [list showview $n] \
1566 entryconf [list -label $viewname($n)]
1567 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1568 entryconf [list -label $viewname($n) -value $viewname($n)]
1569 }
1570 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1571 set viewfiles($n) $files
1572 set viewargs($n) $newargs
1573 if {$curview == $n} {
1574 after idle updatecommits
1575 }
1576 }
1577 }
1578 catch {destroy $top}
1579 }
1580
1581 proc delview {} {
1582 global curview viewdata viewperm hlview selectedhlview
1583
1584 if {$curview == 0} return
1585 if {[info exists hlview] && $hlview == $curview} {
1586 set selectedhlview None
1587 unset hlview
1588 }
1589 allviewmenus $curview delete
1590 set viewdata($curview) {}
1591 set viewperm($curview) 0
1592 showview 0
1593 }
1594
1595 proc addviewmenu {n} {
1596 global viewname viewhlmenu
1597
1598 .bar.view add radiobutton -label $viewname($n) \
1599 -command [list showview $n] -variable selectedview -value $n
1600 $viewhlmenu add radiobutton -label $viewname($n) \
1601 -command [list addvhighlight $n] -variable selectedhlview
1602 }
1603
1604 proc flatten {var} {
1605 global $var
1606
1607 set ret {}
1608 foreach i [array names $var] {
1609 lappend ret $i [set $var\($i\)]
1610 }
1611 return $ret
1612 }
1613
1614 proc unflatten {var l} {
1615 global $var
1616
1617 catch {unset $var}
1618 foreach {i v} $l {
1619 set $var\($i\) $v
1620 }
1621 }
1622
1623 proc showview {n} {
1624 global curview viewdata viewfiles
1625 global displayorder parentlist childlist rowidlist rowoffsets
1626 global colormap rowtextx commitrow nextcolor canvxmax
1627 global numcommits rowrangelist commitlisted idrowranges
1628 global selectedline currentid canv canvy0
1629 global matchinglines treediffs
1630 global pending_select phase
1631 global commitidx rowlaidout rowoptim linesegends
1632 global commfd nextupdate
1633 global selectedview
1634 global vparentlist vchildlist vdisporder vcmitlisted
1635 global hlview selectedhlview
1636
1637 if {$n == $curview} return
1638 set selid {}
1639 if {[info exists selectedline]} {
1640 set selid $currentid
1641 set y [yc $selectedline]
1642 set ymax [lindex [$canv cget -scrollregion] 3]
1643 set span [$canv yview]
1644 set ytop [expr {[lindex $span 0] * $ymax}]
1645 set ybot [expr {[lindex $span 1] * $ymax}]
1646 if {$ytop < $y && $y < $ybot} {
1647 set yscreen [expr {$y - $ytop}]
1648 } else {
1649 set yscreen [expr {($ybot - $ytop) / 2}]
1650 }
1651 }
1652 unselectline
1653 normalline
1654 stopfindproc
1655 if {$curview >= 0} {
1656 set vparentlist($curview) $parentlist
1657 set vchildlist($curview) $childlist
1658 set vdisporder($curview) $displayorder
1659 set vcmitlisted($curview) $commitlisted
1660 if {$phase ne {}} {
1661 set viewdata($curview) \
1662 [list $phase $rowidlist $rowoffsets $rowrangelist \
1663 [flatten idrowranges] [flatten idinlist] \
1664 $rowlaidout $rowoptim $numcommits $linesegends]
1665 } elseif {![info exists viewdata($curview)]
1666 || [lindex $viewdata($curview) 0] ne {}} {
1667 set viewdata($curview) \
1668 [list {} $rowidlist $rowoffsets $rowrangelist]
1669 }
1670 }
1671 catch {unset matchinglines}
1672 catch {unset treediffs}
1673 clear_display
1674 if {[info exists hlview] && $hlview == $n} {
1675 unset hlview
1676 set selectedhlview None
1677 }
1678
1679 set curview $n
1680 set selectedview $n
1681 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1682 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1683
1684 if {![info exists viewdata($n)]} {
1685 set pending_select $selid
1686 getcommits
1687 return
1688 }
1689
1690 set v $viewdata($n)
1691 set phase [lindex $v 0]
1692 set displayorder $vdisporder($n)
1693 set parentlist $vparentlist($n)
1694 set childlist $vchildlist($n)
1695 set commitlisted $vcmitlisted($n)
1696 set rowidlist [lindex $v 1]
1697 set rowoffsets [lindex $v 2]
1698 set rowrangelist [lindex $v 3]
1699 if {$phase eq {}} {
1700 set numcommits [llength $displayorder]
1701 catch {unset idrowranges}
1702 } else {
1703 unflatten idrowranges [lindex $v 4]
1704 unflatten idinlist [lindex $v 5]
1705 set rowlaidout [lindex $v 6]
1706 set rowoptim [lindex $v 7]
1707 set numcommits [lindex $v 8]
1708 set linesegends [lindex $v 9]
1709 }
1710
1711 catch {unset colormap}
1712 catch {unset rowtextx}
1713 set nextcolor 0
1714 set canvxmax [$canv cget -width]
1715 set curview $n
1716 set row 0
1717 setcanvscroll
1718 set yf 0
1719 set row 0
1720 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1721 set row $commitrow($n,$selid)
1722 # try to get the selected row in the same position on the screen
1723 set ymax [lindex [$canv cget -scrollregion] 3]
1724 set ytop [expr {[yc $row] - $yscreen}]
1725 if {$ytop < 0} {
1726 set ytop 0
1727 }
1728 set yf [expr {$ytop * 1.0 / $ymax}]
1729 }
1730 allcanvs yview moveto $yf
1731 drawvisible
1732 selectline $row 0
1733 if {$phase ne {}} {
1734 if {$phase eq "getcommits"} {
1735 show_status "Reading commits..."
1736 }
1737 if {[info exists commfd($n)]} {
1738 layoutmore {}
1739 } else {
1740 finishcommits
1741 }
1742 } elseif {$numcommits == 0} {
1743 show_status "No commits selected"
1744 }
1745 }
1746
1747 # Stuff relating to the highlighting facility
1748
1749 proc ishighlighted {row} {
1750 global vhighlights fhighlights nhighlights rhighlights
1751
1752 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1753 return $nhighlights($row)
1754 }
1755 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1756 return $vhighlights($row)
1757 }
1758 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1759 return $fhighlights($row)
1760 }
1761 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1762 return $rhighlights($row)
1763 }
1764 return 0
1765 }
1766
1767 proc bolden {row font} {
1768 global canv linehtag selectedline boldrows
1769
1770 lappend boldrows $row
1771 $canv itemconf $linehtag($row) -font $font
1772 if {[info exists selectedline] && $row == $selectedline} {
1773 $canv delete secsel
1774 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1775 -outline {{}} -tags secsel \
1776 -fill [$canv cget -selectbackground]]
1777 $canv lower $t
1778 }
1779 }
1780
1781 proc bolden_name {row font} {
1782 global canv2 linentag selectedline boldnamerows
1783
1784 lappend boldnamerows $row
1785 $canv2 itemconf $linentag($row) -font $font
1786 if {[info exists selectedline] && $row == $selectedline} {
1787 $canv2 delete secsel
1788 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1789 -outline {{}} -tags secsel \
1790 -fill [$canv2 cget -selectbackground]]
1791 $canv2 lower $t
1792 }
1793 }
1794
1795 proc unbolden {} {
1796 global mainfont boldrows
1797
1798 set stillbold {}
1799 foreach row $boldrows {
1800 if {![ishighlighted $row]} {
1801 bolden $row $mainfont
1802 } else {
1803 lappend stillbold $row
1804 }
1805 }
1806 set boldrows $stillbold
1807 }
1808
1809 proc addvhighlight {n} {
1810 global hlview curview viewdata vhl_done vhighlights commitidx
1811
1812 if {[info exists hlview]} {
1813 delvhighlight
1814 }
1815 set hlview $n
1816 if {$n != $curview && ![info exists viewdata($n)]} {
1817 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1818 set vparentlist($n) {}
1819 set vchildlist($n) {}
1820 set vdisporder($n) {}
1821 set vcmitlisted($n) {}
1822 start_rev_list $n
1823 }
1824 set vhl_done $commitidx($hlview)
1825 if {$vhl_done > 0} {
1826 drawvisible
1827 }
1828 }
1829
1830 proc delvhighlight {} {
1831 global hlview vhighlights
1832
1833 if {![info exists hlview]} return
1834 unset hlview
1835 catch {unset vhighlights}
1836 unbolden
1837 }
1838
1839 proc vhighlightmore {} {
1840 global hlview vhl_done commitidx vhighlights
1841 global displayorder vdisporder curview mainfont
1842
1843 set font [concat $mainfont bold]
1844 set max $commitidx($hlview)
1845 if {$hlview == $curview} {
1846 set disp $displayorder
1847 } else {
1848 set disp $vdisporder($hlview)
1849 }
1850 set vr [visiblerows]
1851 set r0 [lindex $vr 0]
1852 set r1 [lindex $vr 1]
1853 for {set i $vhl_done} {$i < $max} {incr i} {
1854 set id [lindex $disp $i]
1855 if {[info exists commitrow($curview,$id)]} {
1856 set row $commitrow($curview,$id)
1857 if {$r0 <= $row && $row <= $r1} {
1858 if {![highlighted $row]} {
1859 bolden $row $font
1860 }
1861 set vhighlights($row) 1
1862 }
1863 }
1864 }
1865 set vhl_done $max
1866 }
1867
1868 proc askvhighlight {row id} {
1869 global hlview vhighlights commitrow iddrawn mainfont
1870
1871 if {[info exists commitrow($hlview,$id)]} {
1872 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1873 bolden $row [concat $mainfont bold]
1874 }
1875 set vhighlights($row) 1
1876 } else {
1877 set vhighlights($row) 0
1878 }
1879 }
1880
1881 proc hfiles_change {name ix op} {
1882 global highlight_files filehighlight fhighlights fh_serial
1883 global mainfont highlight_paths
1884
1885 if {[info exists filehighlight]} {
1886 # delete previous highlights
1887 catch {close $filehighlight}
1888 unset filehighlight
1889 catch {unset fhighlights}
1890 unbolden
1891 unhighlight_filelist
1892 }
1893 set highlight_paths {}
1894 after cancel do_file_hl $fh_serial
1895 incr fh_serial
1896 if {$highlight_files ne {}} {
1897 after 300 do_file_hl $fh_serial
1898 }
1899 }
1900
1901 proc makepatterns {l} {
1902 set ret {}
1903 foreach e $l {
1904 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1905 if {[string index $ee end] eq "/"} {
1906 lappend ret "$ee*"
1907 } else {
1908 lappend ret $ee
1909 lappend ret "$ee/*"
1910 }
1911 }
1912 return $ret
1913 }
1914
1915 proc do_file_hl {serial} {
1916 global highlight_files filehighlight highlight_paths gdttype fhl_list
1917
1918 if {$gdttype eq "touching paths:"} {
1919 if {[catch {set paths [shellsplit $highlight_files]}]} return
1920 set highlight_paths [makepatterns $paths]
1921 highlight_filelist
1922 set gdtargs [concat -- $paths]
1923 } else {
1924 set gdtargs [list "-S$highlight_files"]
1925 }
1926 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1927 set filehighlight [open $cmd r+]
1928 fconfigure $filehighlight -blocking 0
1929 fileevent $filehighlight readable readfhighlight
1930 set fhl_list {}
1931 drawvisible
1932 flushhighlights
1933 }
1934
1935 proc flushhighlights {} {
1936 global filehighlight fhl_list
1937
1938 if {[info exists filehighlight]} {
1939 lappend fhl_list {}
1940 puts $filehighlight ""
1941 flush $filehighlight
1942 }
1943 }
1944
1945 proc askfilehighlight {row id} {
1946 global filehighlight fhighlights fhl_list
1947
1948 lappend fhl_list $id
1949 set fhighlights($row) -1
1950 puts $filehighlight $id
1951 }
1952
1953 proc readfhighlight {} {
1954 global filehighlight fhighlights commitrow curview mainfont iddrawn
1955 global fhl_list
1956
1957 while {[gets $filehighlight line] >= 0} {
1958 set line [string trim $line]
1959 set i [lsearch -exact $fhl_list $line]
1960 if {$i < 0} continue
1961 for {set j 0} {$j < $i} {incr j} {
1962 set id [lindex $fhl_list $j]
1963 if {[info exists commitrow($curview,$id)]} {
1964 set fhighlights($commitrow($curview,$id)) 0
1965 }
1966 }
1967 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1968 if {$line eq {}} continue
1969 if {![info exists commitrow($curview,$line)]} continue
1970 set row $commitrow($curview,$line)
1971 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1972 bolden $row [concat $mainfont bold]
1973 }
1974 set fhighlights($row) 1
1975 }
1976 if {[eof $filehighlight]} {
1977 # strange...
1978 puts "oops, git diff-tree died"
1979 catch {close $filehighlight}
1980 unset filehighlight
1981 }
1982 next_hlcont
1983 }
1984
1985 proc find_change {name ix op} {
1986 global nhighlights mainfont boldnamerows
1987 global findstring findpattern findtype
1988
1989 # delete previous highlights, if any
1990 foreach row $boldnamerows {
1991 bolden_name $row $mainfont
1992 }
1993 set boldnamerows {}
1994 catch {unset nhighlights}
1995 unbolden
1996 if {$findtype ne "Regexp"} {
1997 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1998 $findstring]
1999 set findpattern "*$e*"
2000 }
2001 drawvisible
2002 }
2003
2004 proc askfindhighlight {row id} {
2005 global nhighlights commitinfo iddrawn mainfont
2006 global findstring findtype findloc findpattern
2007
2008 if {![info exists commitinfo($id)]} {
2009 getcommit $id
2010 }
2011 set info $commitinfo($id)
2012 set isbold 0
2013 set fldtypes {Headline Author Date Committer CDate Comments}
2014 foreach f $info ty $fldtypes {
2015 if {$findloc ne "All fields" && $findloc ne $ty} {
2016 continue
2017 }
2018 if {$findtype eq "Regexp"} {
2019 set doesmatch [regexp $findstring $f]
2020 } elseif {$findtype eq "IgnCase"} {
2021 set doesmatch [string match -nocase $findpattern $f]
2022 } else {
2023 set doesmatch [string match $findpattern $f]
2024 }
2025 if {$doesmatch} {
2026 if {$ty eq "Author"} {
2027 set isbold 2
2028 } else {
2029 set isbold 1
2030 }
2031 }
2032 }
2033 if {[info exists iddrawn($id)]} {
2034 if {$isbold && ![ishighlighted $row]} {
2035 bolden $row [concat $mainfont bold]
2036 }
2037 if {$isbold >= 2} {
2038 bolden_name $row [concat $mainfont bold]
2039 }
2040 }
2041 set nhighlights($row) $isbold
2042 }
2043
2044 proc vrel_change {name ix op} {
2045 global highlight_related
2046
2047 rhighlight_none
2048 if {$highlight_related ne "None"} {
2049 after idle drawvisible
2050 }
2051 }
2052
2053 # prepare for testing whether commits are descendents or ancestors of a
2054 proc rhighlight_sel {a} {
2055 global descendent desc_todo ancestor anc_todo
2056 global highlight_related rhighlights
2057
2058 catch {unset descendent}
2059 set desc_todo [list $a]
2060 catch {unset ancestor}
2061 set anc_todo [list $a]
2062 if {$highlight_related ne "None"} {
2063 rhighlight_none
2064 after idle drawvisible
2065 }
2066 }
2067
2068 proc rhighlight_none {} {
2069 global rhighlights
2070
2071 catch {unset rhighlights}
2072 unbolden
2073 }
2074
2075 proc is_descendent {a} {
2076 global curview children commitrow descendent desc_todo
2077
2078 set v $curview
2079 set la $commitrow($v,$a)
2080 set todo $desc_todo
2081 set leftover {}
2082 set done 0
2083 for {set i 0} {$i < [llength $todo]} {incr i} {
2084 set do [lindex $todo $i]
2085 if {$commitrow($v,$do) < $la} {
2086 lappend leftover $do
2087 continue
2088 }
2089 foreach nk $children($v,$do) {
2090 if {![info exists descendent($nk)]} {
2091 set descendent($nk) 1
2092 lappend todo $nk
2093 if {$nk eq $a} {
2094 set done 1
2095 }
2096 }
2097 }
2098 if {$done} {
2099 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2100 return
2101 }
2102 }
2103 set descendent($a) 0
2104 set desc_todo $leftover
2105 }
2106
2107 proc is_ancestor {a} {
2108 global curview parentlist commitrow ancestor anc_todo
2109
2110 set v $curview
2111 set la $commitrow($v,$a)
2112 set todo $anc_todo
2113 set leftover {}
2114 set done 0
2115 for {set i 0} {$i < [llength $todo]} {incr i} {
2116 set do [lindex $todo $i]
2117 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2118 lappend leftover $do
2119 continue
2120 }
2121 foreach np [lindex $parentlist $commitrow($v,$do)] {
2122 if {![info exists ancestor($np)]} {
2123 set ancestor($np) 1
2124 lappend todo $np
2125 if {$np eq $a} {
2126 set done 1
2127 }
2128 }
2129 }
2130 if {$done} {
2131 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2132 return
2133 }
2134 }
2135 set ancestor($a) 0
2136 set anc_todo $leftover
2137 }
2138
2139 proc askrelhighlight {row id} {
2140 global descendent highlight_related iddrawn mainfont rhighlights
2141 global selectedline ancestor
2142
2143 if {![info exists selectedline]} return
2144 set isbold 0
2145 if {$highlight_related eq "Descendent" ||
2146 $highlight_related eq "Not descendent"} {
2147 if {![info exists descendent($id)]} {
2148 is_descendent $id
2149 }
2150 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2151 set isbold 1
2152 }
2153 } elseif {$highlight_related eq "Ancestor" ||
2154 $highlight_related eq "Not ancestor"} {
2155 if {![info exists ancestor($id)]} {
2156 is_ancestor $id
2157 }
2158 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2159 set isbold 1
2160 }
2161 }
2162 if {[info exists iddrawn($id)]} {
2163 if {$isbold && ![ishighlighted $row]} {
2164 bolden $row [concat $mainfont bold]
2165 }
2166 }
2167 set rhighlights($row) $isbold
2168 }
2169
2170 proc next_hlcont {} {
2171 global fhl_row fhl_dirn displayorder numcommits
2172 global vhighlights fhighlights nhighlights rhighlights
2173 global hlview filehighlight findstring highlight_related
2174
2175 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2176 set row $fhl_row
2177 while {1} {
2178 if {$row < 0 || $row >= $numcommits} {
2179 bell
2180 set fhl_dirn 0
2181 return
2182 }
2183 set id [lindex $displayorder $row]
2184 if {[info exists hlview]} {
2185 if {![info exists vhighlights($row)]} {
2186 askvhighlight $row $id
2187 }
2188 if {$vhighlights($row) > 0} break
2189 }
2190 if {$findstring ne {}} {
2191 if {![info exists nhighlights($row)]} {
2192 askfindhighlight $row $id
2193 }
2194 if {$nhighlights($row) > 0} break
2195 }
2196 if {$highlight_related ne "None"} {
2197 if {![info exists rhighlights($row)]} {
2198 askrelhighlight $row $id
2199 }
2200 if {$rhighlights($row) > 0} break
2201 }
2202 if {[info exists filehighlight]} {
2203 if {![info exists fhighlights($row)]} {
2204 # ask for a few more while we're at it...
2205 set r $row
2206 for {set n 0} {$n < 100} {incr n} {
2207 if {![info exists fhighlights($r)]} {
2208 askfilehighlight $r [lindex $displayorder $r]
2209 }
2210 incr r $fhl_dirn
2211 if {$r < 0 || $r >= $numcommits} break
2212 }
2213 flushhighlights
2214 }
2215 if {$fhighlights($row) < 0} {
2216 set fhl_row $row
2217 return
2218 }
2219 if {$fhighlights($row) > 0} break
2220 }
2221 incr row $fhl_dirn
2222 }
2223 set fhl_dirn 0
2224 selectline $row 1
2225 }
2226
2227 proc next_highlight {dirn} {
2228 global selectedline fhl_row fhl_dirn
2229 global hlview filehighlight findstring highlight_related
2230
2231 if {![info exists selectedline]} return
2232 if {!([info exists hlview] || $findstring ne {} ||
2233 $highlight_related ne "None" || [info exists filehighlight])} return
2234 set fhl_row [expr {$selectedline + $dirn}]
2235 set fhl_dirn $dirn
2236 next_hlcont
2237 }
2238
2239 proc cancel_next_highlight {} {
2240 global fhl_dirn
2241
2242 set fhl_dirn 0
2243 }
2244
2245 # Graph layout functions
2246
2247 proc shortids {ids} {
2248 set res {}
2249 foreach id $ids {
2250 if {[llength $id] > 1} {
2251 lappend res [shortids $id]
2252 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2253 lappend res [string range $id 0 7]
2254 } else {
2255 lappend res $id
2256 }
2257 }
2258 return $res
2259 }
2260
2261 proc incrange {l x o} {
2262 set n [llength $l]
2263 while {$x < $n} {
2264 set e [lindex $l $x]
2265 if {$e ne {}} {
2266 lset l $x [expr {$e + $o}]
2267 }
2268 incr x
2269 }
2270 return $l
2271 }
2272
2273 proc ntimes {n o} {
2274 set ret {}
2275 for {} {$n > 0} {incr n -1} {
2276 lappend ret $o
2277 }
2278 return $ret
2279 }
2280
2281 proc usedinrange {id l1 l2} {
2282 global children commitrow childlist curview
2283
2284 if {[info exists commitrow($curview,$id)]} {
2285 set r $commitrow($curview,$id)
2286 if {$l1 <= $r && $r <= $l2} {
2287 return [expr {$r - $l1 + 1}]
2288 }
2289 set kids [lindex $childlist $r]
2290 } else {
2291 set kids $children($curview,$id)
2292 }
2293 foreach c $kids {
2294 set r $commitrow($curview,$c)
2295 if {$l1 <= $r && $r <= $l2} {
2296 return [expr {$r - $l1 + 1}]
2297 }
2298 }
2299 return 0
2300 }
2301
2302 proc sanity {row {full 0}} {
2303 global rowidlist rowoffsets
2304
2305 set col -1
2306 set ids [lindex $rowidlist $row]
2307 foreach id $ids {
2308 incr col
2309 if {$id eq {}} continue
2310 if {$col < [llength $ids] - 1 &&
2311 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2312 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2313 }
2314 set o [lindex $rowoffsets $row $col]
2315 set y $row
2316 set x $col
2317 while {$o ne {}} {
2318 incr y -1
2319 incr x $o
2320 if {[lindex $rowidlist $y $x] != $id} {
2321 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2322 puts " id=[shortids $id] check started at row $row"
2323 for {set i $row} {$i >= $y} {incr i -1} {
2324 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2325 }
2326 break
2327 }
2328 if {!$full} break
2329 set o [lindex $rowoffsets $y $x]
2330 }
2331 }
2332 }
2333
2334 proc makeuparrow {oid x y z} {
2335 global rowidlist rowoffsets uparrowlen idrowranges
2336
2337 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2338 incr y -1
2339 incr x $z
2340 set off0 [lindex $rowoffsets $y]
2341 for {set x0 $x} {1} {incr x0} {
2342 if {$x0 >= [llength $off0]} {
2343 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2344 break
2345 }
2346 set z [lindex $off0 $x0]
2347 if {$z ne {}} {
2348 incr x0 $z
2349 break
2350 }
2351 }
2352 set z [expr {$x0 - $x}]
2353 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2354 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2355 }
2356 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2357 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2358 lappend idrowranges($oid) $y
2359 }
2360
2361 proc initlayout {} {
2362 global rowidlist rowoffsets displayorder commitlisted
2363 global rowlaidout rowoptim
2364 global idinlist rowchk rowrangelist idrowranges
2365 global numcommits canvxmax canv
2366 global nextcolor
2367 global parentlist childlist children
2368 global colormap rowtextx
2369 global linesegends
2370
2371 set numcommits 0
2372 set displayorder {}
2373 set commitlisted {}
2374 set parentlist {}
2375 set childlist {}
2376 set rowrangelist {}
2377 set nextcolor 0
2378 set rowidlist {{}}
2379 set rowoffsets {{}}
2380 catch {unset idinlist}
2381 catch {unset rowchk}
2382 set rowlaidout 0
2383 set rowoptim 0
2384 set canvxmax [$canv cget -width]
2385 catch {unset colormap}
2386 catch {unset rowtextx}
2387 catch {unset idrowranges}
2388 set linesegends {}
2389 }
2390
2391 proc setcanvscroll {} {
2392 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2393
2394 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2395 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2396 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2397 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2398 }
2399
2400 proc visiblerows {} {
2401 global canv numcommits linespc
2402
2403 set ymax [lindex [$canv cget -scrollregion] 3]
2404 if {$ymax eq {} || $ymax == 0} return
2405 set f [$canv yview]
2406 set y0 [expr {int([lindex $f 0] * $ymax)}]
2407 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2408 if {$r0 < 0} {
2409 set r0 0
2410 }
2411 set y1 [expr {int([lindex $f 1] * $ymax)}]
2412 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2413 if {$r1 >= $numcommits} {
2414 set r1 [expr {$numcommits - 1}]
2415 }
2416 return [list $r0 $r1]
2417 }
2418
2419 proc layoutmore {tmax} {
2420 global rowlaidout rowoptim commitidx numcommits optim_delay
2421 global uparrowlen curview
2422
2423 while {1} {
2424 if {$rowoptim - $optim_delay > $numcommits} {
2425 showstuff [expr {$rowoptim - $optim_delay}]
2426 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2427 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2428 if {$nr > 100} {
2429 set nr 100
2430 }
2431 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2432 incr rowoptim $nr
2433 } elseif {$commitidx($curview) > $rowlaidout} {
2434 set nr [expr {$commitidx($curview) - $rowlaidout}]
2435 # may need to increase this threshold if uparrowlen or
2436 # mingaplen are increased...
2437 if {$nr > 150} {
2438 set nr 150
2439 }
2440 set row $rowlaidout
2441 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2442 if {$rowlaidout == $row} {
2443 return 0
2444 }
2445 } else {
2446 return 0
2447 }
2448 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2449 return 1
2450 }
2451 }
2452 }
2453
2454 proc showstuff {canshow} {
2455 global numcommits commitrow pending_select selectedline
2456 global linesegends idrowranges idrangedrawn curview
2457
2458 if {$numcommits == 0} {
2459 global phase
2460 set phase "incrdraw"
2461 allcanvs delete all
2462 }
2463 set row $numcommits
2464 set numcommits $canshow
2465 setcanvscroll
2466 set rows [visiblerows]
2467 set r0 [lindex $rows 0]
2468 set r1 [lindex $rows 1]
2469 set selrow -1
2470 for {set r $row} {$r < $canshow} {incr r} {
2471 foreach id [lindex $linesegends [expr {$r+1}]] {
2472 set i -1
2473 foreach {s e} [rowranges $id] {
2474 incr i
2475 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2476 && ![info exists idrangedrawn($id,$i)]} {
2477 drawlineseg $id $i
2478 set idrangedrawn($id,$i) 1
2479 }
2480 }
2481 }
2482 }
2483 if {$canshow > $r1} {
2484 set canshow $r1
2485 }
2486 while {$row < $canshow} {
2487 drawcmitrow $row
2488 incr row
2489 }
2490 if {[info exists pending_select] &&
2491 [info exists commitrow($curview,$pending_select)] &&
2492 $commitrow($curview,$pending_select) < $numcommits} {
2493 selectline $commitrow($curview,$pending_select) 1
2494 }
2495 if {![info exists selectedline] && ![info exists pending_select]} {
2496 selectline 0 1
2497 }
2498 }
2499
2500 proc layoutrows {row endrow last} {
2501 global rowidlist rowoffsets displayorder
2502 global uparrowlen downarrowlen maxwidth mingaplen
2503 global childlist parentlist
2504 global idrowranges linesegends
2505 global commitidx curview
2506 global idinlist rowchk rowrangelist
2507
2508 set idlist [lindex $rowidlist $row]
2509 set offs [lindex $rowoffsets $row]
2510 while {$row < $endrow} {
2511 set id [lindex $displayorder $row]
2512 set oldolds {}
2513 set newolds {}
2514 foreach p [lindex $parentlist $row] {
2515 if {![info exists idinlist($p)]} {
2516 lappend newolds $p
2517 } elseif {!$idinlist($p)} {
2518 lappend oldolds $p
2519 }
2520 }
2521 set lse {}
2522 set nev [expr {[llength $idlist] + [llength $newolds]
2523 + [llength $oldolds] - $maxwidth + 1}]
2524 if {$nev > 0} {
2525 if {!$last &&
2526 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2527 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2528 set i [lindex $idlist $x]
2529 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2530 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2531 [expr {$row + $uparrowlen + $mingaplen}]]
2532 if {$r == 0} {
2533 set idlist [lreplace $idlist $x $x]
2534 set offs [lreplace $offs $x $x]
2535 set offs [incrange $offs $x 1]
2536 set idinlist($i) 0
2537 set rm1 [expr {$row - 1}]
2538 lappend lse $i
2539 lappend idrowranges($i) $rm1
2540 if {[incr nev -1] <= 0} break
2541 continue
2542 }
2543 set rowchk($id) [expr {$row + $r}]
2544 }
2545 }
2546 lset rowidlist $row $idlist
2547 lset rowoffsets $row $offs
2548 }
2549 lappend linesegends $lse
2550 set col [lsearch -exact $idlist $id]
2551 if {$col < 0} {
2552 set col [llength $idlist]
2553 lappend idlist $id
2554 lset rowidlist $row $idlist
2555 set z {}
2556 if {[lindex $childlist $row] ne {}} {
2557 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2558 unset idinlist($id)
2559 }
2560 lappend offs $z
2561 lset rowoffsets $row $offs
2562 if {$z ne {}} {
2563 makeuparrow $id $col $row $z
2564 }
2565 } else {
2566 unset idinlist($id)
2567 }
2568 set ranges {}
2569 if {[info exists idrowranges($id)]} {
2570 set ranges $idrowranges($id)
2571 lappend ranges $row
2572 unset idrowranges($id)
2573 }
2574 lappend rowrangelist $ranges
2575 incr row
2576 set offs [ntimes [llength $idlist] 0]
2577 set l [llength $newolds]
2578 set idlist [eval lreplace \$idlist $col $col $newolds]
2579 set o 0
2580 if {$l != 1} {
2581 set offs [lrange $offs 0 [expr {$col - 1}]]
2582 foreach x $newolds {
2583 lappend offs {}
2584 incr o -1
2585 }
2586 incr o
2587 set tmp [expr {[llength $idlist] - [llength $offs]}]
2588 if {$tmp > 0} {
2589 set offs [concat $offs [ntimes $tmp $o]]
2590 }
2591 } else {
2592 lset offs $col {}
2593 }
2594 foreach i $newolds {
2595 set idinlist($i) 1
2596 set idrowranges($i) $row
2597 }
2598 incr col $l
2599 foreach oid $oldolds {
2600 set idinlist($oid) 1
2601 set idlist [linsert $idlist $col $oid]
2602 set offs [linsert $offs $col $o]
2603 makeuparrow $oid $col $row $o
2604 incr col
2605 }
2606 lappend rowidlist $idlist
2607 lappend rowoffsets $offs
2608 }
2609 return $row
2610 }
2611
2612 proc addextraid {id row} {
2613 global displayorder commitrow commitinfo
2614 global commitidx commitlisted
2615 global parentlist childlist children curview
2616
2617 incr commitidx($curview)
2618 lappend displayorder $id
2619 lappend commitlisted 0
2620 lappend parentlist {}
2621 set commitrow($curview,$id) $row
2622 readcommit $id
2623 if {![info exists commitinfo($id)]} {
2624 set commitinfo($id) {"No commit information available"}
2625 }
2626 if {![info exists children($curview,$id)]} {
2627 set children($curview,$id) {}
2628 }
2629 lappend childlist $children($curview,$id)
2630 }
2631
2632 proc layouttail {} {
2633 global rowidlist rowoffsets idinlist commitidx curview
2634 global idrowranges rowrangelist
2635
2636 set row $commitidx($curview)
2637 set idlist [lindex $rowidlist $row]
2638 while {$idlist ne {}} {
2639 set col [expr {[llength $idlist] - 1}]
2640 set id [lindex $idlist $col]
2641 addextraid $id $row
2642 unset idinlist($id)
2643 lappend idrowranges($id) $row
2644 lappend rowrangelist $idrowranges($id)
2645 unset idrowranges($id)
2646 incr row
2647 set offs [ntimes $col 0]
2648 set idlist [lreplace $idlist $col $col]
2649 lappend rowidlist $idlist
2650 lappend rowoffsets $offs
2651 }
2652
2653 foreach id [array names idinlist] {
2654 addextraid $id $row
2655 lset rowidlist $row [list $id]
2656 lset rowoffsets $row 0
2657 makeuparrow $id 0 $row 0
2658 lappend idrowranges($id) $row
2659 lappend rowrangelist $idrowranges($id)
2660 unset idrowranges($id)
2661 incr row
2662 lappend rowidlist {}
2663 lappend rowoffsets {}
2664 }
2665 }
2666
2667 proc insert_pad {row col npad} {
2668 global rowidlist rowoffsets
2669
2670 set pad [ntimes $npad {}]
2671 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2672 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2673 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2674 }
2675
2676 proc optimize_rows {row col endrow} {
2677 global rowidlist rowoffsets idrowranges displayorder
2678
2679 for {} {$row < $endrow} {incr row} {
2680 set idlist [lindex $rowidlist $row]
2681 set offs [lindex $rowoffsets $row]
2682 set haspad 0
2683 for {} {$col < [llength $offs]} {incr col} {
2684 if {[lindex $idlist $col] eq {}} {
2685 set haspad 1
2686 continue
2687 }
2688 set z [lindex $offs $col]
2689 if {$z eq {}} continue
2690 set isarrow 0
2691 set x0 [expr {$col + $z}]
2692 set y0 [expr {$row - 1}]
2693 set z0 [lindex $rowoffsets $y0 $x0]
2694 if {$z0 eq {}} {
2695 set id [lindex $idlist $col]
2696 set ranges [rowranges $id]
2697 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2698 set isarrow 1
2699 }
2700 }
2701 if {$z < -1 || ($z < 0 && $isarrow)} {
2702 set npad [expr {-1 - $z + $isarrow}]
2703 set offs [incrange $offs $col $npad]
2704 insert_pad $y0 $x0 $npad
2705 if {$y0 > 0} {
2706 optimize_rows $y0 $x0 $row
2707 }
2708 set z [lindex $offs $col]
2709 set x0 [expr {$col + $z}]
2710 set z0 [lindex $rowoffsets $y0 $x0]
2711 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2712 set npad [expr {$z - 1 + $isarrow}]
2713 set y1 [expr {$row + 1}]
2714 set offs2 [lindex $rowoffsets $y1]
2715 set x1 -1
2716 foreach z $offs2 {
2717 incr x1
2718 if {$z eq {} || $x1 + $z < $col} continue
2719 if {$x1 + $z > $col} {
2720 incr npad
2721 }
2722 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2723 break
2724 }
2725 set pad [ntimes $npad {}]
2726 set idlist [eval linsert \$idlist $col $pad]
2727 set tmp [eval linsert \$offs $col $pad]
2728 incr col $npad
2729 set offs [incrange $tmp $col [expr {-$npad}]]
2730 set z [lindex $offs $col]
2731 set haspad 1
2732 }
2733 if {$z0 eq {} && !$isarrow} {
2734 # this line links to its first child on row $row-2
2735 set rm2 [expr {$row - 2}]
2736 set id [lindex $displayorder $rm2]
2737 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2738 if {$xc >= 0} {
2739 set z0 [expr {$xc - $x0}]
2740 }
2741 }
2742 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2743 insert_pad $y0 $x0 1
2744 set offs [incrange $offs $col 1]
2745 optimize_rows $y0 [expr {$x0 + 1}] $row
2746 }
2747 }
2748 if {!$haspad} {
2749 set o {}
2750 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2751 set o [lindex $offs $col]
2752 if {$o eq {}} {
2753 # check if this is the link to the first child
2754 set id [lindex $idlist $col]
2755 set ranges [rowranges $id]
2756 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2757 # it is, work out offset to child
2758 set y0 [expr {$row - 1}]
2759 set id [lindex $displayorder $y0]
2760 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2761 if {$x0 >= 0} {
2762 set o [expr {$x0 - $col}]
2763 }
2764 }
2765 }
2766 if {$o eq {} || $o <= 0} break
2767 }
2768 if {$o ne {} && [incr col] < [llength $idlist]} {
2769 set y1 [expr {$row + 1}]
2770 set offs2 [lindex $rowoffsets $y1]
2771 set x1 -1
2772 foreach z $offs2 {
2773 incr x1
2774 if {$z eq {} || $x1 + $z < $col} continue
2775 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2776 break
2777 }
2778 set idlist [linsert $idlist $col {}]
2779 set tmp [linsert $offs $col {}]
2780 incr col
2781 set offs [incrange $tmp $col -1]
2782 }
2783 }
2784 lset rowidlist $row $idlist
2785 lset rowoffsets $row $offs
2786 set col 0
2787 }
2788 }
2789
2790 proc xc {row col} {
2791 global canvx0 linespc
2792 return [expr {$canvx0 + $col * $linespc}]
2793 }
2794
2795 proc yc {row} {
2796 global canvy0 linespc
2797 return [expr {$canvy0 + $row * $linespc}]
2798 }
2799
2800 proc linewidth {id} {
2801 global thickerline lthickness
2802
2803 set wid $lthickness
2804 if {[info exists thickerline] && $id eq $thickerline} {
2805 set wid [expr {2 * $lthickness}]
2806 }
2807 return $wid
2808 }
2809
2810 proc rowranges {id} {
2811 global phase idrowranges commitrow rowlaidout rowrangelist curview
2812
2813 set ranges {}
2814 if {$phase eq {} ||
2815 ([info exists commitrow($curview,$id)]
2816 && $commitrow($curview,$id) < $rowlaidout)} {
2817 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2818 } elseif {[info exists idrowranges($id)]} {
2819 set ranges $idrowranges($id)
2820 }
2821 return $ranges
2822 }
2823
2824 proc drawlineseg {id i} {
2825 global rowoffsets rowidlist
2826 global displayorder
2827 global canv colormap linespc
2828 global numcommits commitrow curview
2829
2830 set ranges [rowranges $id]
2831 set downarrow 1
2832 if {[info exists commitrow($curview,$id)]
2833 && $commitrow($curview,$id) < $numcommits} {
2834 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2835 } else {
2836 set downarrow 1
2837 }
2838 set startrow [lindex $ranges [expr {2 * $i}]]
2839 set row [lindex $ranges [expr {2 * $i + 1}]]
2840 if {$startrow == $row} return
2841 assigncolor $id
2842 set coords {}
2843 set col [lsearch -exact [lindex $rowidlist $row] $id]
2844 if {$col < 0} {
2845 puts "oops: drawline: id $id not on row $row"
2846 return
2847 }
2848 set lasto {}
2849 set ns 0
2850 while {1} {
2851 set o [lindex $rowoffsets $row $col]
2852 if {$o eq {}} break
2853 if {$o ne $lasto} {
2854 # changing direction
2855 set x [xc $row $col]
2856 set y [yc $row]
2857 lappend coords $x $y
2858 set lasto $o
2859 }
2860 incr col $o
2861 incr row -1
2862 }
2863 set x [xc $row $col]
2864 set y [yc $row]
2865 lappend coords $x $y
2866 if {$i == 0} {
2867 # draw the link to the first child as part of this line
2868 incr row -1
2869 set child [lindex $displayorder $row]
2870 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2871 if {$ccol >= 0} {
2872 set x [xc $row $ccol]
2873 set y [yc $row]
2874 if {$ccol < $col - 1} {
2875 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2876 } elseif {$ccol > $col + 1} {
2877 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2878 }
2879 lappend coords $x $y
2880 }
2881 }
2882 if {[llength $coords] < 4} return
2883 if {$downarrow} {
2884 # This line has an arrow at the lower end: check if the arrow is
2885 # on a diagonal segment, and if so, work around the Tk 8.4
2886 # refusal to draw arrows on diagonal lines.
2887 set x0 [lindex $coords 0]
2888 set x1 [lindex $coords 2]
2889 if {$x0 != $x1} {
2890 set y0 [lindex $coords 1]
2891 set y1 [lindex $coords 3]
2892 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2893 # we have a nearby vertical segment, just trim off the diag bit
2894 set coords [lrange $coords 2 end]
2895 } else {
2896 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2897 set xi [expr {$x0 - $slope * $linespc / 2}]
2898 set yi [expr {$y0 - $linespc / 2}]
2899 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2900 }
2901 }
2902 }
2903 set arrow [expr {2 * ($i > 0) + $downarrow}]
2904 set arrow [lindex {none first last both} $arrow]
2905 set t [$canv create line $coords -width [linewidth $id] \
2906 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2907 $canv lower $t
2908 bindline $t $id
2909 }
2910
2911 proc drawparentlinks {id row col olds} {
2912 global rowidlist canv colormap
2913
2914 set row2 [expr {$row + 1}]
2915 set x [xc $row $col]
2916 set y [yc $row]
2917 set y2 [yc $row2]
2918 set ids [lindex $rowidlist $row2]
2919 # rmx = right-most X coord used
2920 set rmx 0
2921 foreach p $olds {
2922 set i [lsearch -exact $ids $p]
2923 if {$i < 0} {
2924 puts "oops, parent $p of $id not in list"
2925 continue
2926 }
2927 set x2 [xc $row2 $i]
2928 if {$x2 > $rmx} {
2929 set rmx $x2
2930 }
2931 set ranges [rowranges $p]
2932 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2933 && $row2 < [lindex $ranges 1]} {
2934 # drawlineseg will do this one for us
2935 continue
2936 }
2937 assigncolor $p
2938 # should handle duplicated parents here...
2939 set coords [list $x $y]
2940 if {$i < $col - 1} {
2941 lappend coords [xc $row [expr {$i + 1}]] $y
2942 } elseif {$i > $col + 1} {
2943 lappend coords [xc $row [expr {$i - 1}]] $y
2944 }
2945 lappend coords $x2 $y2
2946 set t [$canv create line $coords -width [linewidth $p] \
2947 -fill $colormap($p) -tags lines.$p]
2948 $canv lower $t
2949 bindline $t $p
2950 }
2951 return $rmx
2952 }
2953
2954 proc drawlines {id} {
2955 global colormap canv
2956 global idrangedrawn
2957 global children iddrawn commitrow rowidlist curview
2958
2959 $canv delete lines.$id
2960 set nr [expr {[llength [rowranges $id]] / 2}]
2961 for {set i 0} {$i < $nr} {incr i} {
2962 if {[info exists idrangedrawn($id,$i)]} {
2963 drawlineseg $id $i
2964 }
2965 }
2966 foreach child $children($curview,$id) {
2967 if {[info exists iddrawn($child)]} {
2968 set row $commitrow($curview,$child)
2969 set col [lsearch -exact [lindex $rowidlist $row] $child]
2970 if {$col >= 0} {
2971 drawparentlinks $child $row $col [list $id]
2972 }
2973 }
2974 }
2975 }
2976
2977 proc drawcmittext {id row col rmx} {
2978 global linespc canv canv2 canv3 canvy0 fgcolor
2979 global commitlisted commitinfo rowidlist
2980 global rowtextx idpos idtags idheads idotherrefs
2981 global linehtag linentag linedtag
2982 global mainfont canvxmax boldrows boldnamerows fgcolor
2983
2984 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2985 set x [xc $row $col]
2986 set y [yc $row]
2987 set orad [expr {$linespc / 3}]
2988 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2989 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2990 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2991 $canv raise $t
2992 $canv bind $t <1> {selcanvline {} %x %y}
2993 set xt [xc $row [llength [lindex $rowidlist $row]]]
2994 if {$xt < $rmx} {
2995 set xt $rmx
2996 }
2997 set rowtextx($row) $xt
2998 set idpos($id) [list $x $xt $y]
2999 if {[info exists idtags($id)] || [info exists idheads($id)]
3000 || [info exists idotherrefs($id)]} {
3001 set xt [drawtags $id $x $xt $y]
3002 }
3003 set headline [lindex $commitinfo($id) 0]
3004 set name [lindex $commitinfo($id) 1]
3005 set date [lindex $commitinfo($id) 2]
3006 set date [formatdate $date]
3007 set font $mainfont
3008 set nfont $mainfont
3009 set isbold [ishighlighted $row]
3010 if {$isbold > 0} {
3011 lappend boldrows $row
3012 lappend font bold
3013 if {$isbold > 1} {
3014 lappend boldnamerows $row
3015 lappend nfont bold
3016 }
3017 }
3018 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3019 -text $headline -font $font -tags text]
3020 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3021 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3022 -text $name -font $nfont -tags text]
3023 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3024 -text $date -font $mainfont -tags text]
3025 set xr [expr {$xt + [font measure $mainfont $headline]}]
3026 if {$xr > $canvxmax} {
3027 set canvxmax $xr
3028 setcanvscroll
3029 }
3030 }
3031
3032 proc drawcmitrow {row} {
3033 global displayorder rowidlist
3034 global idrangedrawn iddrawn
3035 global commitinfo parentlist numcommits
3036 global filehighlight fhighlights findstring nhighlights
3037 global hlview vhighlights
3038 global highlight_related rhighlights
3039
3040 if {$row >= $numcommits} return
3041 foreach id [lindex $rowidlist $row] {
3042 if {$id eq {}} continue
3043 set i -1
3044 foreach {s e} [rowranges $id] {
3045 incr i
3046 if {$row < $s} continue
3047 if {$e eq {}} break
3048 if {$row <= $e} {
3049 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3050 drawlineseg $id $i
3051 set idrangedrawn($id,$i) 1
3052 }
3053 break
3054 }
3055 }
3056 }
3057
3058 set id [lindex $displayorder $row]
3059 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3060 askvhighlight $row $id
3061 }
3062 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3063 askfilehighlight $row $id
3064 }
3065 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3066 askfindhighlight $row $id
3067 }
3068 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3069 askrelhighlight $row $id
3070 }
3071 if {[info exists iddrawn($id)]} return
3072 set col [lsearch -exact [lindex $rowidlist $row] $id]
3073 if {$col < 0} {
3074 puts "oops, row $row id $id not in list"
3075 return
3076 }
3077 if {![info exists commitinfo($id)]} {
3078 getcommit $id
3079 }
3080 assigncolor $id
3081 set olds [lindex $parentlist $row]
3082 if {$olds ne {}} {
3083 set rmx [drawparentlinks $id $row $col $olds]
3084 } else {
3085 set rmx 0
3086 }
3087 drawcmittext $id $row $col $rmx
3088 set iddrawn($id) 1
3089 }
3090
3091 proc drawfrac {f0 f1} {
3092 global numcommits canv
3093 global linespc
3094
3095 set ymax [lindex [$canv cget -scrollregion] 3]
3096 if {$ymax eq {} || $ymax == 0} return
3097 set y0 [expr {int($f0 * $ymax)}]
3098 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3099 if {$row < 0} {
3100 set row 0
3101 }
3102 set y1 [expr {int($f1 * $ymax)}]
3103 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3104 if {$endrow >= $numcommits} {
3105 set endrow [expr {$numcommits - 1}]
3106 }
3107 for {} {$row <= $endrow} {incr row} {
3108 drawcmitrow $row
3109 }
3110 }
3111
3112 proc drawvisible {} {
3113 global canv
3114 eval drawfrac [$canv yview]
3115 }
3116
3117 proc clear_display {} {
3118 global iddrawn idrangedrawn
3119 global vhighlights fhighlights nhighlights rhighlights
3120
3121 allcanvs delete all
3122 catch {unset iddrawn}
3123 catch {unset idrangedrawn}
3124 catch {unset vhighlights}
3125 catch {unset fhighlights}
3126 catch {unset nhighlights}
3127 catch {unset rhighlights}
3128 }
3129
3130 proc findcrossings {id} {
3131 global rowidlist parentlist numcommits rowoffsets displayorder
3132
3133 set cross {}
3134 set ccross {}
3135 foreach {s e} [rowranges $id] {
3136 if {$e >= $numcommits} {
3137 set e [expr {$numcommits - 1}]
3138 }
3139 if {$e <= $s} continue
3140 set x [lsearch -exact [lindex $rowidlist $e] $id]
3141 if {$x < 0} {
3142 puts "findcrossings: oops, no [shortids $id] in row $e"
3143 continue
3144 }
3145 for {set row $e} {[incr row -1] >= $s} {} {
3146 set olds [lindex $parentlist $row]
3147 set kid [lindex $displayorder $row]
3148 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3149 if {$kidx < 0} continue
3150 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3151 foreach p $olds {
3152 set px [lsearch -exact $nextrow $p]
3153 if {$px < 0} continue
3154 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3155 if {[lsearch -exact $ccross $p] >= 0} continue
3156 if {$x == $px + ($kidx < $px? -1: 1)} {
3157 lappend ccross $p
3158 } elseif {[lsearch -exact $cross $p] < 0} {
3159 lappend cross $p
3160 }
3161 }
3162 }
3163 set inc [lindex $rowoffsets $row $x]
3164 if {$inc eq {}} break
3165 incr x $inc
3166 }
3167 }
3168 return [concat $ccross {{}} $cross]
3169 }
3170
3171 proc assigncolor {id} {
3172 global colormap colors nextcolor
3173 global commitrow parentlist children children curview
3174
3175 if {[info exists colormap($id)]} return
3176 set ncolors [llength $colors]
3177 if {[info exists children($curview,$id)]} {
3178 set kids $children($curview,$id)
3179 } else {
3180 set kids {}
3181 }
3182 if {[llength $kids] == 1} {
3183 set child [lindex $kids 0]
3184 if {[info exists colormap($child)]
3185 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3186 set colormap($id) $colormap($child)
3187 return
3188 }
3189 }
3190 set badcolors {}
3191 set origbad {}
3192 foreach x [findcrossings $id] {
3193 if {$x eq {}} {
3194 # delimiter between corner crossings and other crossings
3195 if {[llength $badcolors] >= $ncolors - 1} break
3196 set origbad $badcolors
3197 }
3198 if {[info exists colormap($x)]
3199 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3200 lappend badcolors $colormap($x)
3201 }
3202 }
3203 if {[llength $badcolors] >= $ncolors} {
3204 set badcolors $origbad
3205 }
3206 set origbad $badcolors
3207 if {[llength $badcolors] < $ncolors - 1} {
3208 foreach child $kids {
3209 if {[info exists colormap($child)]
3210 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3211 lappend badcolors $colormap($child)
3212 }
3213 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3214 if {[info exists colormap($p)]
3215 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3216 lappend badcolors $colormap($p)
3217 }
3218 }
3219 }
3220 if {[llength $badcolors] >= $ncolors} {
3221 set badcolors $origbad
3222 }
3223 }
3224 for {set i 0} {$i <= $ncolors} {incr i} {
3225 set c [lindex $colors $nextcolor]
3226 if {[incr nextcolor] >= $ncolors} {
3227 set nextcolor 0
3228 }
3229 if {[lsearch -exact $badcolors $c]} break
3230 }
3231 set colormap($id) $c
3232 }
3233
3234 proc bindline {t id} {
3235 global canv
3236
3237 $canv bind $t <Enter> "lineenter %x %y $id"
3238 $canv bind $t <Motion> "linemotion %x %y $id"
3239 $canv bind $t <Leave> "lineleave $id"
3240 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3241 }
3242
3243 proc drawtags {id x xt y1} {
3244 global idtags idheads idotherrefs mainhead
3245 global linespc lthickness
3246 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3247
3248 set marks {}
3249 set ntags 0
3250 set nheads 0
3251 if {[info exists idtags($id)]} {
3252 set marks $idtags($id)
3253 set ntags [llength $marks]
3254 }
3255 if {[info exists idheads($id)]} {
3256 set marks [concat $marks $idheads($id)]
3257 set nheads [llength $idheads($id)]
3258 }
3259 if {[info exists idotherrefs($id)]} {
3260 set marks [concat $marks $idotherrefs($id)]
3261 }
3262 if {$marks eq {}} {
3263 return $xt
3264 }
3265
3266 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3267 set yt [expr {$y1 - 0.5 * $linespc}]
3268 set yb [expr {$yt + $linespc - 1}]
3269 set xvals {}
3270 set wvals {}
3271 set i -1
3272 foreach tag $marks {
3273 incr i
3274 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3275 set wid [font measure [concat $mainfont bold] $tag]
3276 } else {
3277 set wid [font measure $mainfont $tag]
3278 }
3279 lappend xvals $xt
3280 lappend wvals $wid
3281 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3282 }
3283 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3284 -width $lthickness -fill black -tags tag.$id]
3285 $canv lower $t
3286 foreach tag $marks x $xvals wid $wvals {
3287 set xl [expr {$x + $delta}]
3288 set xr [expr {$x + $delta + $wid + $lthickness}]
3289 set font $mainfont
3290 if {[incr ntags -1] >= 0} {
3291 # draw a tag
3292 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3293 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3294 -width 1 -outline black -fill yellow -tags tag.$id]
3295 $canv bind $t <1> [list showtag $tag 1]
3296 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3297 } else {
3298 # draw a head or other ref
3299 if {[incr nheads -1] >= 0} {
3300 set col green
3301 if {$tag eq $mainhead} {
3302 lappend font bold
3303 }
3304 } else {
3305 set col "#ddddff"
3306 }
3307 set xl [expr {$xl - $delta/2}]
3308 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3309 -width 1 -outline black -fill $col -tags tag.$id
3310 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3311 set rwid [font measure $mainfont $remoteprefix]
3312 set xi [expr {$x + 1}]
3313 set yti [expr {$yt + 1}]
3314 set xri [expr {$x + $rwid}]
3315 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3316 -width 0 -fill "#ffddaa" -tags tag.$id
3317 }
3318 }
3319 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3320 -font $font -tags [list tag.$id text]]
3321 if {$ntags >= 0} {
3322 $canv bind $t <1> [list showtag $tag 1]
3323 } elseif {$nheads >= 0} {
3324 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3325 }
3326 }
3327 return $xt
3328 }
3329
3330 proc xcoord {i level ln} {
3331 global canvx0 xspc1 xspc2
3332
3333 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3334 if {$i > 0 && $i == $level} {
3335 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3336 } elseif {$i > $level} {
3337 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3338 }
3339 return $x
3340 }
3341
3342 proc show_status {msg} {
3343 global canv mainfont fgcolor
3344
3345 clear_display
3346 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3347 -tags text -fill $fgcolor
3348 }
3349
3350 proc finishcommits {} {
3351 global commitidx phase curview
3352 global pending_select
3353
3354 if {$commitidx($curview) > 0} {
3355 drawrest
3356 } else {
3357 show_status "No commits selected"
3358 }
3359 set phase {}
3360 catch {unset pending_select}
3361 }
3362
3363 # Insert a new commit as the child of the commit on row $row.
3364 # The new commit will be displayed on row $row and the commits
3365 # on that row and below will move down one row.
3366 proc insertrow {row newcmit} {
3367 global displayorder parentlist childlist commitlisted
3368 global commitrow curview rowidlist rowoffsets numcommits
3369 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3370 global linesegends selectedline
3371
3372 if {$row >= $numcommits} {
3373 puts "oops, inserting new row $row but only have $numcommits rows"
3374 return
3375 }
3376 set p [lindex $displayorder $row]
3377 set displayorder [linsert $displayorder $row $newcmit]
3378 set parentlist [linsert $parentlist $row $p]
3379 set kids [lindex $childlist $row]
3380 lappend kids $newcmit
3381 lset childlist $row $kids
3382 set childlist [linsert $childlist $row {}]
3383 set commitlisted [linsert $commitlisted $row 1]
3384 set l [llength $displayorder]
3385 for {set r $row} {$r < $l} {incr r} {
3386 set id [lindex $displayorder $r]
3387 set commitrow($curview,$id) $r
3388 }
3389
3390 set idlist [lindex $rowidlist $row]
3391 set offs [lindex $rowoffsets $row]
3392 set newoffs {}
3393 foreach x $idlist {
3394 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3395 lappend newoffs {}
3396 } else {
3397 lappend newoffs 0
3398 }
3399 }
3400 if {[llength $kids] == 1} {
3401 set col [lsearch -exact $idlist $p]
3402 lset idlist $col $newcmit
3403 } else {
3404 set col [llength $idlist]
3405 lappend idlist $newcmit
3406 lappend offs {}
3407 lset rowoffsets $row $offs
3408 }
3409 set rowidlist [linsert $rowidlist $row $idlist]
3410 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3411
3412 set rowrangelist [linsert $rowrangelist $row {}]
3413 set l [llength $rowrangelist]
3414 for {set r 0} {$r < $l} {incr r} {
3415 set ranges [lindex $rowrangelist $r]
3416 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3417 set newranges {}
3418 foreach x $ranges {
3419 if {$x >= $row} {
3420 lappend newranges [expr {$x + 1}]
3421 } else {
3422 lappend newranges $x
3423 }
3424 }
3425 lset rowrangelist $r $newranges
3426 }
3427 }
3428 if {[llength $kids] > 1} {
3429 set rp1 [expr {$row + 1}]
3430 set ranges [lindex $rowrangelist $rp1]
3431 if {$ranges eq {}} {
3432 set ranges [list $row $rp1]
3433 } elseif {[lindex $ranges end-1] == $rp1} {
3434 lset ranges end-1 $row
3435 }
3436 lset rowrangelist $rp1 $ranges
3437 }
3438 foreach id [array names idrowranges] {
3439 set ranges $idrowranges($id)
3440 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3441 set newranges {}
3442 foreach x $ranges {
3443 if {$x >= $row} {
3444 lappend newranges [expr {$x + 1}]
3445 } else {
3446 lappend newranges $x
3447 }
3448 }
3449 set idrowranges($id) $newranges
3450 }
3451 }
3452
3453 set linesegends [linsert $linesegends $row {}]
3454
3455 incr rowlaidout
3456 incr rowoptim
3457 incr numcommits
3458
3459 if {[info exists selectedline] && $selectedline >= $row} {
3460 incr selectedline
3461 }
3462 redisplay
3463 }
3464
3465 # Don't change the text pane cursor if it is currently the hand cursor,
3466 # showing that we are over a sha1 ID link.
3467 proc settextcursor {c} {
3468 global ctext curtextcursor
3469
3470 if {[$ctext cget -cursor] == $curtextcursor} {
3471 $ctext config -cursor $c
3472 }
3473 set curtextcursor $c
3474 }
3475
3476 proc nowbusy {what} {
3477 global isbusy
3478
3479 if {[array names isbusy] eq {}} {
3480 . config -cursor watch
3481 settextcursor watch
3482 }
3483 set isbusy($what) 1
3484 }
3485
3486 proc notbusy {what} {
3487 global isbusy maincursor textcursor
3488
3489 catch {unset isbusy($what)}
3490 if {[array names isbusy] eq {}} {
3491 . config -cursor $maincursor
3492 settextcursor $textcursor
3493 }
3494 }
3495
3496 proc drawrest {} {
3497 global startmsecs
3498 global rowlaidout commitidx curview
3499 global pending_select
3500
3501 set row $rowlaidout
3502 layoutrows $rowlaidout $commitidx($curview) 1
3503 layouttail
3504 optimize_rows $row 0 $commitidx($curview)
3505 showstuff $commitidx($curview)
3506 if {[info exists pending_select]} {
3507 selectline 0 1
3508 }
3509
3510 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3511 #global numcommits
3512 #puts "overall $drawmsecs ms for $numcommits commits"
3513 }
3514
3515 proc findmatches {f} {
3516 global findtype foundstring foundstrlen
3517 if {$findtype == "Regexp"} {
3518 set matches [regexp -indices -all -inline $foundstring $f]
3519 } else {
3520 if {$findtype == "IgnCase"} {
3521 set str [string tolower $f]
3522 } else {
3523 set str $f
3524 }
3525 set matches {}
3526 set i 0
3527 while {[set j [string first $foundstring $str $i]] >= 0} {
3528 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3529 set i [expr {$j + $foundstrlen}]
3530 }
3531 }
3532 return $matches
3533 }
3534
3535 proc dofind {} {
3536 global findtype findloc findstring markedmatches commitinfo
3537 global numcommits displayorder linehtag linentag linedtag
3538 global mainfont canv canv2 canv3 selectedline
3539 global matchinglines foundstring foundstrlen matchstring
3540 global commitdata
3541
3542 stopfindproc
3543 unmarkmatches
3544 cancel_next_highlight
3545 focus .
3546 set matchinglines {}
3547 if {$findtype == "IgnCase"} {
3548 set foundstring [string tolower $findstring]
3549 } else {
3550 set foundstring $findstring
3551 }
3552 set foundstrlen [string length $findstring]
3553 if {$foundstrlen == 0} return
3554 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3555 set matchstring "*$matchstring*"
3556 if {![info exists selectedline]} {
3557 set oldsel -1
3558 } else {
3559 set oldsel $selectedline
3560 }
3561 set didsel 0
3562 set fldtypes {Headline Author Date Committer CDate Comments}
3563 set l -1
3564 foreach id $displayorder {
3565 set d $commitdata($id)
3566 incr l
3567 if {$findtype == "Regexp"} {
3568 set doesmatch [regexp $foundstring $d]
3569 } elseif {$findtype == "IgnCase"} {
3570 set doesmatch [string match -nocase $matchstring $d]
3571 } else {
3572 set doesmatch [string match $matchstring $d]
3573 }
3574 if {!$doesmatch} continue
3575 if {![info exists commitinfo($id)]} {
3576 getcommit $id
3577 }
3578 set info $commitinfo($id)
3579 set doesmatch 0
3580 foreach f $info ty $fldtypes {
3581 if {$findloc != "All fields" && $findloc != $ty} {
3582 continue
3583 }
3584 set matches [findmatches $f]
3585 if {$matches == {}} continue
3586 set doesmatch 1
3587 if {$ty == "Headline"} {
3588 drawcmitrow $l
3589 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3590 } elseif {$ty == "Author"} {
3591 drawcmitrow $l
3592 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3593 } elseif {$ty == "Date"} {
3594 drawcmitrow $l
3595 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3596 }
3597 }
3598 if {$doesmatch} {
3599 lappend matchinglines $l
3600 if {!$didsel && $l > $oldsel} {
3601 findselectline $l
3602 set didsel 1
3603 }
3604 }
3605 }
3606 if {$matchinglines == {}} {
3607 bell
3608 } elseif {!$didsel} {
3609 findselectline [lindex $matchinglines 0]
3610 }
3611 }
3612
3613 proc findselectline {l} {
3614 global findloc commentend ctext
3615 selectline $l 1
3616 if {$findloc == "All fields" || $findloc == "Comments"} {
3617 # highlight the matches in the comments
3618 set f [$ctext get 1.0 $commentend]
3619 set matches [findmatches $f]
3620 foreach match $matches {
3621 set start [lindex $match 0]
3622 set end [expr {[lindex $match 1] + 1}]
3623 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3624 }
3625 }
3626 }
3627
3628 proc findnext {restart} {
3629 global matchinglines selectedline
3630 if {![info exists matchinglines]} {
3631 if {$restart} {
3632 dofind
3633 }
3634 return
3635 }
3636 if {![info exists selectedline]} return
3637 foreach l $matchinglines {
3638 if {$l > $selectedline} {
3639 findselectline $l
3640 return
3641 }
3642 }
3643 bell
3644 }
3645
3646 proc findprev {} {
3647 global matchinglines selectedline
3648 if {![info exists matchinglines]} {
3649 dofind
3650 return
3651 }
3652 if {![info exists selectedline]} return
3653 set prev {}
3654 foreach l $matchinglines {
3655 if {$l >= $selectedline} break
3656 set prev $l
3657 }
3658 if {$prev != {}} {
3659 findselectline $prev
3660 } else {
3661 bell
3662 }
3663 }
3664
3665 proc stopfindproc {{done 0}} {
3666 global findprocpid findprocfile findids
3667 global ctext findoldcursor phase maincursor textcursor
3668 global findinprogress
3669
3670 catch {unset findids}
3671 if {[info exists findprocpid]} {
3672 if {!$done} {
3673 catch {exec kill $findprocpid}
3674 }
3675 catch {close $findprocfile}
3676 unset findprocpid
3677 }
3678 catch {unset findinprogress}
3679 notbusy find
3680 }
3681
3682 # mark a commit as matching by putting a yellow background
3683 # behind the headline
3684 proc markheadline {l id} {
3685 global canv mainfont linehtag
3686
3687 drawcmitrow $l
3688 set bbox [$canv bbox $linehtag($l)]
3689 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3690 $canv lower $t
3691 }
3692
3693 # mark the bits of a headline, author or date that match a find string
3694 proc markmatches {canv l str tag matches font} {
3695 set bbox [$canv bbox $tag]
3696 set x0 [lindex $bbox 0]
3697 set y0 [lindex $bbox 1]
3698 set y1 [lindex $bbox 3]
3699 foreach match $matches {
3700 set start [lindex $match 0]
3701 set end [lindex $match 1]
3702 if {$start > $end} continue
3703 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3704 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3705 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3706 [expr {$x0+$xlen+2}] $y1 \
3707 -outline {} -tags matches -fill yellow]
3708 $canv lower $t
3709 }
3710 }
3711
3712 proc unmarkmatches {} {
3713 global matchinglines findids
3714 allcanvs delete matches
3715 catch {unset matchinglines}
3716 catch {unset findids}
3717 }
3718
3719 proc selcanvline {w x y} {
3720 global canv canvy0 ctext linespc
3721 global rowtextx
3722 set ymax [lindex [$canv cget -scrollregion] 3]
3723 if {$ymax == {}} return
3724 set yfrac [lindex [$canv yview] 0]
3725 set y [expr {$y + $yfrac * $ymax}]
3726 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3727 if {$l < 0} {
3728 set l 0
3729 }
3730 if {$w eq $canv} {
3731 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3732 }
3733 unmarkmatches
3734 selectline $l 1
3735 }
3736
3737 proc commit_descriptor {p} {
3738 global commitinfo
3739 if {![info exists commitinfo($p)]} {
3740 getcommit $p
3741 }
3742 set l "..."
3743 if {[llength $commitinfo($p)] > 1} {
3744 set l [lindex $commitinfo($p) 0]
3745 }
3746 return "$p ($l)\n"
3747 }
3748
3749 # append some text to the ctext widget, and make any SHA1 ID
3750 # that we know about be a clickable link.
3751 proc appendwithlinks {text tags} {
3752 global ctext commitrow linknum curview
3753
3754 set start [$ctext index "end - 1c"]
3755 $ctext insert end $text $tags
3756 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3757 foreach l $links {
3758 set s [lindex $l 0]
3759 set e [lindex $l 1]
3760 set linkid [string range $text $s $e]
3761 if {![info exists commitrow($curview,$linkid)]} continue
3762 incr e
3763 $ctext tag add link "$start + $s c" "$start + $e c"
3764 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3765 $ctext tag bind link$linknum <1> \
3766 [list selectline $commitrow($curview,$linkid) 1]
3767 incr linknum
3768 }
3769 $ctext tag conf link -foreground blue -underline 1
3770 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3771 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3772 }
3773
3774 proc viewnextline {dir} {
3775 global canv linespc
3776
3777 $canv delete hover
3778 set ymax [lindex [$canv cget -scrollregion] 3]
3779 set wnow [$canv yview]
3780 set wtop [expr {[lindex $wnow 0] * $ymax}]
3781 set newtop [expr {$wtop + $dir * $linespc}]
3782 if {$newtop < 0} {
3783 set newtop 0
3784 } elseif {$newtop > $ymax} {
3785 set newtop $ymax
3786 }
3787 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3788 }
3789
3790 # add a list of tag or branch names at position pos
3791 # returns the number of names inserted
3792 proc appendrefs {pos tags var} {
3793 global ctext commitrow linknum curview $var
3794
3795 if {[catch {$ctext index $pos}]} {
3796 return 0
3797 }
3798 set tags [lsort $tags]
3799 set sep {}
3800 foreach tag $tags {
3801 set id [set $var\($tag\)]
3802 set lk link$linknum
3803 incr linknum
3804 $ctext insert $pos $sep
3805 $ctext insert $pos $tag $lk
3806 $ctext tag conf $lk -foreground blue
3807 if {[info exists commitrow($curview,$id)]} {
3808 $ctext tag bind $lk <1> \
3809 [list selectline $commitrow($curview,$id) 1]
3810 $ctext tag conf $lk -underline 1
3811 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3812 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3813 }
3814 set sep ", "
3815 }
3816 return [llength $tags]
3817 }
3818
3819 proc taglist {ids} {
3820 global idtags
3821
3822 set tags {}
3823 foreach id $ids {
3824 foreach tag $idtags($id) {
3825 lappend tags $tag
3826 }
3827 }
3828 return $tags
3829 }
3830
3831 # called when we have finished computing the nearby tags
3832 proc dispneartags {} {
3833 global selectedline currentid ctext anc_tags desc_tags showneartags
3834 global desc_heads
3835
3836 if {![info exists selectedline] || !$showneartags} return
3837 set id $currentid
3838 $ctext conf -state normal
3839 if {[info exists desc_heads($id)]} {
3840 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3841 $ctext insert "branch -2c" "es"
3842 }
3843 }
3844 if {[info exists anc_tags($id)]} {
3845 appendrefs follows [taglist $anc_tags($id)] tagids
3846 }
3847 if {[info exists desc_tags($id)]} {
3848 appendrefs precedes [taglist $desc_tags($id)] tagids
3849 }
3850 $ctext conf -state disabled
3851 }
3852
3853 proc selectline {l isnew} {
3854 global canv canv2 canv3 ctext commitinfo selectedline
3855 global displayorder linehtag linentag linedtag
3856 global canvy0 linespc parentlist childlist
3857 global currentid sha1entry
3858 global commentend idtags linknum
3859 global mergemax numcommits pending_select
3860 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3861
3862 catch {unset pending_select}
3863 $canv delete hover
3864 normalline
3865 cancel_next_highlight
3866 if {$l < 0 || $l >= $numcommits} return
3867 set y [expr {$canvy0 + $l * $linespc}]
3868 set ymax [lindex [$canv cget -scrollregion] 3]
3869 set ytop [expr {$y - $linespc - 1}]
3870 set ybot [expr {$y + $linespc + 1}]
3871 set wnow [$canv yview]
3872 set wtop [expr {[lindex $wnow 0] * $ymax}]
3873 set wbot [expr {[lindex $wnow 1] * $ymax}]
3874 set wh [expr {$wbot - $wtop}]
3875 set newtop $wtop
3876 if {$ytop < $wtop} {
3877 if {$ybot < $wtop} {
3878 set newtop [expr {$y - $wh / 2.0}]
3879 } else {
3880 set newtop $ytop
3881 if {$newtop > $wtop - $linespc} {
3882 set newtop [expr {$wtop - $linespc}]
3883 }
3884 }
3885 } elseif {$ybot > $wbot} {
3886 if {$ytop > $wbot} {
3887 set newtop [expr {$y - $wh / 2.0}]
3888 } else {
3889 set newtop [expr {$ybot - $wh}]
3890 if {$newtop < $wtop + $linespc} {
3891 set newtop [expr {$wtop + $linespc}]
3892 }
3893 }
3894 }
3895 if {$newtop != $wtop} {
3896 if {$newtop < 0} {
3897 set newtop 0
3898 }
3899 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3900 drawvisible
3901 }
3902
3903 if {![info exists linehtag($l)]} return
3904 $canv delete secsel
3905 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3906 -tags secsel -fill [$canv cget -selectbackground]]
3907 $canv lower $t
3908 $canv2 delete secsel
3909 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3910 -tags secsel -fill [$canv2 cget -selectbackground]]
3911 $canv2 lower $t
3912 $canv3 delete secsel
3913 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3914 -tags secsel -fill [$canv3 cget -selectbackground]]
3915 $canv3 lower $t
3916
3917 if {$isnew} {
3918 addtohistory [list selectline $l 0]
3919 }
3920
3921 set selectedline $l
3922
3923 set id [lindex $displayorder $l]
3924 set currentid $id
3925 $sha1entry delete 0 end
3926 $sha1entry insert 0 $id
3927 $sha1entry selection from 0
3928 $sha1entry selection to end
3929 rhighlight_sel $id
3930
3931 $ctext conf -state normal
3932 clear_ctext
3933 set linknum 0
3934 set info $commitinfo($id)
3935 set date [formatdate [lindex $info 2]]
3936 $ctext insert end "Author: [lindex $info 1] $date\n"
3937 set date [formatdate [lindex $info 4]]
3938 $ctext insert end "Committer: [lindex $info 3] $date\n"
3939 if {[info exists idtags($id)]} {
3940 $ctext insert end "Tags:"
3941 foreach tag $idtags($id) {
3942 $ctext insert end " $tag"
3943 }
3944 $ctext insert end "\n"
3945 }
3946
3947 set headers {}
3948 set olds [lindex $parentlist $l]
3949 if {[llength $olds] > 1} {
3950 set np 0
3951 foreach p $olds {
3952 if {$np >= $mergemax} {
3953 set tag mmax
3954 } else {
3955 set tag m$np
3956 }
3957 $ctext insert end "Parent: " $tag
3958 appendwithlinks [commit_descriptor $p] {}
3959 incr np
3960 }
3961 } else {
3962 foreach p $olds {
3963 append headers "Parent: [commit_descriptor $p]"
3964 }
3965 }
3966
3967 foreach c [lindex $childlist $l] {
3968 append headers "Child: [commit_descriptor $c]"
3969 }
3970
3971 # make anything that looks like a SHA1 ID be a clickable link
3972 appendwithlinks $headers {}
3973 if {$showneartags} {
3974 if {![info exists allcommits]} {
3975 getallcommits
3976 }
3977 $ctext insert end "Branch: "
3978 $ctext mark set branch "end -1c"
3979 $ctext mark gravity branch left
3980 if {[info exists desc_heads($id)]} {
3981 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3982 # turn "Branch" into "Branches"
3983 $ctext insert "branch -2c" "es"
3984 }
3985 }
3986 $ctext insert end "\nFollows: "
3987 $ctext mark set follows "end -1c"
3988 $ctext mark gravity follows left
3989 if {[info exists anc_tags($id)]} {
3990 appendrefs follows [taglist $anc_tags($id)] tagids
3991 }
3992 $ctext insert end "\nPrecedes: "
3993 $ctext mark set precedes "end -1c"
3994 $ctext mark gravity precedes left
3995 if {[info exists desc_tags($id)]} {
3996 appendrefs precedes [taglist $desc_tags($id)] tagids
3997 }
3998 $ctext insert end "\n"
3999 }
4000 $ctext insert end "\n"
4001 appendwithlinks [lindex $info 5] {comment}
4002
4003 $ctext tag delete Comments
4004 $ctext tag remove found 1.0 end
4005 $ctext conf -state disabled
4006 set commentend [$ctext index "end - 1c"]
4007
4008 init_flist "Comments"
4009 if {$cmitmode eq "tree"} {
4010 gettree $id
4011 } elseif {[llength $olds] <= 1} {
4012 startdiff $id
4013 } else {
4014 mergediff $id $l
4015 }
4016 }
4017
4018 proc selfirstline {} {
4019 unmarkmatches
4020 selectline 0 1
4021 }
4022
4023 proc sellastline {} {
4024 global numcommits
4025 unmarkmatches
4026 set l [expr {$numcommits - 1}]
4027 selectline $l 1
4028 }
4029
4030 proc selnextline {dir} {
4031 global selectedline
4032 if {![info exists selectedline]} return
4033 set l [expr {$selectedline + $dir}]
4034 unmarkmatches
4035 selectline $l 1
4036 }
4037
4038 proc selnextpage {dir} {
4039 global canv linespc selectedline numcommits
4040
4041 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4042 if {$lpp < 1} {
4043 set lpp 1
4044 }
4045 allcanvs yview scroll [expr {$dir * $lpp}] units
4046 drawvisible
4047 if {![info exists selectedline]} return
4048 set l [expr {$selectedline + $dir * $lpp}]
4049 if {$l < 0} {
4050 set l 0
4051 } elseif {$l >= $numcommits} {
4052 set l [expr $numcommits - 1]
4053 }
4054 unmarkmatches
4055 selectline $l 1
4056 }
4057
4058 proc unselectline {} {
4059 global selectedline currentid
4060
4061 catch {unset selectedline}
4062 catch {unset currentid}
4063 allcanvs delete secsel
4064 rhighlight_none
4065 cancel_next_highlight
4066 }
4067
4068 proc reselectline {} {
4069 global selectedline
4070
4071 if {[info exists selectedline]} {
4072 selectline $selectedline 0
4073 }
4074 }
4075
4076 proc addtohistory {cmd} {
4077 global history historyindex curview
4078
4079 set elt [list $curview $cmd]
4080 if {$historyindex > 0
4081 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4082 return
4083 }
4084
4085 if {$historyindex < [llength $history]} {
4086 set history [lreplace $history $historyindex end $elt]
4087 } else {
4088 lappend history $elt
4089 }
4090 incr historyindex
4091 if {$historyindex > 1} {
4092 .tf.bar.leftbut conf -state normal
4093 } else {
4094 .tf.bar.leftbut conf -state disabled
4095 }
4096 .tf.bar.rightbut conf -state disabled
4097 }
4098
4099 proc godo {elt} {
4100 global curview
4101
4102 set view [lindex $elt 0]
4103 set cmd [lindex $elt 1]
4104 if {$curview != $view} {
4105 showview $view
4106 }
4107 eval $cmd
4108 }
4109
4110 proc goback {} {
4111 global history historyindex
4112
4113 if {$historyindex > 1} {
4114 incr historyindex -1
4115 godo [lindex $history [expr {$historyindex - 1}]]
4116 .tf.bar.rightbut conf -state normal
4117 }
4118 if {$historyindex <= 1} {
4119 .tf.bar.leftbut conf -state disabled
4120 }
4121 }
4122
4123 proc goforw {} {
4124 global history historyindex
4125
4126 if {$historyindex < [llength $history]} {
4127 set cmd [lindex $history $historyindex]
4128 incr historyindex
4129 godo $cmd
4130 .tf.bar.leftbut conf -state normal
4131 }
4132 if {$historyindex >= [llength $history]} {
4133 .tf.bar.rightbut conf -state disabled
4134 }
4135 }
4136
4137 proc gettree {id} {
4138 global treefilelist treeidlist diffids diffmergeid treepending
4139
4140 set diffids $id
4141 catch {unset diffmergeid}
4142 if {![info exists treefilelist($id)]} {
4143 if {![info exists treepending]} {