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