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