1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
5# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
10proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17}
18
19proc 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
53proc 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
66proc 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
75proc 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 vhighlightmore
191 }
192 }
193 if {[clock clicks -milliseconds] >= $nextupdate} {
194 doupdate
195 }
196}
197
198proc 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
219proc readcommit {id} {
220 if {[catch {set contents [exec git cat-file commit $id]}]} return
221 parsecommit $id $contents 0
222}
223
224proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
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 selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
241 discardallcommits
242 readrefs
243 showview $n
244}
245
246proc parsecommit {id contents listed} {
247 global commitinfo cdate
248
249 set inhdr 1
250 set comment {}
251 set headline {}
252 set auname {}
253 set audate {}
254 set comname {}
255 set comdate {}
256 set hdrend [string first "\n\n" $contents]
257 if {$hdrend < 0} {
258 # should never happen...
259 set hdrend [string length $contents]
260 }
261 set header [string range $contents 0 [expr {$hdrend - 1}]]
262 set comment [string range $contents [expr {$hdrend + 2}] end]
263 foreach line [split $header "\n"] {
264 set tag [lindex $line 0]
265 if {$tag == "author"} {
266 set audate [lindex $line end-1]
267 set auname [lrange $line 1 end-2]
268 } elseif {$tag == "committer"} {
269 set comdate [lindex $line end-1]
270 set comname [lrange $line 1 end-2]
271 }
272 }
273 set headline {}
274 # take the first line of the comment as the headline
275 set i [string first "\n" $comment]
276 if {$i >= 0} {
277 set headline [string trim [string range $comment 0 $i]]
278 } else {
279 set headline $comment
280 }
281 if {!$listed} {
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
284 set newcomment {}
285 foreach line [split $comment "\n"] {
286 append newcomment " "
287 append newcomment $line
288 append newcomment "\n"
289 }
290 set comment $newcomment
291 }
292 if {$comdate != {}} {
293 set cdate($id) $comdate
294 }
295 set commitinfo($id) [list $headline $auname $audate \
296 $comname $comdate $comment]
297}
298
299proc getcommit {id} {
300 global commitdata commitinfo
301
302 if {[info exists commitdata($id)]} {
303 parsecommit $id $commitdata($id) 1
304 } else {
305 readcommit $id
306 if {![info exists commitinfo($id)]} {
307 set commitinfo($id) {"No commit information available"}
308 }
309 }
310 return 1
311}
312
313proc readrefs {} {
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs mainhead
316
317 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
318 catch {unset $v}
319 }
320 set refd [open [list | git ls-remote [gitdir]] r]
321 while {0 <= [set n [gets $refd line]]} {
322 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
323 match id path]} {
324 continue
325 }
326 if {[regexp {^remotes/.*/HEAD$} $path match]} {
327 continue
328 }
329 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
330 set type others
331 set name $path
332 }
333 if {[regexp {^remotes/} $path match]} {
334 set type heads
335 }
336 if {$type == "tags"} {
337 set tagids($name) $id
338 lappend idtags($id) $name
339 set obj {}
340 set type {}
341 set tag {}
342 catch {
343 set commit [exec git rev-parse "$id^0"]
344 if {$commit != $id} {
345 set tagids($name) $commit
346 lappend idtags($commit) $name
347 }
348 }
349 catch {
350 set tagcontents($name) [exec git cat-file tag $id]
351 }
352 } elseif { $type == "heads" } {
353 set headids($name) $id
354 lappend idheads($id) $name
355 } else {
356 set otherrefids($name) $id
357 lappend idotherrefs($id) $name
358 }
359 }
360 close $refd
361 set mainhead {}
362 catch {
363 set thehead [exec git symbolic-ref HEAD]
364 if {[string match "refs/heads/*" $thehead]} {
365 set mainhead [string range $thehead 11 end]
366 }
367 }
368}
369
370proc show_error {w top msg} {
371 message $w.m -text $msg -justify center -aspect 400
372 pack $w.m -side top -fill x -padx 20 -pady 20
373 button $w.ok -text OK -command "destroy $top"
374 pack $w.ok -side bottom -fill x
375 bind $top <Visibility> "grab $top; focus $top"
376 bind $top <Key-Return> "destroy $top"
377 tkwait window $top
378}
379
380proc error_popup msg {
381 set w .error
382 toplevel $w
383 wm transient $w .
384 show_error $w $w $msg
385}
386
387proc makewindow {} {
388 global canv canv2 canv3 linespc charspc ctext cflist
389 global textfont mainfont uifont
390 global findtype findtypemenu findloc findstring fstring geometry
391 global entries sha1entry sha1string sha1but
392 global maincursor textcursor curtextcursor
393 global rowctxmenu mergemax wrapcomment
394 global highlight_files gdttype
395 global searchstring sstring
396 global bgcolor fgcolor bglist fglist diffcolors
397
398 menu .bar
399 .bar add cascade -label "File" -menu .bar.file
400 .bar configure -font $uifont
401 menu .bar.file
402 .bar.file add command -label "Update" -command updatecommits
403 .bar.file add command -label "Reread references" -command rereadrefs
404 .bar.file add command -label "Quit" -command doquit
405 .bar.file configure -font $uifont
406 menu .bar.edit
407 .bar add cascade -label "Edit" -menu .bar.edit
408 .bar.edit add command -label "Preferences" -command doprefs
409 .bar.edit configure -font $uifont
410
411 menu .bar.view -font $uifont
412 .bar add cascade -label "View" -menu .bar.view
413 .bar.view add command -label "New view..." -command {newview 0}
414 .bar.view add command -label "Edit view..." -command editview \
415 -state disabled
416 .bar.view add command -label "Delete view" -command delview -state disabled
417 .bar.view add separator
418 .bar.view add radiobutton -label "All files" -command {showview 0} \
419 -variable selectedview -value 0
420
421 menu .bar.help
422 .bar add cascade -label "Help" -menu .bar.help
423 .bar.help add command -label "About gitk" -command about
424 .bar.help add command -label "Key bindings" -command keys
425 .bar.help configure -font $uifont
426 . configure -menu .bar
427
428 if {![info exists geometry(canv1)]} {
429 set geometry(canv1) [expr {45 * $charspc}]
430 set geometry(canv2) [expr {30 * $charspc}]
431 set geometry(canv3) [expr {15 * $charspc}]
432 set geometry(canvh) [expr {25 * $linespc + 4}]
433 set geometry(ctextw) 80
434 set geometry(ctexth) 30
435 set geometry(cflistw) 30
436 }
437 panedwindow .ctop -orient vertical
438 if {[info exists geometry(width)]} {
439 .ctop conf -width $geometry(width) -height $geometry(height)
440 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
441 set geometry(ctexth) [expr {($texth - 8) /
442 [font metrics $textfont -linespace]}]
443 }
444 frame .ctop.top
445 frame .ctop.top.bar
446 frame .ctop.top.lbar
447 pack .ctop.top.lbar -side bottom -fill x
448 pack .ctop.top.bar -side bottom -fill x
449 set cscroll .ctop.top.csb
450 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
451 pack $cscroll -side right -fill y
452 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
453 pack .ctop.top.clist -side top -fill both -expand 1
454 .ctop add .ctop.top
455 set canv .ctop.top.clist.canv
456 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
457 -background $bgcolor -bd 0 \
458 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
459 .ctop.top.clist add $canv
460 set canv2 .ctop.top.clist.canv2
461 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
462 -background $bgcolor -bd 0 -yscrollincr $linespc
463 .ctop.top.clist add $canv2
464 set canv3 .ctop.top.clist.canv3
465 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
466 -background $bgcolor -bd 0 -yscrollincr $linespc
467 .ctop.top.clist add $canv3
468 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
469 lappend bglist $canv $canv2 $canv3
470
471 set sha1entry .ctop.top.bar.sha1
472 set entries $sha1entry
473 set sha1but .ctop.top.bar.sha1label
474 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
475 -command gotocommit -width 8 -font $uifont
476 $sha1but conf -disabledforeground [$sha1but cget -foreground]
477 pack .ctop.top.bar.sha1label -side left
478 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
479 trace add variable sha1string write sha1change
480 pack $sha1entry -side left -pady 2
481
482 image create bitmap bm-left -data {
483 #define left_width 16
484 #define left_height 16
485 static unsigned char left_bits[] = {
486 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
487 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
488 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
489 }
490 image create bitmap bm-right -data {
491 #define right_width 16
492 #define right_height 16
493 static unsigned char right_bits[] = {
494 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
495 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
496 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
497 }
498 button .ctop.top.bar.leftbut -image bm-left -command goback \
499 -state disabled -width 26
500 pack .ctop.top.bar.leftbut -side left -fill y
501 button .ctop.top.bar.rightbut -image bm-right -command goforw \
502 -state disabled -width 26
503 pack .ctop.top.bar.rightbut -side left -fill y
504
505 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
506 pack .ctop.top.bar.findbut -side left
507 set findstring {}
508 set fstring .ctop.top.bar.findstring
509 lappend entries $fstring
510 entry $fstring -width 30 -font $textfont -textvariable findstring
511 trace add variable findstring write find_change
512 pack $fstring -side left -expand 1 -fill x
513 set findtype Exact
514 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp]
516 trace add variable findtype write find_change
517 .ctop.top.bar.findtype configure -font $uifont
518 .ctop.top.bar.findtype.menu configure -font $uifont
519 set findloc "All fields"
520 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
521 Comments Author Committer
522 trace add variable findloc write find_change
523 .ctop.top.bar.findloc configure -font $uifont
524 .ctop.top.bar.findloc.menu configure -font $uifont
525 pack .ctop.top.bar.findloc -side right
526 pack .ctop.top.bar.findtype -side right
527
528 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
529 -font $uifont
530 pack .ctop.top.lbar.flabel -side left -fill y
531 set gdttype "touching paths:"
532 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
533 "adding/removing string:"]
534 trace add variable gdttype write hfiles_change
535 $gm conf -font $uifont
536 .ctop.top.lbar.gdttype conf -font $uifont
537 pack .ctop.top.lbar.gdttype -side left -fill y
538 entry .ctop.top.lbar.fent -width 25 -font $textfont \
539 -textvariable highlight_files
540 trace add variable highlight_files write hfiles_change
541 lappend entries .ctop.top.lbar.fent
542 pack .ctop.top.lbar.fent -side left -fill x -expand 1
543 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
544 pack .ctop.top.lbar.vlabel -side left -fill y
545 global viewhlmenu selectedhlview
546 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
547 $viewhlmenu entryconf 0 -command delvhighlight
548 $viewhlmenu conf -font $uifont
549 .ctop.top.lbar.vhl conf -font $uifont
550 pack .ctop.top.lbar.vhl -side left -fill y
551 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
552 pack .ctop.top.lbar.rlabel -side left -fill y
553 global highlight_related
554 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
555 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
556 $m conf -font $uifont
557 .ctop.top.lbar.relm conf -font $uifont
558 trace add variable highlight_related write vrel_change
559 pack .ctop.top.lbar.relm -side left -fill y
560
561 panedwindow .ctop.cdet -orient horizontal
562 .ctop add .ctop.cdet
563 frame .ctop.cdet.left
564 frame .ctop.cdet.left.bot
565 pack .ctop.cdet.left.bot -side bottom -fill x
566 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
567 -font $uifont
568 pack .ctop.cdet.left.bot.search -side left -padx 5
569 set sstring .ctop.cdet.left.bot.sstring
570 entry $sstring -width 20 -font $textfont -textvariable searchstring
571 lappend entries $sstring
572 trace add variable searchstring write incrsearch
573 pack $sstring -side left -expand 1 -fill x
574 set ctext .ctop.cdet.left.ctext
575 text $ctext -background $bgcolor -foreground $fgcolor \
576 -state disabled -font $textfont \
577 -width $geometry(ctextw) -height $geometry(ctexth) \
578 -yscrollcommand scrolltext -wrap none
579 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
580 pack .ctop.cdet.left.sb -side right -fill y
581 pack $ctext -side left -fill both -expand 1
582 .ctop.cdet add .ctop.cdet.left
583 lappend bglist $ctext
584 lappend fglist $ctext
585
586 $ctext tag conf comment -wrap $wrapcomment
587 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
588 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
589 $ctext tag conf d0 -fore [lindex $diffcolors 0]
590 $ctext tag conf d1 -fore [lindex $diffcolors 1]
591 $ctext tag conf m0 -fore red
592 $ctext tag conf m1 -fore blue
593 $ctext tag conf m2 -fore green
594 $ctext tag conf m3 -fore purple
595 $ctext tag conf m4 -fore brown
596 $ctext tag conf m5 -fore "#009090"
597 $ctext tag conf m6 -fore magenta
598 $ctext tag conf m7 -fore "#808000"
599 $ctext tag conf m8 -fore "#009000"
600 $ctext tag conf m9 -fore "#ff0080"
601 $ctext tag conf m10 -fore cyan
602 $ctext tag conf m11 -fore "#b07070"
603 $ctext tag conf m12 -fore "#70b0f0"
604 $ctext tag conf m13 -fore "#70f0b0"
605 $ctext tag conf m14 -fore "#f0b070"
606 $ctext tag conf m15 -fore "#ff70b0"
607 $ctext tag conf mmax -fore darkgrey
608 set mergemax 16
609 $ctext tag conf mresult -font [concat $textfont bold]
610 $ctext tag conf msep -font [concat $textfont bold]
611 $ctext tag conf found -back yellow
612
613 frame .ctop.cdet.right
614 frame .ctop.cdet.right.mode
615 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
616 -command reselectline -variable cmitmode -value "patch"
617 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
618 -command reselectline -variable cmitmode -value "tree"
619 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
620 pack .ctop.cdet.right.mode -side top -fill x
621 set cflist .ctop.cdet.right.cfiles
622 set indent [font measure $mainfont "nn"]
623 text $cflist -width $geometry(cflistw) \
624 -background $bgcolor -foreground $fgcolor \
625 -font $mainfont \
626 -tabs [list $indent [expr {2 * $indent}]] \
627 -yscrollcommand ".ctop.cdet.right.sb set" \
628 -cursor [. cget -cursor] \
629 -spacing1 1 -spacing3 1
630 lappend bglist $cflist
631 lappend fglist $cflist
632 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
633 pack .ctop.cdet.right.sb -side right -fill y
634 pack $cflist -side left -fill both -expand 1
635 $cflist tag configure highlight \
636 -background [$cflist cget -selectbackground]
637 $cflist tag configure bold -font [concat $mainfont bold]
638 .ctop.cdet add .ctop.cdet.right
639 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
640
641 pack .ctop -side top -fill both -expand 1
642
643 bindall <1> {selcanvline %W %x %y}
644 #bindall <B1-Motion> {selcanvline %W %x %y}
645 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
646 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
647 bindall <2> "canvscan mark %W %x %y"
648 bindall <B2-Motion> "canvscan dragto %W %x %y"
649 bindkey <Home> selfirstline
650 bindkey <End> sellastline
651 bind . <Key-Up> "selnextline -1"
652 bind . <Key-Down> "selnextline 1"
653 bind . <Shift-Key-Up> "next_highlight -1"
654 bind . <Shift-Key-Down> "next_highlight 1"
655 bindkey <Key-Right> "goforw"
656 bindkey <Key-Left> "goback"
657 bind . <Key-Prior> "selnextpage -1"
658 bind . <Key-Next> "selnextpage 1"
659 bind . <Control-Home> "allcanvs yview moveto 0.0"
660 bind . <Control-End> "allcanvs yview moveto 1.0"
661 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
662 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
663 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
664 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
665 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
666 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
667 bindkey <Key-space> "$ctext yview scroll 1 pages"
668 bindkey p "selnextline -1"
669 bindkey n "selnextline 1"
670 bindkey z "goback"
671 bindkey x "goforw"
672 bindkey i "selnextline -1"
673 bindkey k "selnextline 1"
674 bindkey j "goback"
675 bindkey l "goforw"
676 bindkey b "$ctext yview scroll -1 pages"
677 bindkey d "$ctext yview scroll 18 units"
678 bindkey u "$ctext yview scroll -18 units"
679 bindkey / {findnext 1}
680 bindkey <Key-Return> {findnext 0}
681 bindkey ? findprev
682 bindkey f nextfile
683 bind . <Control-q> doquit
684 bind . <Control-f> dofind
685 bind . <Control-g> {findnext 0}
686 bind . <Control-r> dosearchback
687 bind . <Control-s> dosearch
688 bind . <Control-equal> {incrfont 1}
689 bind . <Control-KP_Add> {incrfont 1}
690 bind . <Control-minus> {incrfont -1}
691 bind . <Control-KP_Subtract> {incrfont -1}
692 bind . <Destroy> {savestuff %W}
693 bind . <Button-1> "click %W"
694 bind $fstring <Key-Return> dofind
695 bind $sha1entry <Key-Return> gotocommit
696 bind $sha1entry <<PasteSelection>> clearsha1
697 bind $cflist <1> {sel_flist %W %x %y; break}
698 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
699 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
700
701 set maincursor [. cget -cursor]
702 set textcursor [$ctext cget -cursor]
703 set curtextcursor $textcursor
704
705 set rowctxmenu .rowctxmenu
706 menu $rowctxmenu -tearoff 0
707 $rowctxmenu add command -label "Diff this -> selected" \
708 -command {diffvssel 0}
709 $rowctxmenu add command -label "Diff selected -> this" \
710 -command {diffvssel 1}
711 $rowctxmenu add command -label "Make patch" -command mkpatch
712 $rowctxmenu add command -label "Create tag" -command mktag
713 $rowctxmenu add command -label "Write commit to file" -command writecommit
714 $rowctxmenu add command -label "Create new branch" -command mkbranch
715}
716
717# mouse-2 makes all windows scan vertically, but only the one
718# the cursor is in scans horizontally
719proc canvscan {op w x y} {
720 global canv canv2 canv3
721 foreach c [list $canv $canv2 $canv3] {
722 if {$c == $w} {
723 $c scan $op $x $y
724 } else {
725 $c scan $op 0 $y
726 }
727 }
728}
729
730proc scrollcanv {cscroll f0 f1} {
731 $cscroll set $f0 $f1
732 drawfrac $f0 $f1
733 flushhighlights
734}
735
736# when we make a key binding for the toplevel, make sure
737# it doesn't get triggered when that key is pressed in the
738# find string entry widget.
739proc bindkey {ev script} {
740 global entries
741 bind . $ev $script
742 set escript [bind Entry $ev]
743 if {$escript == {}} {
744 set escript [bind Entry <Key>]
745 }
746 foreach e $entries {
747 bind $e $ev "$escript; break"
748 }
749}
750
751# set the focus back to the toplevel for any click outside
752# the entry widgets
753proc click {w} {
754 global entries
755 foreach e $entries {
756 if {$w == $e} return
757 }
758 focus .
759}
760
761proc savestuff {w} {
762 global canv canv2 canv3 ctext cflist mainfont textfont uifont
763 global stuffsaved findmergefiles maxgraphpct
764 global maxwidth showneartags
765 global viewname viewfiles viewargs viewperm nextviewnum
766 global cmitmode wrapcomment
767 global colors bgcolor fgcolor diffcolors
768
769 if {$stuffsaved} return
770 if {![winfo viewable .]} return
771 catch {
772 set f [open "~/.gitk-new" w]
773 puts $f [list set mainfont $mainfont]
774 puts $f [list set textfont $textfont]
775 puts $f [list set uifont $uifont]
776 puts $f [list set findmergefiles $findmergefiles]
777 puts $f [list set maxgraphpct $maxgraphpct]
778 puts $f [list set maxwidth $maxwidth]
779 puts $f [list set cmitmode $cmitmode]
780 puts $f [list set wrapcomment $wrapcomment]
781 puts $f [list set showneartags $showneartags]
782 puts $f [list set bgcolor $bgcolor]
783 puts $f [list set fgcolor $fgcolor]
784 puts $f [list set colors $colors]
785 puts $f [list set diffcolors $diffcolors]
786 puts $f "set geometry(width) [winfo width .ctop]"
787 puts $f "set geometry(height) [winfo height .ctop]"
788 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
789 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
790 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
791 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
792 set wid [expr {([winfo width $ctext] - 8) \
793 / [font measure $textfont "0"]}]
794 puts $f "set geometry(ctextw) $wid"
795 set wid [expr {([winfo width $cflist] - 11) \
796 / [font measure [$cflist cget -font] "0"]}]
797 puts $f "set geometry(cflistw) $wid"
798 puts -nonewline $f "set permviews {"
799 for {set v 0} {$v < $nextviewnum} {incr v} {
800 if {$viewperm($v)} {
801 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
802 }
803 }
804 puts $f "}"
805 close $f
806 file rename -force "~/.gitk-new" "~/.gitk"
807 }
808 set stuffsaved 1
809}
810
811proc resizeclistpanes {win w} {
812 global oldwidth
813 if {[info exists oldwidth($win)]} {
814 set s0 [$win sash coord 0]
815 set s1 [$win sash coord 1]
816 if {$w < 60} {
817 set sash0 [expr {int($w/2 - 2)}]
818 set sash1 [expr {int($w*5/6 - 2)}]
819 } else {
820 set factor [expr {1.0 * $w / $oldwidth($win)}]
821 set sash0 [expr {int($factor * [lindex $s0 0])}]
822 set sash1 [expr {int($factor * [lindex $s1 0])}]
823 if {$sash0 < 30} {
824 set sash0 30
825 }
826 if {$sash1 < $sash0 + 20} {
827 set sash1 [expr {$sash0 + 20}]
828 }
829 if {$sash1 > $w - 10} {
830 set sash1 [expr {$w - 10}]
831 if {$sash0 > $sash1 - 20} {
832 set sash0 [expr {$sash1 - 20}]
833 }
834 }
835 }
836 $win sash place 0 $sash0 [lindex $s0 1]
837 $win sash place 1 $sash1 [lindex $s1 1]
838 }
839 set oldwidth($win) $w
840}
841
842proc resizecdetpanes {win w} {
843 global oldwidth
844 if {[info exists oldwidth($win)]} {
845 set s0 [$win sash coord 0]
846 if {$w < 60} {
847 set sash0 [expr {int($w*3/4 - 2)}]
848 } else {
849 set factor [expr {1.0 * $w / $oldwidth($win)}]
850 set sash0 [expr {int($factor * [lindex $s0 0])}]
851 if {$sash0 < 45} {
852 set sash0 45
853 }
854 if {$sash0 > $w - 15} {
855 set sash0 [expr {$w - 15}]
856 }
857 }
858 $win sash place 0 $sash0 [lindex $s0 1]
859 }
860 set oldwidth($win) $w
861}
862
863proc allcanvs args {
864 global canv canv2 canv3
865 eval $canv $args
866 eval $canv2 $args
867 eval $canv3 $args
868}
869
870proc bindall {event action} {
871 global canv canv2 canv3
872 bind $canv $event $action
873 bind $canv2 $event $action
874 bind $canv3 $event $action
875}
876
877proc about {} {
878 set w .about
879 if {[winfo exists $w]} {
880 raise $w
881 return
882 }
883 toplevel $w
884 wm title $w "About gitk"
885 message $w.m -text {
886Gitk - a commit viewer for git
887
888Copyright © 2005-2006 Paul Mackerras
889
890Use and redistribute under the terms of the GNU General Public License} \
891 -justify center -aspect 400
892 pack $w.m -side top -fill x -padx 20 -pady 20
893 button $w.ok -text Close -command "destroy $w"
894 pack $w.ok -side bottom
895}
896
897proc keys {} {
898 set w .keys
899 if {[winfo exists $w]} {
900 raise $w
901 return
902 }
903 toplevel $w
904 wm title $w "Gitk key bindings"
905 message $w.m -text {
906Gitk key bindings:
907
908<Ctrl-Q> Quit
909<Home> Move to first commit
910<End> Move to last commit
911<Up>, p, i Move up one commit
912<Down>, n, k Move down one commit
913<Left>, z, j Go back in history list
914<Right>, x, l Go forward in history list
915<PageUp> Move up one page in commit list
916<PageDown> Move down one page in commit list
917<Ctrl-Home> Scroll to top of commit list
918<Ctrl-End> Scroll to bottom of commit list
919<Ctrl-Up> Scroll commit list up one line
920<Ctrl-Down> Scroll commit list down one line
921<Ctrl-PageUp> Scroll commit list up one page
922<Ctrl-PageDown> Scroll commit list down one page
923<Shift-Up> Move to previous highlighted line
924<Shift-Down> Move to next highlighted line
925<Delete>, b Scroll diff view up one page
926<Backspace> Scroll diff view up one page
927<Space> Scroll diff view down one page
928u Scroll diff view up 18 lines
929d Scroll diff view down 18 lines
930<Ctrl-F> Find
931<Ctrl-G> Move to next find hit
932<Return> Move to next find hit
933/ Move to next find hit, or redo find
934? Move to previous find hit
935f Scroll diff view to next file
936<Ctrl-S> Search for next hit in diff view
937<Ctrl-R> Search for previous hit in diff view
938<Ctrl-KP+> Increase font size
939<Ctrl-plus> Increase font size
940<Ctrl-KP-> Decrease font size
941<Ctrl-minus> Decrease font size
942} \
943 -justify left -bg white -border 2 -relief sunken
944 pack $w.m -side top -fill both
945 button $w.ok -text Close -command "destroy $w"
946 pack $w.ok -side bottom
947}
948
949# Procedures for manipulating the file list window at the
950# bottom right of the overall window.
951
952proc treeview {w l openlevs} {
953 global treecontents treediropen treeheight treeparent treeindex
954
955 set ix 0
956 set treeindex() 0
957 set lev 0
958 set prefix {}
959 set prefixend -1
960 set prefendstack {}
961 set htstack {}
962 set ht 0
963 set treecontents() {}
964 $w conf -state normal
965 foreach f $l {
966 while {[string range $f 0 $prefixend] ne $prefix} {
967 if {$lev <= $openlevs} {
968 $w mark set e:$treeindex($prefix) "end -1c"
969 $w mark gravity e:$treeindex($prefix) left
970 }
971 set treeheight($prefix) $ht
972 incr ht [lindex $htstack end]
973 set htstack [lreplace $htstack end end]
974 set prefixend [lindex $prefendstack end]
975 set prefendstack [lreplace $prefendstack end end]
976 set prefix [string range $prefix 0 $prefixend]
977 incr lev -1
978 }
979 set tail [string range $f [expr {$prefixend+1}] end]
980 while {[set slash [string first "/" $tail]] >= 0} {
981 lappend htstack $ht
982 set ht 0
983 lappend prefendstack $prefixend
984 incr prefixend [expr {$slash + 1}]
985 set d [string range $tail 0 $slash]
986 lappend treecontents($prefix) $d
987 set oldprefix $prefix
988 append prefix $d
989 set treecontents($prefix) {}
990 set treeindex($prefix) [incr ix]
991 set treeparent($prefix) $oldprefix
992 set tail [string range $tail [expr {$slash+1}] end]
993 if {$lev <= $openlevs} {
994 set ht 1
995 set treediropen($prefix) [expr {$lev < $openlevs}]
996 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
997 $w mark set d:$ix "end -1c"
998 $w mark gravity d:$ix left
999 set str "\n"
1000 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1001 $w insert end $str
1002 $w image create end -align center -image $bm -padx 1 \
1003 -name a:$ix
1004 $w insert end $d [highlight_tag $prefix]
1005 $w mark set s:$ix "end -1c"
1006 $w mark gravity s:$ix left
1007 }
1008 incr lev
1009 }
1010 if {$tail ne {}} {
1011 if {$lev <= $openlevs} {
1012 incr ht
1013 set str "\n"
1014 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1015 $w insert end $str
1016 $w insert end $tail [highlight_tag $f]
1017 }
1018 lappend treecontents($prefix) $tail
1019 }
1020 }
1021 while {$htstack ne {}} {
1022 set treeheight($prefix) $ht
1023 incr ht [lindex $htstack end]
1024 set htstack [lreplace $htstack end end]
1025 }
1026 $w conf -state disabled
1027}
1028
1029proc linetoelt {l} {
1030 global treeheight treecontents
1031
1032 set y 2
1033 set prefix {}
1034 while {1} {
1035 foreach e $treecontents($prefix) {
1036 if {$y == $l} {
1037 return "$prefix$e"
1038 }
1039 set n 1
1040 if {[string index $e end] eq "/"} {
1041 set n $treeheight($prefix$e)
1042 if {$y + $n > $l} {
1043 append prefix $e
1044 incr y
1045 break
1046 }
1047 }
1048 incr y $n
1049 }
1050 }
1051}
1052
1053proc highlight_tree {y prefix} {
1054 global treeheight treecontents cflist
1055
1056 foreach e $treecontents($prefix) {
1057 set path $prefix$e
1058 if {[highlight_tag $path] ne {}} {
1059 $cflist tag add bold $y.0 "$y.0 lineend"
1060 }
1061 incr y
1062 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1063 set y [highlight_tree $y $path]
1064 }
1065 }
1066 return $y
1067}
1068
1069proc treeclosedir {w dir} {
1070 global treediropen treeheight treeparent treeindex
1071
1072 set ix $treeindex($dir)
1073 $w conf -state normal
1074 $w delete s:$ix e:$ix
1075 set treediropen($dir) 0
1076 $w image configure a:$ix -image tri-rt
1077 $w conf -state disabled
1078 set n [expr {1 - $treeheight($dir)}]
1079 while {$dir ne {}} {
1080 incr treeheight($dir) $n
1081 set dir $treeparent($dir)
1082 }
1083}
1084
1085proc treeopendir {w dir} {
1086 global treediropen treeheight treeparent treecontents treeindex
1087
1088 set ix $treeindex($dir)
1089 $w conf -state normal
1090 $w image configure a:$ix -image tri-dn
1091 $w mark set e:$ix s:$ix
1092 $w mark gravity e:$ix right
1093 set lev 0
1094 set str "\n"
1095 set n [llength $treecontents($dir)]
1096 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1097 incr lev
1098 append str "\t"
1099 incr treeheight($x) $n
1100 }
1101 foreach e $treecontents($dir) {
1102 set de $dir$e
1103 if {[string index $e end] eq "/"} {
1104 set iy $treeindex($de)
1105 $w mark set d:$iy e:$ix
1106 $w mark gravity d:$iy left
1107 $w insert e:$ix $str
1108 set treediropen($de) 0
1109 $w image create e:$ix -align center -image tri-rt -padx 1 \
1110 -name a:$iy
1111 $w insert e:$ix $e [highlight_tag $de]
1112 $w mark set s:$iy e:$ix
1113 $w mark gravity s:$iy left
1114 set treeheight($de) 1
1115 } else {
1116 $w insert e:$ix $str
1117 $w insert e:$ix $e [highlight_tag $de]
1118 }
1119 }
1120 $w mark gravity e:$ix left
1121 $w conf -state disabled
1122 set treediropen($dir) 1
1123 set top [lindex [split [$w index @0,0] .] 0]
1124 set ht [$w cget -height]
1125 set l [lindex [split [$w index s:$ix] .] 0]
1126 if {$l < $top} {
1127 $w yview $l.0
1128 } elseif {$l + $n + 1 > $top + $ht} {
1129 set top [expr {$l + $n + 2 - $ht}]
1130 if {$l < $top} {
1131 set top $l
1132 }
1133 $w yview $top.0
1134 }
1135}
1136
1137proc treeclick {w x y} {
1138 global treediropen cmitmode ctext cflist cflist_top
1139
1140 if {$cmitmode ne "tree"} return
1141 if {![info exists cflist_top]} return
1142 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1143 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1144 $cflist tag add highlight $l.0 "$l.0 lineend"
1145 set cflist_top $l
1146 if {$l == 1} {
1147 $ctext yview 1.0
1148 return
1149 }
1150 set e [linetoelt $l]
1151 if {[string index $e end] ne "/"} {
1152 showfile $e
1153 } elseif {$treediropen($e)} {
1154 treeclosedir $w $e
1155 } else {
1156 treeopendir $w $e
1157 }
1158}
1159
1160proc setfilelist {id} {
1161 global treefilelist cflist
1162
1163 treeview $cflist $treefilelist($id) 0
1164}
1165
1166image create bitmap tri-rt -background black -foreground blue -data {
1167 #define tri-rt_width 13
1168 #define tri-rt_height 13
1169 static unsigned char tri-rt_bits[] = {
1170 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1171 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1172 0x00, 0x00};
1173} -maskdata {
1174 #define tri-rt-mask_width 13
1175 #define tri-rt-mask_height 13
1176 static unsigned char tri-rt-mask_bits[] = {
1177 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1178 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1179 0x08, 0x00};
1180}
1181image create bitmap tri-dn -background black -foreground blue -data {
1182 #define tri-dn_width 13
1183 #define tri-dn_height 13
1184 static unsigned char tri-dn_bits[] = {
1185 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1186 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1187 0x00, 0x00};
1188} -maskdata {
1189 #define tri-dn-mask_width 13
1190 #define tri-dn-mask_height 13
1191 static unsigned char tri-dn-mask_bits[] = {
1192 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1193 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1194 0x00, 0x00};
1195}
1196
1197proc init_flist {first} {
1198 global cflist cflist_top selectedline difffilestart
1199
1200 $cflist conf -state normal
1201 $cflist delete 0.0 end
1202 if {$first ne {}} {
1203 $cflist insert end $first
1204 set cflist_top 1
1205 $cflist tag add highlight 1.0 "1.0 lineend"
1206 } else {
1207 catch {unset cflist_top}
1208 }
1209 $cflist conf -state disabled
1210 set difffilestart {}
1211}
1212
1213proc highlight_tag {f} {
1214 global highlight_paths
1215
1216 foreach p $highlight_paths {
1217 if {[string match $p $f]} {
1218 return "bold"
1219 }
1220 }
1221 return {}
1222}
1223
1224proc highlight_filelist {} {
1225 global cmitmode cflist
1226
1227 $cflist conf -state normal
1228 if {$cmitmode ne "tree"} {
1229 set end [lindex [split [$cflist index end] .] 0]
1230 for {set l 2} {$l < $end} {incr l} {
1231 set line [$cflist get $l.0 "$l.0 lineend"]
1232 if {[highlight_tag $line] ne {}} {
1233 $cflist tag add bold $l.0 "$l.0 lineend"
1234 }
1235 }
1236 } else {
1237 highlight_tree 2 {}
1238 }
1239 $cflist conf -state disabled
1240}
1241
1242proc unhighlight_filelist {} {
1243 global cflist
1244
1245 $cflist conf -state normal
1246 $cflist tag remove bold 1.0 end
1247 $cflist conf -state disabled
1248}
1249
1250proc add_flist {fl} {
1251 global cflist
1252
1253 $cflist conf -state normal
1254 foreach f $fl {
1255 $cflist insert end "\n"
1256 $cflist insert end $f [highlight_tag $f]
1257 }
1258 $cflist conf -state disabled
1259}
1260
1261proc sel_flist {w x y} {
1262 global ctext difffilestart cflist cflist_top cmitmode
1263
1264 if {$cmitmode eq "tree"} return
1265 if {![info exists cflist_top]} return
1266 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1267 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1268 $cflist tag add highlight $l.0 "$l.0 lineend"
1269 set cflist_top $l
1270 if {$l == 1} {
1271 $ctext yview 1.0
1272 } else {
1273 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1274 }
1275}
1276
1277# Functions for adding and removing shell-type quoting
1278
1279proc shellquote {str} {
1280 if {![string match "*\['\"\\ \t]*" $str]} {
1281 return $str
1282 }
1283 if {![string match "*\['\"\\]*" $str]} {
1284 return "\"$str\""
1285 }
1286 if {![string match "*'*" $str]} {
1287 return "'$str'"
1288 }
1289 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1290}
1291
1292proc shellarglist {l} {
1293 set str {}
1294 foreach a $l {
1295 if {$str ne {}} {
1296 append str " "
1297 }
1298 append str [shellquote $a]
1299 }
1300 return $str
1301}
1302
1303proc shelldequote {str} {
1304 set ret {}
1305 set used -1
1306 while {1} {
1307 incr used
1308 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1309 append ret [string range $str $used end]
1310 set used [string length $str]
1311 break
1312 }
1313 set first [lindex $first 0]
1314 set ch [string index $str $first]
1315 if {$first > $used} {
1316 append ret [string range $str $used [expr {$first - 1}]]
1317 set used $first
1318 }
1319 if {$ch eq " " || $ch eq "\t"} break
1320 incr used
1321 if {$ch eq "'"} {
1322 set first [string first "'" $str $used]
1323 if {$first < 0} {
1324 error "unmatched single-quote"
1325 }
1326 append ret [string range $str $used [expr {$first - 1}]]
1327 set used $first
1328 continue
1329 }
1330 if {$ch eq "\\"} {
1331 if {$used >= [string length $str]} {
1332 error "trailing backslash"
1333 }
1334 append ret [string index $str $used]
1335 continue
1336 }
1337 # here ch == "\""
1338 while {1} {
1339 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1340 error "unmatched double-quote"
1341 }
1342 set first [lindex $first 0]
1343 set ch [string index $str $first]
1344 if {$first > $used} {
1345 append ret [string range $str $used [expr {$first - 1}]]
1346 set used $first
1347 }
1348 if {$ch eq "\""} break
1349 incr used
1350 append ret [string index $str $used]
1351 incr used
1352 }
1353 }
1354 return [list $used $ret]
1355}
1356
1357proc shellsplit {str} {
1358 set l {}
1359 while {1} {
1360 set str [string trimleft $str]
1361 if {$str eq {}} break
1362 set dq [shelldequote $str]
1363 set n [lindex $dq 0]
1364 set word [lindex $dq 1]
1365 set str [string range $str $n end]
1366 lappend l $word
1367 }
1368 return $l
1369}
1370
1371# Code to implement multiple views
1372
1373proc newview {ishighlight} {
1374 global nextviewnum newviewname newviewperm uifont newishighlight
1375 global newviewargs revtreeargs
1376
1377 set newishighlight $ishighlight
1378 set top .gitkview
1379 if {[winfo exists $top]} {
1380 raise $top
1381 return
1382 }
1383 set newviewname($nextviewnum) "View $nextviewnum"
1384 set newviewperm($nextviewnum) 0
1385 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1386 vieweditor $top $nextviewnum "Gitk view definition"
1387}
1388
1389proc editview {} {
1390 global curview
1391 global viewname viewperm newviewname newviewperm
1392 global viewargs newviewargs
1393
1394 set top .gitkvedit-$curview
1395 if {[winfo exists $top]} {
1396 raise $top
1397 return
1398 }
1399 set newviewname($curview) $viewname($curview)
1400 set newviewperm($curview) $viewperm($curview)
1401 set newviewargs($curview) [shellarglist $viewargs($curview)]
1402 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1403}
1404
1405proc vieweditor {top n title} {
1406 global newviewname newviewperm viewfiles
1407 global uifont
1408
1409 toplevel $top
1410 wm title $top $title
1411 label $top.nl -text "Name" -font $uifont
1412 entry $top.name -width 20 -textvariable newviewname($n)
1413 grid $top.nl $top.name -sticky w -pady 5
1414 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1415 grid $top.perm - -pady 5 -sticky w
1416 message $top.al -aspect 1000 -font $uifont \
1417 -text "Commits to include (arguments to git rev-list):"
1418 grid $top.al - -sticky w -pady 5
1419 entry $top.args -width 50 -textvariable newviewargs($n) \
1420 -background white
1421 grid $top.args - -sticky ew -padx 5
1422 message $top.l -aspect 1000 -font $uifont \
1423 -text "Enter files and directories to include, one per line:"
1424 grid $top.l - -sticky w
1425 text $top.t -width 40 -height 10 -background white
1426 if {[info exists viewfiles($n)]} {
1427 foreach f $viewfiles($n) {
1428 $top.t insert end $f
1429 $top.t insert end "\n"
1430 }
1431 $top.t delete {end - 1c} end
1432 $top.t mark set insert 0.0
1433 }
1434 grid $top.t - -sticky ew -padx 5
1435 frame $top.buts
1436 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1437 button $top.buts.can -text "Cancel" -command [list destroy $top]
1438 grid $top.buts.ok $top.buts.can
1439 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1440 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1441 grid $top.buts - -pady 10 -sticky ew
1442 focus $top.t
1443}
1444
1445proc doviewmenu {m first cmd op argv} {
1446 set nmenu [$m index end]
1447 for {set i $first} {$i <= $nmenu} {incr i} {
1448 if {[$m entrycget $i -command] eq $cmd} {
1449 eval $m $op $i $argv
1450 break
1451 }
1452 }
1453}
1454
1455proc allviewmenus {n op args} {
1456 global viewhlmenu
1457
1458 doviewmenu .bar.view 7 [list showview $n] $op $args
1459 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1460}
1461
1462proc newviewok {top n} {
1463 global nextviewnum newviewperm newviewname newishighlight
1464 global viewname viewfiles viewperm selectedview curview
1465 global viewargs newviewargs viewhlmenu
1466
1467 if {[catch {
1468 set newargs [shellsplit $newviewargs($n)]
1469 } err]} {
1470 error_popup "Error in commit selection arguments: $err"
1471 wm raise $top
1472 focus $top
1473 return
1474 }
1475 set files {}
1476 foreach f [split [$top.t get 0.0 end] "\n"] {
1477 set ft [string trim $f]
1478 if {$ft ne {}} {
1479 lappend files $ft
1480 }
1481 }
1482 if {![info exists viewfiles($n)]} {
1483 # creating a new view
1484 incr nextviewnum
1485 set viewname($n) $newviewname($n)
1486 set viewperm($n) $newviewperm($n)
1487 set viewfiles($n) $files
1488 set viewargs($n) $newargs
1489 addviewmenu $n
1490 if {!$newishighlight} {
1491 after idle showview $n
1492 } else {
1493 after idle addvhighlight $n
1494 }
1495 } else {
1496 # editing an existing view
1497 set viewperm($n) $newviewperm($n)
1498 if {$newviewname($n) ne $viewname($n)} {
1499 set viewname($n) $newviewname($n)
1500 doviewmenu .bar.view 7 [list showview $n] \
1501 entryconf [list -label $viewname($n)]
1502 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1503 entryconf [list -label $viewname($n) -value $viewname($n)]
1504 }
1505 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1506 set viewfiles($n) $files
1507 set viewargs($n) $newargs
1508 if {$curview == $n} {
1509 after idle updatecommits
1510 }
1511 }
1512 }
1513 catch {destroy $top}
1514}
1515
1516proc delview {} {
1517 global curview viewdata viewperm hlview selectedhlview
1518
1519 if {$curview == 0} return
1520 if {[info exists hlview] && $hlview == $curview} {
1521 set selectedhlview None
1522 unset hlview
1523 }
1524 allviewmenus $curview delete
1525 set viewdata($curview) {}
1526 set viewperm($curview) 0
1527 showview 0
1528}
1529
1530proc addviewmenu {n} {
1531 global viewname viewhlmenu
1532
1533 .bar.view add radiobutton -label $viewname($n) \
1534 -command [list showview $n] -variable selectedview -value $n
1535 $viewhlmenu add radiobutton -label $viewname($n) \
1536 -command [list addvhighlight $n] -variable selectedhlview
1537}
1538
1539proc flatten {var} {
1540 global $var
1541
1542 set ret {}
1543 foreach i [array names $var] {
1544 lappend ret $i [set $var\($i\)]
1545 }
1546 return $ret
1547}
1548
1549proc unflatten {var l} {
1550 global $var
1551
1552 catch {unset $var}
1553 foreach {i v} $l {
1554 set $var\($i\) $v
1555 }
1556}
1557
1558proc showview {n} {
1559 global curview viewdata viewfiles
1560 global displayorder parentlist childlist rowidlist rowoffsets
1561 global colormap rowtextx commitrow nextcolor canvxmax
1562 global numcommits rowrangelist commitlisted idrowranges
1563 global selectedline currentid canv canvy0
1564 global matchinglines treediffs
1565 global pending_select phase
1566 global commitidx rowlaidout rowoptim linesegends
1567 global commfd nextupdate
1568 global selectedview
1569 global vparentlist vchildlist vdisporder vcmitlisted
1570 global hlview selectedhlview
1571
1572 if {$n == $curview} return
1573 set selid {}
1574 if {[info exists selectedline]} {
1575 set selid $currentid
1576 set y [yc $selectedline]
1577 set ymax [lindex [$canv cget -scrollregion] 3]
1578 set span [$canv yview]
1579 set ytop [expr {[lindex $span 0] * $ymax}]
1580 set ybot [expr {[lindex $span 1] * $ymax}]
1581 if {$ytop < $y && $y < $ybot} {
1582 set yscreen [expr {$y - $ytop}]
1583 } else {
1584 set yscreen [expr {($ybot - $ytop) / 2}]
1585 }
1586 }
1587 unselectline
1588 normalline
1589 stopfindproc
1590 if {$curview >= 0} {
1591 set vparentlist($curview) $parentlist
1592 set vchildlist($curview) $childlist
1593 set vdisporder($curview) $displayorder
1594 set vcmitlisted($curview) $commitlisted
1595 if {$phase ne {}} {
1596 set viewdata($curview) \
1597 [list $phase $rowidlist $rowoffsets $rowrangelist \
1598 [flatten idrowranges] [flatten idinlist] \
1599 $rowlaidout $rowoptim $numcommits $linesegends]
1600 } elseif {![info exists viewdata($curview)]
1601 || [lindex $viewdata($curview) 0] ne {}} {
1602 set viewdata($curview) \
1603 [list {} $rowidlist $rowoffsets $rowrangelist]
1604 }
1605 }
1606 catch {unset matchinglines}
1607 catch {unset treediffs}
1608 clear_display
1609 if {[info exists hlview] && $hlview == $n} {
1610 unset hlview
1611 set selectedhlview None
1612 }
1613
1614 set curview $n
1615 set selectedview $n
1616 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1617 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1618
1619 if {![info exists viewdata($n)]} {
1620 set pending_select $selid
1621 getcommits
1622 return
1623 }
1624
1625 set v $viewdata($n)
1626 set phase [lindex $v 0]
1627 set displayorder $vdisporder($n)
1628 set parentlist $vparentlist($n)
1629 set childlist $vchildlist($n)
1630 set commitlisted $vcmitlisted($n)
1631 set rowidlist [lindex $v 1]
1632 set rowoffsets [lindex $v 2]
1633 set rowrangelist [lindex $v 3]
1634 if {$phase eq {}} {
1635 set numcommits [llength $displayorder]
1636 catch {unset idrowranges}
1637 } else {
1638 unflatten idrowranges [lindex $v 4]
1639 unflatten idinlist [lindex $v 5]
1640 set rowlaidout [lindex $v 6]
1641 set rowoptim [lindex $v 7]
1642 set numcommits [lindex $v 8]
1643 set linesegends [lindex $v 9]
1644 }
1645
1646 catch {unset colormap}
1647 catch {unset rowtextx}
1648 set nextcolor 0
1649 set canvxmax [$canv cget -width]
1650 set curview $n
1651 set row 0
1652 setcanvscroll
1653 set yf 0
1654 set row 0
1655 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1656 set row $commitrow($n,$selid)
1657 # try to get the selected row in the same position on the screen
1658 set ymax [lindex [$canv cget -scrollregion] 3]
1659 set ytop [expr {[yc $row] - $yscreen}]
1660 if {$ytop < 0} {
1661 set ytop 0
1662 }
1663 set yf [expr {$ytop * 1.0 / $ymax}]
1664 }
1665 allcanvs yview moveto $yf
1666 drawvisible
1667 selectline $row 0
1668 if {$phase ne {}} {
1669 if {$phase eq "getcommits"} {
1670 show_status "Reading commits..."
1671 }
1672 if {[info exists commfd($n)]} {
1673 layoutmore
1674 } else {
1675 finishcommits
1676 }
1677 } elseif {$numcommits == 0} {
1678 show_status "No commits selected"
1679 }
1680}
1681
1682# Stuff relating to the highlighting facility
1683
1684proc ishighlighted {row} {
1685 global vhighlights fhighlights nhighlights rhighlights
1686
1687 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1688 return $nhighlights($row)
1689 }
1690 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1691 return $vhighlights($row)
1692 }
1693 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1694 return $fhighlights($row)
1695 }
1696 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1697 return $rhighlights($row)
1698 }
1699 return 0
1700}
1701
1702proc bolden {row font} {
1703 global canv linehtag selectedline boldrows
1704
1705 lappend boldrows $row
1706 $canv itemconf $linehtag($row) -font $font
1707 if {[info exists selectedline] && $row == $selectedline} {
1708 $canv delete secsel
1709 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1710 -outline {{}} -tags secsel \
1711 -fill [$canv cget -selectbackground]]
1712 $canv lower $t
1713 }
1714}
1715
1716proc bolden_name {row font} {
1717 global canv2 linentag selectedline boldnamerows
1718
1719 lappend boldnamerows $row
1720 $canv2 itemconf $linentag($row) -font $font
1721 if {[info exists selectedline] && $row == $selectedline} {
1722 $canv2 delete secsel
1723 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1724 -outline {{}} -tags secsel \
1725 -fill [$canv2 cget -selectbackground]]
1726 $canv2 lower $t
1727 }
1728}
1729
1730proc unbolden {} {
1731 global mainfont boldrows
1732
1733 set stillbold {}
1734 foreach row $boldrows {
1735 if {![ishighlighted $row]} {
1736 bolden $row $mainfont
1737 } else {
1738 lappend stillbold $row
1739 }
1740 }
1741 set boldrows $stillbold
1742}
1743
1744proc addvhighlight {n} {
1745 global hlview curview viewdata vhl_done vhighlights commitidx
1746
1747 if {[info exists hlview]} {
1748 delvhighlight
1749 }
1750 set hlview $n
1751 if {$n != $curview && ![info exists viewdata($n)]} {
1752 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1753 set vparentlist($n) {}
1754 set vchildlist($n) {}
1755 set vdisporder($n) {}
1756 set vcmitlisted($n) {}
1757 start_rev_list $n
1758 }
1759 set vhl_done $commitidx($hlview)
1760 if {$vhl_done > 0} {
1761 drawvisible
1762 }
1763}
1764
1765proc delvhighlight {} {
1766 global hlview vhighlights
1767
1768 if {![info exists hlview]} return
1769 unset hlview
1770 catch {unset vhighlights}
1771 unbolden
1772}
1773
1774proc vhighlightmore {} {
1775 global hlview vhl_done commitidx vhighlights
1776 global displayorder vdisporder curview mainfont
1777
1778 set font [concat $mainfont bold]
1779 set max $commitidx($hlview)
1780 if {$hlview == $curview} {
1781 set disp $displayorder
1782 } else {
1783 set disp $vdisporder($hlview)
1784 }
1785 set vr [visiblerows]
1786 set r0 [lindex $vr 0]
1787 set r1 [lindex $vr 1]
1788 for {set i $vhl_done} {$i < $max} {incr i} {
1789 set id [lindex $disp $i]
1790 if {[info exists commitrow($curview,$id)]} {
1791 set row $commitrow($curview,$id)
1792 if {$r0 <= $row && $row <= $r1} {
1793 if {![highlighted $row]} {
1794 bolden $row $font
1795 }
1796 set vhighlights($row) 1
1797 }
1798 }
1799 }
1800 set vhl_done $max
1801}
1802
1803proc askvhighlight {row id} {
1804 global hlview vhighlights commitrow iddrawn mainfont
1805
1806 if {[info exists commitrow($hlview,$id)]} {
1807 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1808 bolden $row [concat $mainfont bold]
1809 }
1810 set vhighlights($row) 1
1811 } else {
1812 set vhighlights($row) 0
1813 }
1814}
1815
1816proc hfiles_change {name ix op} {
1817 global highlight_files filehighlight fhighlights fh_serial
1818 global mainfont highlight_paths
1819
1820 if {[info exists filehighlight]} {
1821 # delete previous highlights
1822 catch {close $filehighlight}
1823 unset filehighlight
1824 catch {unset fhighlights}
1825 unbolden
1826 unhighlight_filelist
1827 }
1828 set highlight_paths {}
1829 after cancel do_file_hl $fh_serial
1830 incr fh_serial
1831 if {$highlight_files ne {}} {
1832 after 300 do_file_hl $fh_serial
1833 }
1834}
1835
1836proc makepatterns {l} {
1837 set ret {}
1838 foreach e $l {
1839 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1840 if {[string index $ee end] eq "/"} {
1841 lappend ret "$ee*"
1842 } else {
1843 lappend ret $ee
1844 lappend ret "$ee/*"
1845 }
1846 }
1847 return $ret
1848}
1849
1850proc do_file_hl {serial} {
1851 global highlight_files filehighlight highlight_paths gdttype fhl_list
1852
1853 if {$gdttype eq "touching paths:"} {
1854 if {[catch {set paths [shellsplit $highlight_files]}]} return
1855 set highlight_paths [makepatterns $paths]
1856 highlight_filelist
1857 set gdtargs [concat -- $paths]
1858 } else {
1859 set gdtargs [list "-S$highlight_files"]
1860 }
1861 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1862 set filehighlight [open $cmd r+]
1863 fconfigure $filehighlight -blocking 0
1864 fileevent $filehighlight readable readfhighlight
1865 set fhl_list {}
1866 drawvisible
1867 flushhighlights
1868}
1869
1870proc flushhighlights {} {
1871 global filehighlight fhl_list
1872
1873 if {[info exists filehighlight]} {
1874 lappend fhl_list {}
1875 puts $filehighlight ""
1876 flush $filehighlight
1877 }
1878}
1879
1880proc askfilehighlight {row id} {
1881 global filehighlight fhighlights fhl_list
1882
1883 lappend fhl_list $id
1884 set fhighlights($row) -1
1885 puts $filehighlight $id
1886}
1887
1888proc readfhighlight {} {
1889 global filehighlight fhighlights commitrow curview mainfont iddrawn
1890 global fhl_list
1891
1892 while {[gets $filehighlight line] >= 0} {
1893 set line [string trim $line]
1894 set i [lsearch -exact $fhl_list $line]
1895 if {$i < 0} continue
1896 for {set j 0} {$j < $i} {incr j} {
1897 set id [lindex $fhl_list $j]
1898 if {[info exists commitrow($curview,$id)]} {
1899 set fhighlights($commitrow($curview,$id)) 0
1900 }
1901 }
1902 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1903 if {$line eq {}} continue
1904 if {![info exists commitrow($curview,$line)]} continue
1905 set row $commitrow($curview,$line)
1906 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1907 bolden $row [concat $mainfont bold]
1908 }
1909 set fhighlights($row) 1
1910 }
1911 if {[eof $filehighlight]} {
1912 # strange...
1913 puts "oops, git-diff-tree died"
1914 catch {close $filehighlight}
1915 unset filehighlight
1916 }
1917 next_hlcont
1918}
1919
1920proc find_change {name ix op} {
1921 global nhighlights mainfont boldnamerows
1922 global findstring findpattern findtype
1923
1924 # delete previous highlights, if any
1925 foreach row $boldnamerows {
1926 bolden_name $row $mainfont
1927 }
1928 set boldnamerows {}
1929 catch {unset nhighlights}
1930 unbolden
1931 if {$findtype ne "Regexp"} {
1932 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1933 $findstring]
1934 set findpattern "*$e*"
1935 }
1936 drawvisible
1937}
1938
1939proc askfindhighlight {row id} {
1940 global nhighlights commitinfo iddrawn mainfont
1941 global findstring findtype findloc findpattern
1942
1943 if {![info exists commitinfo($id)]} {
1944 getcommit $id
1945 }
1946 set info $commitinfo($id)
1947 set isbold 0
1948 set fldtypes {Headline Author Date Committer CDate Comments}
1949 foreach f $info ty $fldtypes {
1950 if {$findloc ne "All fields" && $findloc ne $ty} {
1951 continue
1952 }
1953 if {$findtype eq "Regexp"} {
1954 set doesmatch [regexp $findstring $f]
1955 } elseif {$findtype eq "IgnCase"} {
1956 set doesmatch [string match -nocase $findpattern $f]
1957 } else {
1958 set doesmatch [string match $findpattern $f]
1959 }
1960 if {$doesmatch} {
1961 if {$ty eq "Author"} {
1962 set isbold 2
1963 } else {
1964 set isbold 1
1965 }
1966 }
1967 }
1968 if {[info exists iddrawn($id)]} {
1969 if {$isbold && ![ishighlighted $row]} {
1970 bolden $row [concat $mainfont bold]
1971 }
1972 if {$isbold >= 2} {
1973 bolden_name $row [concat $mainfont bold]
1974 }
1975 }
1976 set nhighlights($row) $isbold
1977}
1978
1979proc vrel_change {name ix op} {
1980 global highlight_related
1981
1982 rhighlight_none
1983 if {$highlight_related ne "None"} {
1984 after idle drawvisible
1985 }
1986}
1987
1988# prepare for testing whether commits are descendents or ancestors of a
1989proc rhighlight_sel {a} {
1990 global descendent desc_todo ancestor anc_todo
1991 global highlight_related rhighlights
1992
1993 catch {unset descendent}
1994 set desc_todo [list $a]
1995 catch {unset ancestor}
1996 set anc_todo [list $a]
1997 if {$highlight_related ne "None"} {
1998 rhighlight_none
1999 after idle drawvisible
2000 }
2001}
2002
2003proc rhighlight_none {} {
2004 global rhighlights
2005
2006 catch {unset rhighlights}
2007 unbolden
2008}
2009
2010proc is_descendent {a} {
2011 global curview children commitrow descendent desc_todo
2012
2013 set v $curview
2014 set la $commitrow($v,$a)
2015 set todo $desc_todo
2016 set leftover {}
2017 set done 0
2018 for {set i 0} {$i < [llength $todo]} {incr i} {
2019 set do [lindex $todo $i]
2020 if {$commitrow($v,$do) < $la} {
2021 lappend leftover $do
2022 continue
2023 }
2024 foreach nk $children($v,$do) {
2025 if {![info exists descendent($nk)]} {
2026 set descendent($nk) 1
2027 lappend todo $nk
2028 if {$nk eq $a} {
2029 set done 1
2030 }
2031 }
2032 }
2033 if {$done} {
2034 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2035 return
2036 }
2037 }
2038 set descendent($a) 0
2039 set desc_todo $leftover
2040}
2041
2042proc is_ancestor {a} {
2043 global curview parentlist commitrow ancestor anc_todo
2044
2045 set v $curview
2046 set la $commitrow($v,$a)
2047 set todo $anc_todo
2048 set leftover {}
2049 set done 0
2050 for {set i 0} {$i < [llength $todo]} {incr i} {
2051 set do [lindex $todo $i]
2052 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2053 lappend leftover $do
2054 continue
2055 }
2056 foreach np [lindex $parentlist $commitrow($v,$do)] {
2057 if {![info exists ancestor($np)]} {
2058 set ancestor($np) 1
2059 lappend todo $np
2060 if {$np eq $a} {
2061 set done 1
2062 }
2063 }
2064 }
2065 if {$done} {
2066 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2067 return
2068 }
2069 }
2070 set ancestor($a) 0
2071 set anc_todo $leftover
2072}
2073
2074proc askrelhighlight {row id} {
2075 global descendent highlight_related iddrawn mainfont rhighlights
2076 global selectedline ancestor
2077
2078 if {![info exists selectedline]} return
2079 set isbold 0
2080 if {$highlight_related eq "Descendent" ||
2081 $highlight_related eq "Not descendent"} {
2082 if {![info exists descendent($id)]} {
2083 is_descendent $id
2084 }
2085 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2086 set isbold 1
2087 }
2088 } elseif {$highlight_related eq "Ancestor" ||
2089 $highlight_related eq "Not ancestor"} {
2090 if {![info exists ancestor($id)]} {
2091 is_ancestor $id
2092 }
2093 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2094 set isbold 1
2095 }
2096 }
2097 if {[info exists iddrawn($id)]} {
2098 if {$isbold && ![ishighlighted $row]} {
2099 bolden $row [concat $mainfont bold]
2100 }
2101 }
2102 set rhighlights($row) $isbold
2103}
2104
2105proc next_hlcont {} {
2106 global fhl_row fhl_dirn displayorder numcommits
2107 global vhighlights fhighlights nhighlights rhighlights
2108 global hlview filehighlight findstring highlight_related
2109
2110 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2111 set row $fhl_row
2112 while {1} {
2113 if {$row < 0 || $row >= $numcommits} {
2114 bell
2115 set fhl_dirn 0
2116 return
2117 }
2118 set id [lindex $displayorder $row]
2119 if {[info exists hlview]} {
2120 if {![info exists vhighlights($row)]} {
2121 askvhighlight $row $id
2122 }
2123 if {$vhighlights($row) > 0} break
2124 }
2125 if {$findstring ne {}} {
2126 if {![info exists nhighlights($row)]} {
2127 askfindhighlight $row $id
2128 }
2129 if {$nhighlights($row) > 0} break
2130 }
2131 if {$highlight_related ne "None"} {
2132 if {![info exists rhighlights($row)]} {
2133 askrelhighlight $row $id
2134 }
2135 if {$rhighlights($row) > 0} break
2136 }
2137 if {[info exists filehighlight]} {
2138 if {![info exists fhighlights($row)]} {
2139 # ask for a few more while we're at it...
2140 set r $row
2141 for {set n 0} {$n < 100} {incr n} {
2142 if {![info exists fhighlights($r)]} {
2143 askfilehighlight $r [lindex $displayorder $r]
2144 }
2145 incr r $fhl_dirn
2146 if {$r < 0 || $r >= $numcommits} break
2147 }
2148 flushhighlights
2149 }
2150 if {$fhighlights($row) < 0} {
2151 set fhl_row $row
2152 return
2153 }
2154 if {$fhighlights($row) > 0} break
2155 }
2156 incr row $fhl_dirn
2157 }
2158 set fhl_dirn 0
2159 selectline $row 1
2160}
2161
2162proc next_highlight {dirn} {
2163 global selectedline fhl_row fhl_dirn
2164 global hlview filehighlight findstring highlight_related
2165
2166 if {![info exists selectedline]} return
2167 if {!([info exists hlview] || $findstring ne {} ||
2168 $highlight_related ne "None" || [info exists filehighlight])} return
2169 set fhl_row [expr {$selectedline + $dirn}]
2170 set fhl_dirn $dirn
2171 next_hlcont
2172}
2173
2174proc cancel_next_highlight {} {
2175 global fhl_dirn
2176
2177 set fhl_dirn 0
2178}
2179
2180# Graph layout functions
2181
2182proc shortids {ids} {
2183 set res {}
2184 foreach id $ids {
2185 if {[llength $id] > 1} {
2186 lappend res [shortids $id]
2187 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2188 lappend res [string range $id 0 7]
2189 } else {
2190 lappend res $id
2191 }
2192 }
2193 return $res
2194}
2195
2196proc incrange {l x o} {
2197 set n [llength $l]
2198 while {$x < $n} {
2199 set e [lindex $l $x]
2200 if {$e ne {}} {
2201 lset l $x [expr {$e + $o}]
2202 }
2203 incr x
2204 }
2205 return $l
2206}
2207
2208proc ntimes {n o} {
2209 set ret {}
2210 for {} {$n > 0} {incr n -1} {
2211 lappend ret $o
2212 }
2213 return $ret
2214}
2215
2216proc usedinrange {id l1 l2} {
2217 global children commitrow childlist curview
2218
2219 if {[info exists commitrow($curview,$id)]} {
2220 set r $commitrow($curview,$id)
2221 if {$l1 <= $r && $r <= $l2} {
2222 return [expr {$r - $l1 + 1}]
2223 }
2224 set kids [lindex $childlist $r]
2225 } else {
2226 set kids $children($curview,$id)
2227 }
2228 foreach c $kids {
2229 set r $commitrow($curview,$c)
2230 if {$l1 <= $r && $r <= $l2} {
2231 return [expr {$r - $l1 + 1}]
2232 }
2233 }
2234 return 0
2235}
2236
2237proc sanity {row {full 0}} {
2238 global rowidlist rowoffsets
2239
2240 set col -1
2241 set ids [lindex $rowidlist $row]
2242 foreach id $ids {
2243 incr col
2244 if {$id eq {}} continue
2245 if {$col < [llength $ids] - 1 &&
2246 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2247 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2248 }
2249 set o [lindex $rowoffsets $row $col]
2250 set y $row
2251 set x $col
2252 while {$o ne {}} {
2253 incr y -1
2254 incr x $o
2255 if {[lindex $rowidlist $y $x] != $id} {
2256 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2257 puts " id=[shortids $id] check started at row $row"
2258 for {set i $row} {$i >= $y} {incr i -1} {
2259 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2260 }
2261 break
2262 }
2263 if {!$full} break
2264 set o [lindex $rowoffsets $y $x]
2265 }
2266 }
2267}
2268
2269proc makeuparrow {oid x y z} {
2270 global rowidlist rowoffsets uparrowlen idrowranges
2271
2272 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2273 incr y -1
2274 incr x $z
2275 set off0 [lindex $rowoffsets $y]
2276 for {set x0 $x} {1} {incr x0} {
2277 if {$x0 >= [llength $off0]} {
2278 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2279 break
2280 }
2281 set z [lindex $off0 $x0]
2282 if {$z ne {}} {
2283 incr x0 $z
2284 break
2285 }
2286 }
2287 set z [expr {$x0 - $x}]
2288 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2289 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2290 }
2291 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2292 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2293 lappend idrowranges($oid) $y
2294}
2295
2296proc initlayout {} {
2297 global rowidlist rowoffsets displayorder commitlisted
2298 global rowlaidout rowoptim
2299 global idinlist rowchk rowrangelist idrowranges
2300 global numcommits canvxmax canv
2301 global nextcolor
2302 global parentlist childlist children
2303 global colormap rowtextx
2304 global linesegends
2305
2306 set numcommits 0
2307 set displayorder {}
2308 set commitlisted {}
2309 set parentlist {}
2310 set childlist {}
2311 set rowrangelist {}
2312 set nextcolor 0
2313 set rowidlist {{}}
2314 set rowoffsets {{}}
2315 catch {unset idinlist}
2316 catch {unset rowchk}
2317 set rowlaidout 0
2318 set rowoptim 0
2319 set canvxmax [$canv cget -width]
2320 catch {unset colormap}
2321 catch {unset rowtextx}
2322 catch {unset idrowranges}
2323 set linesegends {}
2324}
2325
2326proc setcanvscroll {} {
2327 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2328
2329 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2330 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2331 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2332 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2333}
2334
2335proc visiblerows {} {
2336 global canv numcommits linespc
2337
2338 set ymax [lindex [$canv cget -scrollregion] 3]
2339 if {$ymax eq {} || $ymax == 0} return
2340 set f [$canv yview]
2341 set y0 [expr {int([lindex $f 0] * $ymax)}]
2342 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2343 if {$r0 < 0} {
2344 set r0 0
2345 }
2346 set y1 [expr {int([lindex $f 1] * $ymax)}]
2347 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2348 if {$r1 >= $numcommits} {
2349 set r1 [expr {$numcommits - 1}]
2350 }
2351 return [list $r0 $r1]
2352}
2353
2354proc layoutmore {} {
2355 global rowlaidout rowoptim commitidx numcommits optim_delay
2356 global uparrowlen curview
2357
2358 set row $rowlaidout
2359 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2360 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2361 if {$orow > $rowoptim} {
2362 optimize_rows $rowoptim 0 $orow
2363 set rowoptim $orow
2364 }
2365 set canshow [expr {$rowoptim - $optim_delay}]
2366 if {$canshow > $numcommits} {
2367 showstuff $canshow
2368 }
2369}
2370
2371proc showstuff {canshow} {
2372 global numcommits commitrow pending_select selectedline
2373 global linesegends idrowranges idrangedrawn curview
2374
2375 if {$numcommits == 0} {
2376 global phase
2377 set phase "incrdraw"
2378 allcanvs delete all
2379 }
2380 set row $numcommits
2381 set numcommits $canshow
2382 setcanvscroll
2383 set rows [visiblerows]
2384 set r0 [lindex $rows 0]
2385 set r1 [lindex $rows 1]
2386 set selrow -1
2387 for {set r $row} {$r < $canshow} {incr r} {
2388 foreach id [lindex $linesegends [expr {$r+1}]] {
2389 set i -1
2390 foreach {s e} [rowranges $id] {
2391 incr i
2392 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2393 && ![info exists idrangedrawn($id,$i)]} {
2394 drawlineseg $id $i
2395 set idrangedrawn($id,$i) 1
2396 }
2397 }
2398 }
2399 }
2400 if {$canshow > $r1} {
2401 set canshow $r1
2402 }
2403 while {$row < $canshow} {
2404 drawcmitrow $row
2405 incr row
2406 }
2407 if {[info exists pending_select] &&
2408 [info exists commitrow($curview,$pending_select)] &&
2409 $commitrow($curview,$pending_select) < $numcommits} {
2410 selectline $commitrow($curview,$pending_select) 1
2411 }
2412 if {![info exists selectedline] && ![info exists pending_select]} {
2413 selectline 0 1
2414 }
2415}
2416
2417proc layoutrows {row endrow last} {
2418 global rowidlist rowoffsets displayorder
2419 global uparrowlen downarrowlen maxwidth mingaplen
2420 global childlist parentlist
2421 global idrowranges linesegends
2422 global commitidx curview
2423 global idinlist rowchk rowrangelist
2424
2425 set idlist [lindex $rowidlist $row]
2426 set offs [lindex $rowoffsets $row]
2427 while {$row < $endrow} {
2428 set id [lindex $displayorder $row]
2429 set oldolds {}
2430 set newolds {}
2431 foreach p [lindex $parentlist $row] {
2432 if {![info exists idinlist($p)]} {
2433 lappend newolds $p
2434 } elseif {!$idinlist($p)} {
2435 lappend oldolds $p
2436 }
2437 }
2438 set lse {}
2439 set nev [expr {[llength $idlist] + [llength $newolds]
2440 + [llength $oldolds] - $maxwidth + 1}]
2441 if {$nev > 0} {
2442 if {!$last &&
2443 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2444 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2445 set i [lindex $idlist $x]
2446 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2447 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2448 [expr {$row + $uparrowlen + $mingaplen}]]
2449 if {$r == 0} {
2450 set idlist [lreplace $idlist $x $x]
2451 set offs [lreplace $offs $x $x]
2452 set offs [incrange $offs $x 1]
2453 set idinlist($i) 0
2454 set rm1 [expr {$row - 1}]
2455 lappend lse $i
2456 lappend idrowranges($i) $rm1
2457 if {[incr nev -1] <= 0} break
2458 continue
2459 }
2460 set rowchk($id) [expr {$row + $r}]
2461 }
2462 }
2463 lset rowidlist $row $idlist
2464 lset rowoffsets $row $offs
2465 }
2466 lappend linesegends $lse
2467 set col [lsearch -exact $idlist $id]
2468 if {$col < 0} {
2469 set col [llength $idlist]
2470 lappend idlist $id
2471 lset rowidlist $row $idlist
2472 set z {}
2473 if {[lindex $childlist $row] ne {}} {
2474 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2475 unset idinlist($id)
2476 }
2477 lappend offs $z
2478 lset rowoffsets $row $offs
2479 if {$z ne {}} {
2480 makeuparrow $id $col $row $z
2481 }
2482 } else {
2483 unset idinlist($id)
2484 }
2485 set ranges {}
2486 if {[info exists idrowranges($id)]} {
2487 set ranges $idrowranges($id)
2488 lappend ranges $row
2489 unset idrowranges($id)
2490 }
2491 lappend rowrangelist $ranges
2492 incr row
2493 set offs [ntimes [llength $idlist] 0]
2494 set l [llength $newolds]
2495 set idlist [eval lreplace \$idlist $col $col $newolds]
2496 set o 0
2497 if {$l != 1} {
2498 set offs [lrange $offs 0 [expr {$col - 1}]]
2499 foreach x $newolds {
2500 lappend offs {}
2501 incr o -1
2502 }
2503 incr o
2504 set tmp [expr {[llength $idlist] - [llength $offs]}]
2505 if {$tmp > 0} {
2506 set offs [concat $offs [ntimes $tmp $o]]
2507 }
2508 } else {
2509 lset offs $col {}
2510 }
2511 foreach i $newolds {
2512 set idinlist($i) 1
2513 set idrowranges($i) $row
2514 }
2515 incr col $l
2516 foreach oid $oldolds {
2517 set idinlist($oid) 1
2518 set idlist [linsert $idlist $col $oid]
2519 set offs [linsert $offs $col $o]
2520 makeuparrow $oid $col $row $o
2521 incr col
2522 }
2523 lappend rowidlist $idlist
2524 lappend rowoffsets $offs
2525 }
2526 return $row
2527}
2528
2529proc addextraid {id row} {
2530 global displayorder commitrow commitinfo
2531 global commitidx commitlisted
2532 global parentlist childlist children curview
2533
2534 incr commitidx($curview)
2535 lappend displayorder $id
2536 lappend commitlisted 0
2537 lappend parentlist {}
2538 set commitrow($curview,$id) $row
2539 readcommit $id
2540 if {![info exists commitinfo($id)]} {
2541 set commitinfo($id) {"No commit information available"}
2542 }
2543 if {![info exists children($curview,$id)]} {
2544 set children($curview,$id) {}
2545 }
2546 lappend childlist $children($curview,$id)
2547}
2548
2549proc layouttail {} {
2550 global rowidlist rowoffsets idinlist commitidx curview
2551 global idrowranges rowrangelist
2552
2553 set row $commitidx($curview)
2554 set idlist [lindex $rowidlist $row]
2555 while {$idlist ne {}} {
2556 set col [expr {[llength $idlist] - 1}]
2557 set id [lindex $idlist $col]
2558 addextraid $id $row
2559 unset idinlist($id)
2560 lappend idrowranges($id) $row
2561 lappend rowrangelist $idrowranges($id)
2562 unset idrowranges($id)
2563 incr row
2564 set offs [ntimes $col 0]
2565 set idlist [lreplace $idlist $col $col]
2566 lappend rowidlist $idlist
2567 lappend rowoffsets $offs
2568 }
2569
2570 foreach id [array names idinlist] {
2571 addextraid $id $row
2572 lset rowidlist $row [list $id]
2573 lset rowoffsets $row 0
2574 makeuparrow $id 0 $row 0
2575 lappend idrowranges($id) $row
2576 lappend rowrangelist $idrowranges($id)
2577 unset idrowranges($id)
2578 incr row
2579 lappend rowidlist {}
2580 lappend rowoffsets {}
2581 }
2582}
2583
2584proc insert_pad {row col npad} {
2585 global rowidlist rowoffsets
2586
2587 set pad [ntimes $npad {}]
2588 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2589 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2590 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2591}
2592
2593proc optimize_rows {row col endrow} {
2594 global rowidlist rowoffsets idrowranges displayorder
2595
2596 for {} {$row < $endrow} {incr row} {
2597 set idlist [lindex $rowidlist $row]
2598 set offs [lindex $rowoffsets $row]
2599 set haspad 0
2600 for {} {$col < [llength $offs]} {incr col} {
2601 if {[lindex $idlist $col] eq {}} {
2602 set haspad 1
2603 continue
2604 }
2605 set z [lindex $offs $col]
2606 if {$z eq {}} continue
2607 set isarrow 0
2608 set x0 [expr {$col + $z}]
2609 set y0 [expr {$row - 1}]
2610 set z0 [lindex $rowoffsets $y0 $x0]
2611 if {$z0 eq {}} {
2612 set id [lindex $idlist $col]
2613 set ranges [rowranges $id]
2614 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2615 set isarrow 1
2616 }
2617 }
2618 if {$z < -1 || ($z < 0 && $isarrow)} {
2619 set npad [expr {-1 - $z + $isarrow}]
2620 set offs [incrange $offs $col $npad]
2621 insert_pad $y0 $x0 $npad
2622 if {$y0 > 0} {
2623 optimize_rows $y0 $x0 $row
2624 }
2625 set z [lindex $offs $col]
2626 set x0 [expr {$col + $z}]
2627 set z0 [lindex $rowoffsets $y0 $x0]
2628 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2629 set npad [expr {$z - 1 + $isarrow}]
2630 set y1 [expr {$row + 1}]
2631 set offs2 [lindex $rowoffsets $y1]
2632 set x1 -1
2633 foreach z $offs2 {
2634 incr x1
2635 if {$z eq {} || $x1 + $z < $col} continue
2636 if {$x1 + $z > $col} {
2637 incr npad
2638 }
2639 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2640 break
2641 }
2642 set pad [ntimes $npad {}]
2643 set idlist [eval linsert \$idlist $col $pad]
2644 set tmp [eval linsert \$offs $col $pad]
2645 incr col $npad
2646 set offs [incrange $tmp $col [expr {-$npad}]]
2647 set z [lindex $offs $col]
2648 set haspad 1
2649 }
2650 if {$z0 eq {} && !$isarrow} {
2651 # this line links to its first child on row $row-2
2652 set rm2 [expr {$row - 2}]
2653 set id [lindex $displayorder $rm2]
2654 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2655 if {$xc >= 0} {
2656 set z0 [expr {$xc - $x0}]
2657 }
2658 }
2659 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2660 insert_pad $y0 $x0 1
2661 set offs [incrange $offs $col 1]
2662 optimize_rows $y0 [expr {$x0 + 1}] $row
2663 }
2664 }
2665 if {!$haspad} {
2666 set o {}
2667 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2668 set o [lindex $offs $col]
2669 if {$o eq {}} {
2670 # check if this is the link to the first child
2671 set id [lindex $idlist $col]
2672 set ranges [rowranges $id]
2673 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2674 # it is, work out offset to child
2675 set y0 [expr {$row - 1}]
2676 set id [lindex $displayorder $y0]
2677 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2678 if {$x0 >= 0} {
2679 set o [expr {$x0 - $col}]
2680 }
2681 }
2682 }
2683 if {$o eq {} || $o <= 0} break
2684 }
2685 if {$o ne {} && [incr col] < [llength $idlist]} {
2686 set y1 [expr {$row + 1}]
2687 set offs2 [lindex $rowoffsets $y1]
2688 set x1 -1
2689 foreach z $offs2 {
2690 incr x1
2691 if {$z eq {} || $x1 + $z < $col} continue
2692 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2693 break
2694 }
2695 set idlist [linsert $idlist $col {}]
2696 set tmp [linsert $offs $col {}]
2697 incr col
2698 set offs [incrange $tmp $col -1]
2699 }
2700 }
2701 lset rowidlist $row $idlist
2702 lset rowoffsets $row $offs
2703 set col 0
2704 }
2705}
2706
2707proc xc {row col} {
2708 global canvx0 linespc
2709 return [expr {$canvx0 + $col * $linespc}]
2710}
2711
2712proc yc {row} {
2713 global canvy0 linespc
2714 return [expr {$canvy0 + $row * $linespc}]
2715}
2716
2717proc linewidth {id} {
2718 global thickerline lthickness
2719
2720 set wid $lthickness
2721 if {[info exists thickerline] && $id eq $thickerline} {
2722 set wid [expr {2 * $lthickness}]
2723 }
2724 return $wid
2725}
2726
2727proc rowranges {id} {
2728 global phase idrowranges commitrow rowlaidout rowrangelist curview
2729
2730 set ranges {}
2731 if {$phase eq {} ||
2732 ([info exists commitrow($curview,$id)]
2733 && $commitrow($curview,$id) < $rowlaidout)} {
2734 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2735 } elseif {[info exists idrowranges($id)]} {
2736 set ranges $idrowranges($id)
2737 }
2738 return $ranges
2739}
2740
2741proc drawlineseg {id i} {
2742 global rowoffsets rowidlist
2743 global displayorder
2744 global canv colormap linespc
2745 global numcommits commitrow curview
2746
2747 set ranges [rowranges $id]
2748 set downarrow 1
2749 if {[info exists commitrow($curview,$id)]
2750 && $commitrow($curview,$id) < $numcommits} {
2751 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2752 } else {
2753 set downarrow 1
2754 }
2755 set startrow [lindex $ranges [expr {2 * $i}]]
2756 set row [lindex $ranges [expr {2 * $i + 1}]]
2757 if {$startrow == $row} return
2758 assigncolor $id
2759 set coords {}
2760 set col [lsearch -exact [lindex $rowidlist $row] $id]
2761 if {$col < 0} {
2762 puts "oops: drawline: id $id not on row $row"
2763 return
2764 }
2765 set lasto {}
2766 set ns 0
2767 while {1} {
2768 set o [lindex $rowoffsets $row $col]
2769 if {$o eq {}} break
2770 if {$o ne $lasto} {
2771 # changing direction
2772 set x [xc $row $col]
2773 set y [yc $row]
2774 lappend coords $x $y
2775 set lasto $o
2776 }
2777 incr col $o
2778 incr row -1
2779 }
2780 set x [xc $row $col]
2781 set y [yc $row]
2782 lappend coords $x $y
2783 if {$i == 0} {
2784 # draw the link to the first child as part of this line
2785 incr row -1
2786 set child [lindex $displayorder $row]
2787 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2788 if {$ccol >= 0} {
2789 set x [xc $row $ccol]
2790 set y [yc $row]
2791 if {$ccol < $col - 1} {
2792 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2793 } elseif {$ccol > $col + 1} {
2794 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2795 }
2796 lappend coords $x $y
2797 }
2798 }
2799 if {[llength $coords] < 4} return
2800 if {$downarrow} {
2801 # This line has an arrow at the lower end: check if the arrow is
2802 # on a diagonal segment, and if so, work around the Tk 8.4
2803 # refusal to draw arrows on diagonal lines.
2804 set x0 [lindex $coords 0]
2805 set x1 [lindex $coords 2]
2806 if {$x0 != $x1} {
2807 set y0 [lindex $coords 1]
2808 set y1 [lindex $coords 3]
2809 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2810 # we have a nearby vertical segment, just trim off the diag bit
2811 set coords [lrange $coords 2 end]
2812 } else {
2813 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2814 set xi [expr {$x0 - $slope * $linespc / 2}]
2815 set yi [expr {$y0 - $linespc / 2}]
2816 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2817 }
2818 }
2819 }
2820 set arrow [expr {2 * ($i > 0) + $downarrow}]
2821 set arrow [lindex {none first last both} $arrow]
2822 set t [$canv create line $coords -width [linewidth $id] \
2823 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2824 $canv lower $t
2825 bindline $t $id
2826}
2827
2828proc drawparentlinks {id row col olds} {
2829 global rowidlist canv colormap
2830
2831 set row2 [expr {$row + 1}]
2832 set x [xc $row $col]
2833 set y [yc $row]
2834 set y2 [yc $row2]
2835 set ids [lindex $rowidlist $row2]
2836 # rmx = right-most X coord used
2837 set rmx 0
2838 foreach p $olds {
2839 set i [lsearch -exact $ids $p]
2840 if {$i < 0} {
2841 puts "oops, parent $p of $id not in list"
2842 continue
2843 }
2844 set x2 [xc $row2 $i]
2845 if {$x2 > $rmx} {
2846 set rmx $x2
2847 }
2848 set ranges [rowranges $p]
2849 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2850 && $row2 < [lindex $ranges 1]} {
2851 # drawlineseg will do this one for us
2852 continue
2853 }
2854 assigncolor $p
2855 # should handle duplicated parents here...
2856 set coords [list $x $y]
2857 if {$i < $col - 1} {
2858 lappend coords [xc $row [expr {$i + 1}]] $y
2859 } elseif {$i > $col + 1} {
2860 lappend coords [xc $row [expr {$i - 1}]] $y
2861 }
2862 lappend coords $x2 $y2
2863 set t [$canv create line $coords -width [linewidth $p] \
2864 -fill $colormap($p) -tags lines.$p]
2865 $canv lower $t
2866 bindline $t $p
2867 }
2868 return $rmx
2869}
2870
2871proc drawlines {id} {
2872 global colormap canv
2873 global idrangedrawn
2874 global children iddrawn commitrow rowidlist curview
2875
2876 $canv delete lines.$id
2877 set nr [expr {[llength [rowranges $id]] / 2}]
2878 for {set i 0} {$i < $nr} {incr i} {
2879 if {[info exists idrangedrawn($id,$i)]} {
2880 drawlineseg $id $i
2881 }
2882 }
2883 foreach child $children($curview,$id) {
2884 if {[info exists iddrawn($child)]} {
2885 set row $commitrow($curview,$child)
2886 set col [lsearch -exact [lindex $rowidlist $row] $child]
2887 if {$col >= 0} {
2888 drawparentlinks $child $row $col [list $id]
2889 }
2890 }
2891 }
2892}
2893
2894proc drawcmittext {id row col rmx} {
2895 global linespc canv canv2 canv3 canvy0 fgcolor
2896 global commitlisted commitinfo rowidlist
2897 global rowtextx idpos idtags idheads idotherrefs
2898 global linehtag linentag linedtag
2899 global mainfont canvxmax boldrows boldnamerows fgcolor
2900
2901 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2902 set x [xc $row $col]
2903 set y [yc $row]
2904 set orad [expr {$linespc / 3}]
2905 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2906 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2907 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2908 $canv raise $t
2909 $canv bind $t <1> {selcanvline {} %x %y}
2910 set xt [xc $row [llength [lindex $rowidlist $row]]]
2911 if {$xt < $rmx} {
2912 set xt $rmx
2913 }
2914 set rowtextx($row) $xt
2915 set idpos($id) [list $x $xt $y]
2916 if {[info exists idtags($id)] || [info exists idheads($id)]
2917 || [info exists idotherrefs($id)]} {
2918 set xt [drawtags $id $x $xt $y]
2919 }
2920 set headline [lindex $commitinfo($id) 0]
2921 set name [lindex $commitinfo($id) 1]
2922 set date [lindex $commitinfo($id) 2]
2923 set date [formatdate $date]
2924 set font $mainfont
2925 set nfont $mainfont
2926 set isbold [ishighlighted $row]
2927 if {$isbold > 0} {
2928 lappend boldrows $row
2929 lappend font bold
2930 if {$isbold > 1} {
2931 lappend boldnamerows $row
2932 lappend nfont bold
2933 }
2934 }
2935 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2936 -text $headline -font $font -tags text]
2937 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2938 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2939 -text $name -font $nfont -tags text]
2940 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2941 -text $date -font $mainfont -tags text]
2942 set xr [expr {$xt + [font measure $mainfont $headline]}]
2943 if {$xr > $canvxmax} {
2944 set canvxmax $xr
2945 setcanvscroll
2946 }
2947}
2948
2949proc drawcmitrow {row} {
2950 global displayorder rowidlist
2951 global idrangedrawn iddrawn
2952 global commitinfo parentlist numcommits
2953 global filehighlight fhighlights findstring nhighlights
2954 global hlview vhighlights
2955 global highlight_related rhighlights
2956
2957 if {$row >= $numcommits} return
2958 foreach id [lindex $rowidlist $row] {
2959 if {$id eq {}} continue
2960 set i -1
2961 foreach {s e} [rowranges $id] {
2962 incr i
2963 if {$row < $s} continue
2964 if {$e eq {}} break
2965 if {$row <= $e} {
2966 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2967 drawlineseg $id $i
2968 set idrangedrawn($id,$i) 1
2969 }
2970 break
2971 }
2972 }
2973 }
2974
2975 set id [lindex $displayorder $row]
2976 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2977 askvhighlight $row $id
2978 }
2979 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2980 askfilehighlight $row $id
2981 }
2982 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2983 askfindhighlight $row $id
2984 }
2985 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2986 askrelhighlight $row $id
2987 }
2988 if {[info exists iddrawn($id)]} return
2989 set col [lsearch -exact [lindex $rowidlist $row] $id]
2990 if {$col < 0} {
2991 puts "oops, row $row id $id not in list"
2992 return
2993 }
2994 if {![info exists commitinfo($id)]} {
2995 getcommit $id
2996 }
2997 assigncolor $id
2998 set olds [lindex $parentlist $row]
2999 if {$olds ne {}} {
3000 set rmx [drawparentlinks $id $row $col $olds]
3001 } else {
3002 set rmx 0
3003 }
3004 drawcmittext $id $row $col $rmx
3005 set iddrawn($id) 1
3006}
3007
3008proc drawfrac {f0 f1} {
3009 global numcommits canv
3010 global linespc
3011
3012 set ymax [lindex [$canv cget -scrollregion] 3]
3013 if {$ymax eq {} || $ymax == 0} return
3014 set y0 [expr {int($f0 * $ymax)}]
3015 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3016 if {$row < 0} {
3017 set row 0
3018 }
3019 set y1 [expr {int($f1 * $ymax)}]
3020 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3021 if {$endrow >= $numcommits} {
3022 set endrow [expr {$numcommits - 1}]
3023 }
3024 for {} {$row <= $endrow} {incr row} {
3025 drawcmitrow $row
3026 }
3027}
3028
3029proc drawvisible {} {
3030 global canv
3031 eval drawfrac [$canv yview]
3032}
3033
3034proc clear_display {} {
3035 global iddrawn idrangedrawn
3036 global vhighlights fhighlights nhighlights rhighlights
3037
3038 allcanvs delete all
3039 catch {unset iddrawn}
3040 catch {unset idrangedrawn}
3041 catch {unset vhighlights}
3042 catch {unset fhighlights}
3043 catch {unset nhighlights}
3044 catch {unset rhighlights}
3045}
3046
3047proc findcrossings {id} {
3048 global rowidlist parentlist numcommits rowoffsets displayorder
3049
3050 set cross {}
3051 set ccross {}
3052 foreach {s e} [rowranges $id] {
3053 if {$e >= $numcommits} {
3054 set e [expr {$numcommits - 1}]
3055 }
3056 if {$e <= $s} continue
3057 set x [lsearch -exact [lindex $rowidlist $e] $id]
3058 if {$x < 0} {
3059 puts "findcrossings: oops, no [shortids $id] in row $e"
3060 continue
3061 }
3062 for {set row $e} {[incr row -1] >= $s} {} {
3063 set olds [lindex $parentlist $row]
3064 set kid [lindex $displayorder $row]
3065 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3066 if {$kidx < 0} continue
3067 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3068 foreach p $olds {
3069 set px [lsearch -exact $nextrow $p]
3070 if {$px < 0} continue
3071 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3072 if {[lsearch -exact $ccross $p] >= 0} continue
3073 if {$x == $px + ($kidx < $px? -1: 1)} {
3074 lappend ccross $p
3075 } elseif {[lsearch -exact $cross $p] < 0} {
3076 lappend cross $p
3077 }
3078 }
3079 }
3080 set inc [lindex $rowoffsets $row $x]
3081 if {$inc eq {}} break
3082 incr x $inc
3083 }
3084 }
3085 return [concat $ccross {{}} $cross]
3086}
3087
3088proc assigncolor {id} {
3089 global colormap colors nextcolor
3090 global commitrow parentlist children children curview
3091
3092 if {[info exists colormap($id)]} return
3093 set ncolors [llength $colors]
3094 if {[info exists children($curview,$id)]} {
3095 set kids $children($curview,$id)
3096 } else {
3097 set kids {}
3098 }
3099 if {[llength $kids] == 1} {
3100 set child [lindex $kids 0]
3101 if {[info exists colormap($child)]
3102 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3103 set colormap($id) $colormap($child)
3104 return
3105 }
3106 }
3107 set badcolors {}
3108 set origbad {}
3109 foreach x [findcrossings $id] {
3110 if {$x eq {}} {
3111 # delimiter between corner crossings and other crossings
3112 if {[llength $badcolors] >= $ncolors - 1} break
3113 set origbad $badcolors
3114 }
3115 if {[info exists colormap($x)]
3116 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3117 lappend badcolors $colormap($x)
3118 }
3119 }
3120 if {[llength $badcolors] >= $ncolors} {
3121 set badcolors $origbad
3122 }
3123 set origbad $badcolors
3124 if {[llength $badcolors] < $ncolors - 1} {
3125 foreach child $kids {
3126 if {[info exists colormap($child)]
3127 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3128 lappend badcolors $colormap($child)
3129 }
3130 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3131 if {[info exists colormap($p)]
3132 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3133 lappend badcolors $colormap($p)
3134 }
3135 }
3136 }
3137 if {[llength $badcolors] >= $ncolors} {
3138 set badcolors $origbad
3139 }
3140 }
3141 for {set i 0} {$i <= $ncolors} {incr i} {
3142 set c [lindex $colors $nextcolor]
3143 if {[incr nextcolor] >= $ncolors} {
3144 set nextcolor 0
3145 }
3146 if {[lsearch -exact $badcolors $c]} break
3147 }
3148 set colormap($id) $c
3149}
3150
3151proc bindline {t id} {
3152 global canv
3153
3154 $canv bind $t <Enter> "lineenter %x %y $id"
3155 $canv bind $t <Motion> "linemotion %x %y $id"
3156 $canv bind $t <Leave> "lineleave $id"
3157 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3158}
3159
3160proc drawtags {id x xt y1} {
3161 global idtags idheads idotherrefs mainhead
3162 global linespc lthickness
3163 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3164
3165 set marks {}
3166 set ntags 0
3167 set nheads 0
3168 if {[info exists idtags($id)]} {
3169 set marks $idtags($id)
3170 set ntags [llength $marks]
3171 }
3172 if {[info exists idheads($id)]} {
3173 set marks [concat $marks $idheads($id)]
3174 set nheads [llength $idheads($id)]
3175 }
3176 if {[info exists idotherrefs($id)]} {
3177 set marks [concat $marks $idotherrefs($id)]
3178 }
3179 if {$marks eq {}} {
3180 return $xt
3181 }
3182
3183 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3184 set yt [expr {$y1 - 0.5 * $linespc}]
3185 set yb [expr {$yt + $linespc - 1}]
3186 set xvals {}
3187 set wvals {}
3188 set i -1
3189 foreach tag $marks {
3190 incr i
3191 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3192 set wid [font measure [concat $mainfont bold] $tag]
3193 } else {
3194 set wid [font measure $mainfont $tag]
3195 }
3196 lappend xvals $xt
3197 lappend wvals $wid
3198 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3199 }
3200 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3201 -width $lthickness -fill black -tags tag.$id]
3202 $canv lower $t
3203 foreach tag $marks x $xvals wid $wvals {
3204 set xl [expr {$x + $delta}]
3205 set xr [expr {$x + $delta + $wid + $lthickness}]
3206 set font $mainfont
3207 if {[incr ntags -1] >= 0} {
3208 # draw a tag
3209 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3210 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3211 -width 1 -outline black -fill yellow -tags tag.$id]
3212 $canv bind $t <1> [list showtag $tag 1]
3213 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3214 } else {
3215 # draw a head or other ref
3216 if {[incr nheads -1] >= 0} {
3217 set col green
3218 if {$tag eq $mainhead} {
3219 lappend font bold
3220 }
3221 } else {
3222 set col "#ddddff"
3223 }
3224 set xl [expr {$xl - $delta/2}]
3225 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3226 -width 1 -outline black -fill $col -tags tag.$id
3227 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3228 set rwid [font measure $mainfont $remoteprefix]
3229 set xi [expr {$x + 1}]
3230 set yti [expr {$yt + 1}]
3231 set xri [expr {$x + $rwid}]
3232 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3233 -width 0 -fill "#ffddaa" -tags tag.$id
3234 }
3235 }
3236 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3237 -font $font -tags [list tag.$id text]]
3238 if {$ntags >= 0} {
3239 $canv bind $t <1> [list showtag $tag 1]
3240 }
3241 }
3242 return $xt
3243}
3244
3245proc xcoord {i level ln} {
3246 global canvx0 xspc1 xspc2
3247
3248 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3249 if {$i > 0 && $i == $level} {
3250 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3251 } elseif {$i > $level} {
3252 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3253 }
3254 return $x
3255}
3256
3257proc show_status {msg} {
3258 global canv mainfont fgcolor
3259
3260 clear_display
3261 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3262 -tags text -fill $fgcolor
3263}
3264
3265proc finishcommits {} {
3266 global commitidx phase curview
3267 global pending_select
3268
3269 if {$commitidx($curview) > 0} {
3270 drawrest
3271 } else {
3272 show_status "No commits selected"
3273 }
3274 set phase {}
3275 catch {unset pending_select}
3276}
3277
3278# Don't change the text pane cursor if it is currently the hand cursor,
3279# showing that we are over a sha1 ID link.
3280proc settextcursor {c} {
3281 global ctext curtextcursor
3282
3283 if {[$ctext cget -cursor] == $curtextcursor} {
3284 $ctext config -cursor $c
3285 }
3286 set curtextcursor $c
3287}
3288
3289proc nowbusy {what} {
3290 global isbusy
3291
3292 if {[array names isbusy] eq {}} {
3293 . config -cursor watch
3294 settextcursor watch
3295 }
3296 set isbusy($what) 1
3297}
3298
3299proc notbusy {what} {
3300 global isbusy maincursor textcursor
3301
3302 catch {unset isbusy($what)}
3303 if {[array names isbusy] eq {}} {
3304 . config -cursor $maincursor
3305 settextcursor $textcursor
3306 }
3307}
3308
3309proc drawrest {} {
3310 global startmsecs
3311 global rowlaidout commitidx curview
3312 global pending_select
3313
3314 set row $rowlaidout
3315 layoutrows $rowlaidout $commitidx($curview) 1
3316 layouttail
3317 optimize_rows $row 0 $commitidx($curview)
3318 showstuff $commitidx($curview)
3319 if {[info exists pending_select]} {
3320 selectline 0 1
3321 }
3322
3323 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3324 #global numcommits
3325 #puts "overall $drawmsecs ms for $numcommits commits"
3326}
3327
3328proc findmatches {f} {
3329 global findtype foundstring foundstrlen
3330 if {$findtype == "Regexp"} {
3331 set matches [regexp -indices -all -inline $foundstring $f]
3332 } else {
3333 if {$findtype == "IgnCase"} {
3334 set str [string tolower $f]
3335 } else {
3336 set str $f
3337 }
3338 set matches {}
3339 set i 0
3340 while {[set j [string first $foundstring $str $i]] >= 0} {
3341 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3342 set i [expr {$j + $foundstrlen}]
3343 }
3344 }
3345 return $matches
3346}
3347
3348proc dofind {} {
3349 global findtype findloc findstring markedmatches commitinfo
3350 global numcommits displayorder linehtag linentag linedtag
3351 global mainfont canv canv2 canv3 selectedline
3352 global matchinglines foundstring foundstrlen matchstring
3353 global commitdata
3354
3355 stopfindproc
3356 unmarkmatches
3357 cancel_next_highlight
3358 focus .
3359 set matchinglines {}
3360 if {$findtype == "IgnCase"} {
3361 set foundstring [string tolower $findstring]
3362 } else {
3363 set foundstring $findstring
3364 }
3365 set foundstrlen [string length $findstring]
3366 if {$foundstrlen == 0} return
3367 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3368 set matchstring "*$matchstring*"
3369 if {![info exists selectedline]} {
3370 set oldsel -1
3371 } else {
3372 set oldsel $selectedline
3373 }
3374 set didsel 0
3375 set fldtypes {Headline Author Date Committer CDate Comments}
3376 set l -1
3377 foreach id $displayorder {
3378 set d $commitdata($id)
3379 incr l
3380 if {$findtype == "Regexp"} {
3381 set doesmatch [regexp $foundstring $d]
3382 } elseif {$findtype == "IgnCase"} {
3383 set doesmatch [string match -nocase $matchstring $d]
3384 } else {
3385 set doesmatch [string match $matchstring $d]
3386 }
3387 if {!$doesmatch} continue
3388 if {![info exists commitinfo($id)]} {
3389 getcommit $id
3390 }
3391 set info $commitinfo($id)
3392 set doesmatch 0
3393 foreach f $info ty $fldtypes {
3394 if {$findloc != "All fields" && $findloc != $ty} {
3395 continue
3396 }
3397 set matches [findmatches $f]
3398 if {$matches == {}} continue
3399 set doesmatch 1
3400 if {$ty == "Headline"} {
3401 drawcmitrow $l
3402 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3403 } elseif {$ty == "Author"} {
3404 drawcmitrow $l
3405 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3406 } elseif {$ty == "Date"} {
3407 drawcmitrow $l
3408 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3409 }
3410 }
3411 if {$doesmatch} {
3412 lappend matchinglines $l
3413 if {!$didsel && $l > $oldsel} {
3414 findselectline $l
3415 set didsel 1
3416 }
3417 }
3418 }
3419 if {$matchinglines == {}} {
3420 bell
3421 } elseif {!$didsel} {
3422 findselectline [lindex $matchinglines 0]
3423 }
3424}
3425
3426proc findselectline {l} {
3427 global findloc commentend ctext
3428 selectline $l 1
3429 if {$findloc == "All fields" || $findloc == "Comments"} {
3430 # highlight the matches in the comments
3431 set f [$ctext get 1.0 $commentend]
3432 set matches [findmatches $f]
3433 foreach match $matches {
3434 set start [lindex $match 0]
3435 set end [expr {[lindex $match 1] + 1}]
3436 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3437 }
3438 }
3439}
3440
3441proc findnext {restart} {
3442 global matchinglines selectedline
3443 if {![info exists matchinglines]} {
3444 if {$restart} {
3445 dofind
3446 }
3447 return
3448 }
3449 if {![info exists selectedline]} return
3450 foreach l $matchinglines {
3451 if {$l > $selectedline} {
3452 findselectline $l
3453 return
3454 }
3455 }
3456 bell
3457}
3458
3459proc findprev {} {
3460 global matchinglines selectedline
3461 if {![info exists matchinglines]} {
3462 dofind
3463 return
3464 }
3465 if {![info exists selectedline]} return
3466 set prev {}
3467 foreach l $matchinglines {
3468 if {$l >= $selectedline} break
3469 set prev $l
3470 }
3471 if {$prev != {}} {
3472 findselectline $prev
3473 } else {
3474 bell
3475 }
3476}
3477
3478proc stopfindproc {{done 0}} {
3479 global findprocpid findprocfile findids
3480 global ctext findoldcursor phase maincursor textcursor
3481 global findinprogress
3482
3483 catch {unset findids}
3484 if {[info exists findprocpid]} {
3485 if {!$done} {
3486 catch {exec kill $findprocpid}
3487 }
3488 catch {close $findprocfile}
3489 unset findprocpid
3490 }
3491 catch {unset findinprogress}
3492 notbusy find
3493}
3494
3495# mark a commit as matching by putting a yellow background
3496# behind the headline
3497proc markheadline {l id} {
3498 global canv mainfont linehtag
3499
3500 drawcmitrow $l
3501 set bbox [$canv bbox $linehtag($l)]
3502 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3503 $canv lower $t
3504}
3505
3506# mark the bits of a headline, author or date that match a find string
3507proc markmatches {canv l str tag matches font} {
3508 set bbox [$canv bbox $tag]
3509 set x0 [lindex $bbox 0]
3510 set y0 [lindex $bbox 1]
3511 set y1 [lindex $bbox 3]
3512 foreach match $matches {
3513 set start [lindex $match 0]
3514 set end [lindex $match 1]
3515 if {$start > $end} continue
3516 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3517 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3518 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3519 [expr {$x0+$xlen+2}] $y1 \
3520 -outline {} -tags matches -fill yellow]
3521 $canv lower $t
3522 }
3523}
3524
3525proc unmarkmatches {} {
3526 global matchinglines findids
3527 allcanvs delete matches
3528 catch {unset matchinglines}
3529 catch {unset findids}
3530}
3531
3532proc selcanvline {w x y} {
3533 global canv canvy0 ctext linespc
3534 global rowtextx
3535 set ymax [lindex [$canv cget -scrollregion] 3]
3536 if {$ymax == {}} return
3537 set yfrac [lindex [$canv yview] 0]
3538 set y [expr {$y + $yfrac * $ymax}]
3539 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3540 if {$l < 0} {
3541 set l 0
3542 }
3543 if {$w eq $canv} {
3544 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3545 }
3546 unmarkmatches
3547 selectline $l 1
3548}
3549
3550proc commit_descriptor {p} {
3551 global commitinfo
3552 if {![info exists commitinfo($p)]} {
3553 getcommit $p
3554 }
3555 set l "..."
3556 if {[llength $commitinfo($p)] > 1} {
3557 set l [lindex $commitinfo($p) 0]
3558 }
3559 return "$p ($l)\n"
3560}
3561
3562# append some text to the ctext widget, and make any SHA1 ID
3563# that we know about be a clickable link.
3564proc appendwithlinks {text tags} {
3565 global ctext commitrow linknum curview
3566
3567 set start [$ctext index "end - 1c"]
3568 $ctext insert end $text $tags
3569 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3570 foreach l $links {
3571 set s [lindex $l 0]
3572 set e [lindex $l 1]
3573 set linkid [string range $text $s $e]
3574 if {![info exists commitrow($curview,$linkid)]} continue
3575 incr e
3576 $ctext tag add link "$start + $s c" "$start + $e c"
3577 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3578 $ctext tag bind link$linknum <1> \
3579 [list selectline $commitrow($curview,$linkid) 1]
3580 incr linknum
3581 }
3582 $ctext tag conf link -foreground blue -underline 1
3583 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3584 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3585}
3586
3587proc viewnextline {dir} {
3588 global canv linespc
3589
3590 $canv delete hover
3591 set ymax [lindex [$canv cget -scrollregion] 3]
3592 set wnow [$canv yview]
3593 set wtop [expr {[lindex $wnow 0] * $ymax}]
3594 set newtop [expr {$wtop + $dir * $linespc}]
3595 if {$newtop < 0} {
3596 set newtop 0
3597 } elseif {$newtop > $ymax} {
3598 set newtop $ymax
3599 }
3600 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3601}
3602
3603# add a list of tag or branch names at position pos
3604# returns the number of names inserted
3605proc appendrefs {pos l var} {
3606 global ctext commitrow linknum curview idtags $var
3607
3608 if {[catch {$ctext index $pos}]} {
3609 return 0
3610 }
3611 set tags {}
3612 foreach id $l {
3613 foreach tag [set $var\($id\)] {
3614 lappend tags [concat $tag $id]
3615 }
3616 }
3617 set tags [lsort -index 1 $tags]
3618 set sep {}
3619 foreach tag $tags {
3620 set name [lindex $tag 0]
3621 set id [lindex $tag 1]
3622 set lk link$linknum
3623 incr linknum
3624 $ctext insert $pos $sep
3625 $ctext insert $pos $name $lk
3626 $ctext tag conf $lk -foreground blue
3627 if {[info exists commitrow($curview,$id)]} {
3628 $ctext tag bind $lk <1> \
3629 [list selectline $commitrow($curview,$id) 1]
3630 $ctext tag conf $lk -underline 1
3631 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3632 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3633 }
3634 set sep ", "
3635 }
3636 return [llength $tags]
3637}
3638
3639# called when we have finished computing the nearby tags
3640proc dispneartags {} {
3641 global selectedline currentid ctext anc_tags desc_tags showneartags
3642 global desc_heads
3643
3644 if {![info exists selectedline] || !$showneartags} return
3645 set id $currentid
3646 $ctext conf -state normal
3647 if {[info exists desc_heads($id)]} {
3648 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3649 $ctext insert "branch -2c" "es"
3650 }
3651 }
3652 if {[info exists anc_tags($id)]} {
3653 appendrefs follows $anc_tags($id) idtags
3654 }
3655 if {[info exists desc_tags($id)]} {
3656 appendrefs precedes $desc_tags($id) idtags
3657 }
3658 $ctext conf -state disabled
3659}
3660
3661proc selectline {l isnew} {
3662 global canv canv2 canv3 ctext commitinfo selectedline
3663 global displayorder linehtag linentag linedtag
3664 global canvy0 linespc parentlist childlist
3665 global currentid sha1entry
3666 global commentend idtags linknum
3667 global mergemax numcommits pending_select
3668 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3669
3670 catch {unset pending_select}
3671 $canv delete hover
3672 normalline
3673 cancel_next_highlight
3674 if {$l < 0 || $l >= $numcommits} return
3675 set y [expr {$canvy0 + $l * $linespc}]
3676 set ymax [lindex [$canv cget -scrollregion] 3]
3677 set ytop [expr {$y - $linespc - 1}]
3678 set ybot [expr {$y + $linespc + 1}]
3679 set wnow [$canv yview]
3680 set wtop [expr {[lindex $wnow 0] * $ymax}]
3681 set wbot [expr {[lindex $wnow 1] * $ymax}]
3682 set wh [expr {$wbot - $wtop}]
3683 set newtop $wtop
3684 if {$ytop < $wtop} {
3685 if {$ybot < $wtop} {
3686 set newtop [expr {$y - $wh / 2.0}]
3687 } else {
3688 set newtop $ytop
3689 if {$newtop > $wtop - $linespc} {
3690 set newtop [expr {$wtop - $linespc}]
3691 }
3692 }
3693 } elseif {$ybot > $wbot} {
3694 if {$ytop > $wbot} {
3695 set newtop [expr {$y - $wh / 2.0}]
3696 } else {
3697 set newtop [expr {$ybot - $wh}]
3698 if {$newtop < $wtop + $linespc} {
3699 set newtop [expr {$wtop + $linespc}]
3700 }
3701 }
3702 }
3703 if {$newtop != $wtop} {
3704 if {$newtop < 0} {
3705 set newtop 0
3706 }
3707 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3708 drawvisible
3709 }
3710
3711 if {![info exists linehtag($l)]} return
3712 $canv delete secsel
3713 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3714 -tags secsel -fill [$canv cget -selectbackground]]
3715 $canv lower $t
3716 $canv2 delete secsel
3717 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3718 -tags secsel -fill [$canv2 cget -selectbackground]]
3719 $canv2 lower $t
3720 $canv3 delete secsel
3721 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3722 -tags secsel -fill [$canv3 cget -selectbackground]]
3723 $canv3 lower $t
3724
3725 if {$isnew} {
3726 addtohistory [list selectline $l 0]
3727 }
3728
3729 set selectedline $l
3730
3731 set id [lindex $displayorder $l]
3732 set currentid $id
3733 $sha1entry delete 0 end
3734 $sha1entry insert 0 $id
3735 $sha1entry selection from 0
3736 $sha1entry selection to end
3737 rhighlight_sel $id
3738
3739 $ctext conf -state normal
3740 clear_ctext
3741 set linknum 0
3742 set info $commitinfo($id)
3743 set date [formatdate [lindex $info 2]]
3744 $ctext insert end "Author: [lindex $info 1] $date\n"
3745 set date [formatdate [lindex $info 4]]
3746 $ctext insert end "Committer: [lindex $info 3] $date\n"
3747 if {[info exists idtags($id)]} {
3748 $ctext insert end "Tags:"
3749 foreach tag $idtags($id) {
3750 $ctext insert end " $tag"
3751 }
3752 $ctext insert end "\n"
3753 }
3754
3755 set headers {}
3756 set olds [lindex $parentlist $l]
3757 if {[llength $olds] > 1} {
3758 set np 0
3759 foreach p $olds {
3760 if {$np >= $mergemax} {
3761 set tag mmax
3762 } else {
3763 set tag m$np
3764 }
3765 $ctext insert end "Parent: " $tag
3766 appendwithlinks [commit_descriptor $p] {}
3767 incr np
3768 }
3769 } else {
3770 foreach p $olds {
3771 append headers "Parent: [commit_descriptor $p]"
3772 }
3773 }
3774
3775 foreach c [lindex $childlist $l] {
3776 append headers "Child: [commit_descriptor $c]"
3777 }
3778
3779 # make anything that looks like a SHA1 ID be a clickable link
3780 appendwithlinks $headers {}
3781 if {$showneartags} {
3782 if {![info exists allcommits]} {
3783 getallcommits
3784 }
3785 $ctext insert end "Branch: "
3786 $ctext mark set branch "end -1c"
3787 $ctext mark gravity branch left
3788 if {[info exists desc_heads($id)]} {
3789 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3790 # turn "Branch" into "Branches"
3791 $ctext insert "branch -2c" "es"
3792 }
3793 }
3794 $ctext insert end "\nFollows: "
3795 $ctext mark set follows "end -1c"
3796 $ctext mark gravity follows left
3797 if {[info exists anc_tags($id)]} {
3798 appendrefs follows $anc_tags($id) idtags
3799 }
3800 $ctext insert end "\nPrecedes: "
3801 $ctext mark set precedes "end -1c"
3802 $ctext mark gravity precedes left
3803 if {[info exists desc_tags($id)]} {
3804 appendrefs precedes $desc_tags($id) idtags
3805 }
3806 $ctext insert end "\n"
3807 }
3808 $ctext insert end "\n"
3809 appendwithlinks [lindex $info 5] {comment}
3810
3811 $ctext tag delete Comments
3812 $ctext tag remove found 1.0 end
3813 $ctext conf -state disabled
3814 set commentend [$ctext index "end - 1c"]
3815
3816 init_flist "Comments"
3817 if {$cmitmode eq "tree"} {
3818 gettree $id
3819 } elseif {[llength $olds] <= 1} {
3820 startdiff $id
3821 } else {
3822 mergediff $id $l
3823 }
3824}
3825
3826proc selfirstline {} {
3827 unmarkmatches
3828 selectline 0 1
3829}
3830
3831proc sellastline {} {
3832 global numcommits
3833 unmarkmatches
3834 set l [expr {$numcommits - 1}]
3835 selectline $l 1
3836}
3837
3838proc selnextline {dir} {
3839 global selectedline
3840 if {![info exists selectedline]} return
3841 set l [expr {$selectedline + $dir}]
3842 unmarkmatches
3843 selectline $l 1
3844}
3845
3846proc selnextpage {dir} {
3847 global canv linespc selectedline numcommits
3848
3849 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3850 if {$lpp < 1} {
3851 set lpp 1
3852 }
3853 allcanvs yview scroll [expr {$dir * $lpp}] units
3854 drawvisible
3855 if {![info exists selectedline]} return
3856 set l [expr {$selectedline + $dir * $lpp}]
3857 if {$l < 0} {
3858 set l 0
3859 } elseif {$l >= $numcommits} {
3860 set l [expr $numcommits - 1]
3861 }
3862 unmarkmatches
3863 selectline $l 1
3864}
3865
3866proc unselectline {} {
3867 global selectedline currentid
3868
3869 catch {unset selectedline}
3870 catch {unset currentid}
3871 allcanvs delete secsel
3872 rhighlight_none
3873 cancel_next_highlight
3874}
3875
3876proc reselectline {} {
3877 global selectedline
3878
3879 if {[info exists selectedline]} {
3880 selectline $selectedline 0
3881 }
3882}
3883
3884proc addtohistory {cmd} {
3885 global history historyindex curview
3886
3887 set elt [list $curview $cmd]
3888 if {$historyindex > 0
3889 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3890 return
3891 }
3892
3893 if {$historyindex < [llength $history]} {
3894 set history [lreplace $history $historyindex end $elt]
3895 } else {
3896 lappend history $elt
3897 }
3898 incr historyindex
3899 if {$historyindex > 1} {
3900 .ctop.top.bar.leftbut conf -state normal
3901 } else {
3902 .ctop.top.bar.leftbut conf -state disabled
3903 }
3904 .ctop.top.bar.rightbut conf -state disabled
3905}
3906
3907proc godo {elt} {
3908 global curview
3909
3910 set view [lindex $elt 0]
3911 set cmd [lindex $elt 1]
3912 if {$curview != $view} {
3913 showview $view
3914 }
3915 eval $cmd
3916}
3917
3918proc goback {} {
3919 global history historyindex
3920
3921 if {$historyindex > 1} {
3922 incr historyindex -1
3923 godo [lindex $history [expr {$historyindex - 1}]]
3924 .ctop.top.bar.rightbut conf -state normal
3925 }
3926 if {$historyindex <= 1} {
3927 .ctop.top.bar.leftbut conf -state disabled
3928 }
3929}
3930
3931proc goforw {} {
3932 global history historyindex
3933
3934 if {$historyindex < [llength $history]} {
3935 set cmd [lindex $history $historyindex]
3936 incr historyindex
3937 godo $cmd
3938 .ctop.top.bar.leftbut conf -state normal
3939 }
3940 if {$historyindex >= [llength $history]} {
3941 .ctop.top.bar.rightbut conf -state disabled
3942 }
3943}
3944
3945proc gettree {id} {
3946 global treefilelist treeidlist diffids diffmergeid treepending
3947
3948 set diffids $id
3949 catch {unset diffmergeid}
3950 if {![info exists treefilelist($id)]} {
3951 if {![info exists treepending]} {
3952 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3953 return
3954 }
3955 set treepending $id
3956 set treefilelist($id) {}
3957 set treeidlist($id) {}
3958 fconfigure $gtf -blocking 0
3959 fileevent $gtf readable [list gettreeline $gtf $id]
3960 }
3961 } else {
3962 setfilelist $id
3963 }
3964}
3965
3966proc gettreeline {gtf id} {
3967 global treefilelist treeidlist treepending cmitmode diffids
3968
3969 while {[gets $gtf line] >= 0} {
3970 if {[lindex $line 1] ne "blob"} continue
3971 set sha1 [lindex $line 2]
3972 set fname [lindex $line 3]
3973 lappend treefilelist($id) $fname
3974 lappend treeidlist($id) $sha1
3975 }
3976 if {![eof $gtf]} return
3977 close $gtf
3978 unset treepending
3979 if {$cmitmode ne "tree"} {
3980 if {![info exists diffmergeid]} {
3981 gettreediffs $diffids
3982 }
3983 } elseif {$id ne $diffids} {
3984 gettree $diffids
3985 } else {
3986 setfilelist $id
3987 }
3988}
3989
3990proc showfile {f} {
3991 global treefilelist treeidlist diffids
3992 global ctext commentend
3993
3994 set i [lsearch -exact $treefilelist($diffids) $f]
3995 if {$i < 0} {
3996 puts "oops, $f not in list for id $diffids"
3997 return
3998 }
3999 set blob [lindex $treeidlist($diffids) $i]
4000 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4001 puts "oops, error reading blob $blob: $err"
4002 return
4003 }
4004 fconfigure $bf -blocking 0
4005 fileevent $bf readable [list getblobline $bf $diffids]
4006 $ctext config -state normal
4007 clear_ctext $commentend
4008 $ctext insert end "\n"
4009 $ctext insert end "$f\n" filesep
4010 $ctext config -state disabled
4011 $ctext yview $commentend
4012}
4013
4014proc getblobline {bf id} {
4015 global diffids cmitmode ctext
4016
4017 if {$id ne $diffids || $cmitmode ne "tree"} {
4018 catch {close $bf}
4019 return
4020 }
4021 $ctext config -state normal
4022 while {[gets $bf line] >= 0} {
4023 $ctext insert end "$line\n"
4024 }
4025 if {[eof $bf]} {
4026 # delete last newline
4027 $ctext delete "end - 2c" "end - 1c"
4028 close $bf
4029 }
4030 $ctext config -state disabled
4031}
4032
4033proc mergediff {id l} {
4034 global diffmergeid diffopts mdifffd
4035 global diffids
4036 global parentlist
4037
4038 set diffmergeid $id
4039 set diffids $id
4040 # this doesn't seem to actually affect anything...
4041 set env(GIT_DIFF_OPTS) $diffopts
4042 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4043 if {[catch {set mdf [open $cmd r]} err]} {
4044 error_popup "Error getting merge diffs: $err"
4045 return
4046 }
4047 fconfigure $mdf -blocking 0
4048 set mdifffd($id) $mdf
4049 set np [llength [lindex $parentlist $l]]
4050 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4051 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4052}
4053
4054proc getmergediffline {mdf id np} {
4055 global diffmergeid ctext cflist nextupdate mergemax
4056 global difffilestart mdifffd
4057
4058 set n [gets $mdf line]
4059 if {$n < 0} {
4060 if {[eof $mdf]} {
4061 close $mdf
4062 }
4063 return
4064 }
4065 if {![info exists diffmergeid] || $id != $diffmergeid
4066 || $mdf != $mdifffd($id)} {
4067 return
4068 }
4069 $ctext conf -state normal
4070 if {[regexp {^diff --cc (.*)} $line match fname]} {
4071 # start of a new file
4072 $ctext insert end "\n"
4073 set here [$ctext index "end - 1c"]
4074 lappend difffilestart $here
4075 add_flist [list $fname]
4076 set l [expr {(78 - [string length $fname]) / 2}]
4077 set pad [string range "----------------------------------------" 1 $l]
4078 $ctext insert end "$pad $fname $pad\n" filesep
4079 } elseif {[regexp {^@@} $line]} {
4080 $ctext insert end "$line\n" hunksep
4081 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4082 # do nothing
4083 } else {
4084 # parse the prefix - one ' ', '-' or '+' for each parent
4085 set spaces {}
4086 set minuses {}
4087 set pluses {}
4088 set isbad 0
4089 for {set j 0} {$j < $np} {incr j} {
4090 set c [string range $line $j $j]
4091 if {$c == " "} {
4092 lappend spaces $j
4093 } elseif {$c == "-"} {
4094 lappend minuses $j
4095 } elseif {$c == "+"} {
4096 lappend pluses $j
4097 } else {
4098 set isbad 1
4099 break
4100 }
4101 }
4102 set tags {}
4103 set num {}
4104 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4105 # line doesn't appear in result, parents in $minuses have the line
4106 set num [lindex $minuses 0]
4107 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4108 # line appears in result, parents in $pluses don't have the line
4109 lappend tags mresult
4110 set num [lindex $spaces 0]
4111 }
4112 if {$num ne {}} {
4113 if {$num >= $mergemax} {
4114 set num "max"
4115 }
4116 lappend tags m$num
4117 }
4118 $ctext insert end "$line\n" $tags
4119 }
4120 $ctext conf -state disabled
4121 if {[clock clicks -milliseconds] >= $nextupdate} {
4122 incr nextupdate 100
4123 fileevent $mdf readable {}
4124 update
4125 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4126 }
4127}
4128
4129proc startdiff {ids} {
4130 global treediffs diffids treepending diffmergeid
4131
4132 set diffids $ids
4133 catch {unset diffmergeid}
4134 if {![info exists treediffs($ids)]} {
4135 if {![info exists treepending]} {
4136 gettreediffs $ids
4137 }
4138 } else {
4139 addtocflist $ids
4140 }
4141}
4142
4143proc addtocflist {ids} {
4144 global treediffs cflist
4145 add_flist $treediffs($ids)
4146 getblobdiffs $ids
4147}
4148
4149proc gettreediffs {ids} {
4150 global treediff treepending
4151 set treepending $ids
4152 set treediff {}
4153 if {[catch \
4154 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4155 ]} return
4156 fconfigure $gdtf -blocking 0
4157 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4158}
4159
4160proc gettreediffline {gdtf ids} {
4161 global treediff treediffs treepending diffids diffmergeid
4162 global cmitmode
4163
4164 set n [gets $gdtf line]
4165 if {$n < 0} {
4166 if {![eof $gdtf]} return
4167 close $gdtf
4168 set treediffs($ids) $treediff
4169 unset treepending
4170 if {$cmitmode eq "tree"} {
4171 gettree $diffids
4172 } elseif {$ids != $diffids} {
4173 if {![info exists diffmergeid]} {
4174 gettreediffs $diffids
4175 }
4176 } else {
4177 addtocflist $ids
4178 }
4179 return
4180 }
4181 set file [lindex $line 5]
4182 lappend treediff $file
4183}
4184
4185proc getblobdiffs {ids} {
4186 global diffopts blobdifffd diffids env curdifftag curtagstart
4187 global nextupdate diffinhdr treediffs
4188
4189 set env(GIT_DIFF_OPTS) $diffopts
4190 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4191 if {[catch {set bdf [open $cmd r]} err]} {
4192 puts "error getting diffs: $err"
4193 return
4194 }
4195 set diffinhdr 0
4196 fconfigure $bdf -blocking 0
4197 set blobdifffd($ids) $bdf
4198 set curdifftag Comments
4199 set curtagstart 0.0
4200 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4201 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4202}
4203
4204proc setinlist {var i val} {
4205 global $var
4206
4207 while {[llength [set $var]] < $i} {
4208 lappend $var {}
4209 }
4210 if {[llength [set $var]] == $i} {
4211 lappend $var $val
4212 } else {
4213 lset $var $i $val
4214 }
4215}
4216
4217proc getblobdiffline {bdf ids} {
4218 global diffids blobdifffd ctext curdifftag curtagstart
4219 global diffnexthead diffnextnote difffilestart
4220 global nextupdate diffinhdr treediffs
4221
4222 set n [gets $bdf line]
4223 if {$n < 0} {
4224 if {[eof $bdf]} {
4225 close $bdf
4226 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4227 $ctext tag add $curdifftag $curtagstart end
4228 }
4229 }
4230 return
4231 }
4232 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4233 return
4234 }
4235 $ctext conf -state normal
4236 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4237 # start of a new file
4238 $ctext insert end "\n"
4239 $ctext tag add $curdifftag $curtagstart end
4240 set here [$ctext index "end - 1c"]
4241 set curtagstart $here
4242 set header $newname
4243 set i [lsearch -exact $treediffs($ids) $fname]
4244 if {$i >= 0} {
4245 setinlist difffilestart $i $here
4246 }
4247 if {$newname ne $fname} {
4248 set i [lsearch -exact $treediffs($ids) $newname]
4249 if {$i >= 0} {
4250 setinlist difffilestart $i $here
4251 }
4252 }
4253 set curdifftag "f:$fname"
4254 $ctext tag delete $curdifftag
4255 set l [expr {(78 - [string length $header]) / 2}]
4256 set pad [string range "----------------------------------------" 1 $l]
4257 $ctext insert end "$pad $header $pad\n" filesep
4258 set diffinhdr 1
4259 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4260 # do nothing
4261 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4262 set diffinhdr 0
4263 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4264 $line match f1l f1c f2l f2c rest]} {
4265 $ctext insert end "$line\n" hunksep
4266 set diffinhdr 0
4267 } else {
4268 set x [string range $line 0 0]
4269 if {$x == "-" || $x == "+"} {
4270 set tag [expr {$x == "+"}]
4271 $ctext insert end "$line\n" d$tag
4272 } elseif {$x == " "} {
4273 $ctext insert end "$line\n"
4274 } elseif {$diffinhdr || $x == "\\"} {
4275 # e.g. "\ No newline at end of file"
4276 $ctext insert end "$line\n" filesep
4277 } else {
4278 # Something else we don't recognize
4279 if {$curdifftag != "Comments"} {
4280 $ctext insert end "\n"
4281 $ctext tag add $curdifftag $curtagstart end
4282 set curtagstart [$ctext index "end - 1c"]
4283 set curdifftag Comments
4284 }
4285 $ctext insert end "$line\n" filesep
4286 }
4287 }
4288 $ctext conf -state disabled
4289 if {[clock clicks -milliseconds] >= $nextupdate} {
4290 incr nextupdate 100
4291 fileevent $bdf readable {}
4292 update
4293 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4294 }
4295}
4296
4297proc nextfile {} {
4298 global difffilestart ctext
4299 set here [$ctext index @0,0]
4300 foreach loc $difffilestart {
4301 if {[$ctext compare $loc > $here]} {
4302 $ctext yview $loc
4303 }
4304 }
4305}
4306
4307proc clear_ctext {{first 1.0}} {
4308 global ctext smarktop smarkbot
4309
4310 set l [lindex [split $first .] 0]
4311 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4312 set smarktop $l
4313 }
4314 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4315 set smarkbot $l
4316 }
4317 $ctext delete $first end
4318}
4319
4320proc incrsearch {name ix op} {
4321 global ctext searchstring searchdirn
4322
4323 $ctext tag remove found 1.0 end
4324 if {[catch {$ctext index anchor}]} {
4325 # no anchor set, use start of selection, or of visible area
4326 set sel [$ctext tag ranges sel]
4327 if {$sel ne {}} {
4328 $ctext mark set anchor [lindex $sel 0]
4329 } elseif {$searchdirn eq "-forwards"} {
4330 $ctext mark set anchor @0,0
4331 } else {
4332 $ctext mark set anchor @0,[winfo height $ctext]
4333 }
4334 }
4335 if {$searchstring ne {}} {
4336 set here [$ctext search $searchdirn -- $searchstring anchor]
4337 if {$here ne {}} {
4338 $ctext see $here
4339 }
4340 searchmarkvisible 1
4341 }
4342}
4343
4344proc dosearch {} {
4345 global sstring ctext searchstring searchdirn
4346
4347 focus $sstring
4348 $sstring icursor end
4349 set searchdirn -forwards
4350 if {$searchstring ne {}} {
4351 set sel [$ctext tag ranges sel]
4352 if {$sel ne {}} {
4353 set start "[lindex $sel 0] + 1c"
4354 } elseif {[catch {set start [$ctext index anchor]}]} {
4355 set start "@0,0"
4356 }
4357 set match [$ctext search -count mlen -- $searchstring $start]
4358 $ctext tag remove sel 1.0 end
4359 if {$match eq {}} {
4360 bell
4361 return
4362 }
4363 $ctext see $match
4364 set mend "$match + $mlen c"
4365 $ctext tag add sel $match $mend
4366 $ctext mark unset anchor
4367 }
4368}
4369
4370proc dosearchback {} {
4371 global sstring ctext searchstring searchdirn
4372
4373 focus $sstring
4374 $sstring icursor end
4375 set searchdirn -backwards
4376 if {$searchstring ne {}} {
4377 set sel [$ctext tag ranges sel]
4378 if {$sel ne {}} {
4379 set start [lindex $sel 0]
4380 } elseif {[catch {set start [$ctext index anchor]}]} {
4381 set start @0,[winfo height $ctext]
4382 }
4383 set match [$ctext search -backwards -count ml -- $searchstring $start]
4384 $ctext tag remove sel 1.0 end
4385 if {$match eq {}} {
4386 bell
4387 return
4388 }
4389 $ctext see $match
4390 set mend "$match + $ml c"
4391 $ctext tag add sel $match $mend
4392 $ctext mark unset anchor
4393 }
4394}
4395
4396proc searchmark {first last} {
4397 global ctext searchstring
4398
4399 set mend $first.0
4400 while {1} {
4401 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4402 if {$match eq {}} break
4403 set mend "$match + $mlen c"
4404 $ctext tag add found $match $mend
4405 }
4406}
4407
4408proc searchmarkvisible {doall} {
4409 global ctext smarktop smarkbot
4410
4411 set topline [lindex [split [$ctext index @0,0] .] 0]
4412 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4413 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4414 # no overlap with previous
4415 searchmark $topline $botline
4416 set smarktop $topline
4417 set smarkbot $botline
4418 } else {
4419 if {$topline < $smarktop} {
4420 searchmark $topline [expr {$smarktop-1}]
4421 set smarktop $topline
4422 }
4423 if {$botline > $smarkbot} {
4424 searchmark [expr {$smarkbot+1}] $botline
4425 set smarkbot $botline
4426 }
4427 }
4428}
4429
4430proc scrolltext {f0 f1} {
4431 global searchstring
4432
4433 .ctop.cdet.left.sb set $f0 $f1
4434 if {$searchstring ne {}} {
4435 searchmarkvisible 0
4436 }
4437}
4438
4439proc setcoords {} {
4440 global linespc charspc canvx0 canvy0 mainfont
4441 global xspc1 xspc2 lthickness
4442
4443 set linespc [font metrics $mainfont -linespace]
4444 set charspc [font measure $mainfont "m"]
4445 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4446 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4447 set lthickness [expr {int($linespc / 9) + 1}]
4448 set xspc1(0) $linespc
4449 set xspc2 $linespc
4450}
4451
4452proc redisplay {} {
4453 global canv
4454 global selectedline
4455
4456 set ymax [lindex [$canv cget -scrollregion] 3]
4457 if {$ymax eq {} || $ymax == 0} return
4458 set span [$canv yview]
4459 clear_display
4460 setcanvscroll
4461 allcanvs yview moveto [lindex $span 0]
4462 drawvisible
4463 if {[info exists selectedline]} {
4464 selectline $selectedline 0
4465 }
4466}
4467
4468proc incrfont {inc} {
4469 global mainfont textfont ctext canv phase
4470 global stopped entries
4471 unmarkmatches
4472 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4473 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4474 setcoords
4475 $ctext conf -font $textfont
4476 $ctext tag conf filesep -font [concat $textfont bold]
4477 foreach e $entries {
4478 $e conf -font $mainfont
4479 }
4480 if {$phase eq "getcommits"} {
4481 $canv itemconf textitems -font $mainfont
4482 }
4483 redisplay
4484}
4485
4486proc clearsha1 {} {
4487 global sha1entry sha1string
4488 if {[string length $sha1string] == 40} {
4489 $sha1entry delete 0 end
4490 }
4491}
4492
4493proc sha1change {n1 n2 op} {
4494 global sha1string currentid sha1but
4495 if {$sha1string == {}
4496 || ([info exists currentid] && $sha1string == $currentid)} {
4497 set state disabled
4498 } else {
4499 set state normal
4500 }
4501 if {[$sha1but cget -state] == $state} return
4502 if {$state == "normal"} {
4503 $sha1but conf -state normal -relief raised -text "Goto: "
4504 } else {
4505 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4506 }
4507}
4508
4509proc gotocommit {} {
4510 global sha1string currentid commitrow tagids headids
4511 global displayorder numcommits curview
4512
4513 if {$sha1string == {}
4514 || ([info exists currentid] && $sha1string == $currentid)} return
4515 if {[info exists tagids($sha1string)]} {
4516 set id $tagids($sha1string)
4517 } elseif {[info exists headids($sha1string)]} {
4518 set id $headids($sha1string)
4519 } else {
4520 set id [string tolower $sha1string]
4521 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4522 set matches {}
4523 foreach i $displayorder {
4524 if {[string match $id* $i]} {
4525 lappend matches $i
4526 }
4527 }
4528 if {$matches ne {}} {
4529 if {[llength $matches] > 1} {
4530 error_popup "Short SHA1 id $id is ambiguous"
4531 return
4532 }
4533 set id [lindex $matches 0]
4534 }
4535 }
4536 }
4537 if {[info exists commitrow($curview,$id)]} {
4538 selectline $commitrow($curview,$id) 1
4539 return
4540 }
4541 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4542 set type "SHA1 id"
4543 } else {
4544 set type "Tag/Head"
4545 }
4546 error_popup "$type $sha1string is not known"
4547}
4548
4549proc lineenter {x y id} {
4550 global hoverx hovery hoverid hovertimer
4551 global commitinfo canv
4552
4553 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4554 set hoverx $x
4555 set hovery $y
4556 set hoverid $id
4557 if {[info exists hovertimer]} {
4558 after cancel $hovertimer
4559 }
4560 set hovertimer [after 500 linehover]
4561 $canv delete hover
4562}
4563
4564proc linemotion {x y id} {
4565 global hoverx hovery hoverid hovertimer
4566
4567 if {[info exists hoverid] && $id == $hoverid} {
4568 set hoverx $x
4569 set hovery $y
4570 if {[info exists hovertimer]} {
4571 after cancel $hovertimer
4572 }
4573 set hovertimer [after 500 linehover]
4574 }
4575}
4576
4577proc lineleave {id} {
4578 global hoverid hovertimer canv
4579
4580 if {[info exists hoverid] && $id == $hoverid} {
4581 $canv delete hover
4582 if {[info exists hovertimer]} {
4583 after cancel $hovertimer
4584 unset hovertimer
4585 }
4586 unset hoverid
4587 }
4588}
4589
4590proc linehover {} {
4591 global hoverx hovery hoverid hovertimer
4592 global canv linespc lthickness
4593 global commitinfo mainfont
4594
4595 set text [lindex $commitinfo($hoverid) 0]
4596 set ymax [lindex [$canv cget -scrollregion] 3]
4597 if {$ymax == {}} return
4598 set yfrac [lindex [$canv yview] 0]
4599 set x [expr {$hoverx + 2 * $linespc}]
4600 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4601 set x0 [expr {$x - 2 * $lthickness}]
4602 set y0 [expr {$y - 2 * $lthickness}]
4603 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4604 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4605 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4606 -fill \#ffff80 -outline black -width 1 -tags hover]
4607 $canv raise $t
4608 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4609 -font $mainfont]
4610 $canv raise $t
4611}
4612
4613proc clickisonarrow {id y} {
4614 global lthickness
4615
4616 set ranges [rowranges $id]
4617 set thresh [expr {2 * $lthickness + 6}]
4618 set n [expr {[llength $ranges] - 1}]
4619 for {set i 1} {$i < $n} {incr i} {
4620 set row [lindex $ranges $i]
4621 if {abs([yc $row] - $y) < $thresh} {
4622 return $i
4623 }
4624 }
4625 return {}
4626}
4627
4628proc arrowjump {id n y} {
4629 global canv
4630
4631 # 1 <-> 2, 3 <-> 4, etc...
4632 set n [expr {(($n - 1) ^ 1) + 1}]
4633 set row [lindex [rowranges $id] $n]
4634 set yt [yc $row]
4635 set ymax [lindex [$canv cget -scrollregion] 3]
4636 if {$ymax eq {} || $ymax <= 0} return
4637 set view [$canv yview]
4638 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4639 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4640 if {$yfrac < 0} {
4641 set yfrac 0
4642 }
4643 allcanvs yview moveto $yfrac
4644}
4645
4646proc lineclick {x y id isnew} {
4647 global ctext commitinfo children canv thickerline curview
4648
4649 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4650 unmarkmatches
4651 unselectline
4652 normalline
4653 $canv delete hover
4654 # draw this line thicker than normal
4655 set thickerline $id
4656 drawlines $id
4657 if {$isnew} {
4658 set ymax [lindex [$canv cget -scrollregion] 3]
4659 if {$ymax eq {}} return
4660 set yfrac [lindex [$canv yview] 0]
4661 set y [expr {$y + $yfrac * $ymax}]
4662 }
4663 set dirn [clickisonarrow $id $y]
4664 if {$dirn ne {}} {
4665 arrowjump $id $dirn $y
4666 return
4667 }
4668
4669 if {$isnew} {
4670 addtohistory [list lineclick $x $y $id 0]
4671 }
4672 # fill the details pane with info about this line
4673 $ctext conf -state normal
4674 clear_ctext
4675 $ctext tag conf link -foreground blue -underline 1
4676 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4677 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4678 $ctext insert end "Parent:\t"
4679 $ctext insert end $id [list link link0]
4680 $ctext tag bind link0 <1> [list selbyid $id]
4681 set info $commitinfo($id)
4682 $ctext insert end "\n\t[lindex $info 0]\n"
4683 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4684 set date [formatdate [lindex $info 2]]
4685 $ctext insert end "\tDate:\t$date\n"
4686 set kids $children($curview,$id)
4687 if {$kids ne {}} {
4688 $ctext insert end "\nChildren:"
4689 set i 0
4690 foreach child $kids {
4691 incr i
4692 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4693 set info $commitinfo($child)
4694 $ctext insert end "\n\t"
4695 $ctext insert end $child [list link link$i]
4696 $ctext tag bind link$i <1> [list selbyid $child]
4697 $ctext insert end "\n\t[lindex $info 0]"
4698 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4699 set date [formatdate [lindex $info 2]]
4700 $ctext insert end "\n\tDate:\t$date\n"
4701 }
4702 }
4703 $ctext conf -state disabled
4704 init_flist {}
4705}
4706
4707proc normalline {} {
4708 global thickerline
4709 if {[info exists thickerline]} {
4710 set id $thickerline
4711 unset thickerline
4712 drawlines $id
4713 }
4714}
4715
4716proc selbyid {id} {
4717 global commitrow curview
4718 if {[info exists commitrow($curview,$id)]} {
4719 selectline $commitrow($curview,$id) 1
4720 }
4721}
4722
4723proc mstime {} {
4724 global startmstime
4725 if {![info exists startmstime]} {
4726 set startmstime [clock clicks -milliseconds]
4727 }
4728 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4729}
4730
4731proc rowmenu {x y id} {
4732 global rowctxmenu commitrow selectedline rowmenuid curview
4733
4734 if {![info exists selectedline]
4735 || $commitrow($curview,$id) eq $selectedline} {
4736 set state disabled
4737 } else {
4738 set state normal
4739 }
4740 $rowctxmenu entryconfigure 0 -state $state
4741 $rowctxmenu entryconfigure 1 -state $state
4742 $rowctxmenu entryconfigure 2 -state $state
4743 set rowmenuid $id
4744 tk_popup $rowctxmenu $x $y
4745}
4746
4747proc diffvssel {dirn} {
4748 global rowmenuid selectedline displayorder
4749
4750 if {![info exists selectedline]} return
4751 if {$dirn} {
4752 set oldid [lindex $displayorder $selectedline]
4753 set newid $rowmenuid
4754 } else {
4755 set oldid $rowmenuid
4756 set newid [lindex $displayorder $selectedline]
4757 }
4758 addtohistory [list doseldiff $oldid $newid]
4759 doseldiff $oldid $newid
4760}
4761
4762proc doseldiff {oldid newid} {
4763 global ctext
4764 global commitinfo
4765
4766 $ctext conf -state normal
4767 clear_ctext
4768 init_flist "Top"
4769 $ctext insert end "From "
4770 $ctext tag conf link -foreground blue -underline 1
4771 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4772 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4773 $ctext tag bind link0 <1> [list selbyid $oldid]
4774 $ctext insert end $oldid [list link link0]
4775 $ctext insert end "\n "
4776 $ctext insert end [lindex $commitinfo($oldid) 0]
4777 $ctext insert end "\n\nTo "
4778 $ctext tag bind link1 <1> [list selbyid $newid]
4779 $ctext insert end $newid [list link link1]
4780 $ctext insert end "\n "
4781 $ctext insert end [lindex $commitinfo($newid) 0]
4782 $ctext insert end "\n"
4783 $ctext conf -state disabled
4784 $ctext tag delete Comments
4785 $ctext tag remove found 1.0 end
4786 startdiff [list $oldid $newid]
4787}
4788
4789proc mkpatch {} {
4790 global rowmenuid currentid commitinfo patchtop patchnum
4791
4792 if {![info exists currentid]} return
4793 set oldid $currentid
4794 set oldhead [lindex $commitinfo($oldid) 0]
4795 set newid $rowmenuid
4796 set newhead [lindex $commitinfo($newid) 0]
4797 set top .patch
4798 set patchtop $top
4799 catch {destroy $top}
4800 toplevel $top
4801 label $top.title -text "Generate patch"
4802 grid $top.title - -pady 10
4803 label $top.from -text "From:"
4804 entry $top.fromsha1 -width 40 -relief flat
4805 $top.fromsha1 insert 0 $oldid
4806 $top.fromsha1 conf -state readonly
4807 grid $top.from $top.fromsha1 -sticky w
4808 entry $top.fromhead -width 60 -relief flat
4809 $top.fromhead insert 0 $oldhead
4810 $top.fromhead conf -state readonly
4811 grid x $top.fromhead -sticky w
4812 label $top.to -text "To:"
4813 entry $top.tosha1 -width 40 -relief flat
4814 $top.tosha1 insert 0 $newid
4815 $top.tosha1 conf -state readonly
4816 grid $top.to $top.tosha1 -sticky w
4817 entry $top.tohead -width 60 -relief flat
4818 $top.tohead insert 0 $newhead
4819 $top.tohead conf -state readonly
4820 grid x $top.tohead -sticky w
4821 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4822 grid $top.rev x -pady 10
4823 label $top.flab -text "Output file:"
4824 entry $top.fname -width 60
4825 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4826 incr patchnum
4827 grid $top.flab $top.fname -sticky w
4828 frame $top.buts
4829 button $top.buts.gen -text "Generate" -command mkpatchgo
4830 button $top.buts.can -text "Cancel" -command mkpatchcan
4831 grid $top.buts.gen $top.buts.can
4832 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4833 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4834 grid $top.buts - -pady 10 -sticky ew
4835 focus $top.fname
4836}
4837
4838proc mkpatchrev {} {
4839 global patchtop
4840
4841 set oldid [$patchtop.fromsha1 get]
4842 set oldhead [$patchtop.fromhead get]
4843 set newid [$patchtop.tosha1 get]
4844 set newhead [$patchtop.tohead get]
4845 foreach e [list fromsha1 fromhead tosha1 tohead] \
4846 v [list $newid $newhead $oldid $oldhead] {
4847 $patchtop.$e conf -state normal
4848 $patchtop.$e delete 0 end
4849 $patchtop.$e insert 0 $v
4850 $patchtop.$e conf -state readonly
4851 }
4852}
4853
4854proc mkpatchgo {} {
4855 global patchtop
4856
4857 set oldid [$patchtop.fromsha1 get]
4858 set newid [$patchtop.tosha1 get]
4859 set fname [$patchtop.fname get]
4860 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4861 error_popup "Error creating patch: $err"
4862 }
4863 catch {destroy $patchtop}
4864 unset patchtop
4865}
4866
4867proc mkpatchcan {} {
4868 global patchtop
4869
4870 catch {destroy $patchtop}
4871 unset patchtop
4872}
4873
4874proc mktag {} {
4875 global rowmenuid mktagtop commitinfo
4876
4877 set top .maketag
4878 set mktagtop $top
4879 catch {destroy $top}
4880 toplevel $top
4881 label $top.title -text "Create tag"
4882 grid $top.title - -pady 10
4883 label $top.id -text "ID:"
4884 entry $top.sha1 -width 40 -relief flat
4885 $top.sha1 insert 0 $rowmenuid
4886 $top.sha1 conf -state readonly
4887 grid $top.id $top.sha1 -sticky w
4888 entry $top.head -width 60 -relief flat
4889 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4890 $top.head conf -state readonly
4891 grid x $top.head -sticky w
4892 label $top.tlab -text "Tag name:"
4893 entry $top.tag -width 60
4894 grid $top.tlab $top.tag -sticky w
4895 frame $top.buts
4896 button $top.buts.gen -text "Create" -command mktaggo
4897 button $top.buts.can -text "Cancel" -command mktagcan
4898 grid $top.buts.gen $top.buts.can
4899 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4900 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4901 grid $top.buts - -pady 10 -sticky ew
4902 focus $top.tag
4903}
4904
4905proc domktag {} {
4906 global mktagtop env tagids idtags
4907
4908 set id [$mktagtop.sha1 get]
4909 set tag [$mktagtop.tag get]
4910 if {$tag == {}} {
4911 error_popup "No tag name specified"
4912 return
4913 }
4914 if {[info exists tagids($tag)]} {
4915 error_popup "Tag \"$tag\" already exists"
4916 return
4917 }
4918 if {[catch {
4919 set dir [gitdir]
4920 set fname [file join $dir "refs/tags" $tag]
4921 set f [open $fname w]
4922 puts $f $id
4923 close $f
4924 } err]} {
4925 error_popup "Error creating tag: $err"
4926 return
4927 }
4928
4929 set tagids($tag) $id
4930 lappend idtags($id) $tag
4931 redrawtags $id
4932}
4933
4934proc redrawtags {id} {
4935 global canv linehtag commitrow idpos selectedline curview
4936 global mainfont canvxmax
4937
4938 if {![info exists commitrow($curview,$id)]} return
4939 drawcmitrow $commitrow($curview,$id)
4940 $canv delete tag.$id
4941 set xt [eval drawtags $id $idpos($id)]
4942 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4943 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4944 set xr [expr {$xt + [font measure $mainfont $text]}]
4945 if {$xr > $canvxmax} {
4946 set canvxmax $xr
4947 setcanvscroll
4948 }
4949 if {[info exists selectedline]
4950 && $selectedline == $commitrow($curview,$id)} {
4951 selectline $selectedline 0
4952 }
4953}
4954
4955proc mktagcan {} {
4956 global mktagtop
4957
4958 catch {destroy $mktagtop}
4959 unset mktagtop
4960}
4961
4962proc mktaggo {} {
4963 domktag
4964 mktagcan
4965}
4966
4967proc writecommit {} {
4968 global rowmenuid wrcomtop commitinfo wrcomcmd
4969
4970 set top .writecommit
4971 set wrcomtop $top
4972 catch {destroy $top}
4973 toplevel $top
4974 label $top.title -text "Write commit to file"
4975 grid $top.title - -pady 10
4976 label $top.id -text "ID:"
4977 entry $top.sha1 -width 40 -relief flat
4978 $top.sha1 insert 0 $rowmenuid
4979 $top.sha1 conf -state readonly
4980 grid $top.id $top.sha1 -sticky w
4981 entry $top.head -width 60 -relief flat
4982 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4983 $top.head conf -state readonly
4984 grid x $top.head -sticky w
4985 label $top.clab -text "Command:"
4986 entry $top.cmd -width 60 -textvariable wrcomcmd
4987 grid $top.clab $top.cmd -sticky w -pady 10
4988 label $top.flab -text "Output file:"
4989 entry $top.fname -width 60
4990 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4991 grid $top.flab $top.fname -sticky w
4992 frame $top.buts
4993 button $top.buts.gen -text "Write" -command wrcomgo
4994 button $top.buts.can -text "Cancel" -command wrcomcan
4995 grid $top.buts.gen $top.buts.can
4996 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4997 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4998 grid $top.buts - -pady 10 -sticky ew
4999 focus $top.fname
5000}
5001
5002proc wrcomgo {} {
5003 global wrcomtop
5004
5005 set id [$wrcomtop.sha1 get]
5006 set cmd "echo $id | [$wrcomtop.cmd get]"
5007 set fname [$wrcomtop.fname get]
5008 if {[catch {exec sh -c $cmd >$fname &} err]} {
5009 error_popup "Error writing commit: $err"
5010 }
5011 catch {destroy $wrcomtop}
5012 unset wrcomtop
5013}
5014
5015proc wrcomcan {} {
5016 global wrcomtop
5017
5018 catch {destroy $wrcomtop}
5019 unset wrcomtop
5020}
5021
5022proc mkbranch {} {
5023 global rowmenuid mkbrtop
5024
5025 set top .makebranch
5026 catch {destroy $top}
5027 toplevel $top
5028 label $top.title -text "Create new branch"
5029 grid $top.title - -pady 10
5030 label $top.id -text "ID:"
5031 entry $top.sha1 -width 40 -relief flat
5032 $top.sha1 insert 0 $rowmenuid
5033 $top.sha1 conf -state readonly
5034 grid $top.id $top.sha1 -sticky w
5035 label $top.nlab -text "Name:"
5036 entry $top.name -width 40
5037 grid $top.nlab $top.name -sticky w
5038 frame $top.buts
5039 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5040 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5041 grid $top.buts.go $top.buts.can
5042 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5043 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5044 grid $top.buts - -pady 10 -sticky ew
5045 focus $top.name
5046}
5047
5048proc mkbrgo {top} {
5049 global headids idheads
5050
5051 set name [$top.name get]
5052 set id [$top.sha1 get]
5053 if {$name eq {}} {
5054 error_popup "Please specify a name for the new branch"
5055 return
5056 }
5057 catch {destroy $top}
5058 nowbusy newbranch
5059 update
5060 if {[catch {
5061 exec git branch $name $id
5062 } err]} {
5063 notbusy newbranch
5064 error_popup $err
5065 } else {
5066 set headids($name) $id
5067 if {![info exists idheads($id)]} {
5068 addedhead $id
5069 }
5070 lappend idheads($id) $name
5071 # XXX should update list of heads displayed for selected commit
5072 notbusy newbranch
5073 redrawtags $id
5074 }
5075}
5076
5077# Stuff for finding nearby tags
5078proc getallcommits {} {
5079 global allcstart allcommits allcfd allids
5080
5081 set allids {}
5082 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5083 set allcfd $fd
5084 fconfigure $fd -blocking 0
5085 set allcommits "reading"
5086 nowbusy allcommits
5087 restartgetall $fd
5088}
5089
5090proc discardallcommits {} {
5091 global allparents allchildren allcommits allcfd
5092 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5093
5094 if {![info exists allcommits]} return
5095 if {$allcommits eq "reading"} {
5096 catch {close $allcfd}
5097 }
5098 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5099 alldtags tagisdesc desc_heads} {
5100 catch {unset $v}
5101 }
5102}
5103
5104proc restartgetall {fd} {
5105 global allcstart
5106
5107 fileevent $fd readable [list getallclines $fd]
5108 set allcstart [clock clicks -milliseconds]
5109}
5110
5111proc combine_dtags {l1 l2} {
5112 global tagisdesc notfirstd
5113
5114 set res [lsort -unique [concat $l1 $l2]]
5115 for {set i 0} {$i < [llength $res]} {incr i} {
5116 set x [lindex $res $i]
5117 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5118 set y [lindex $res $j]
5119 if {[info exists tagisdesc($x,$y)]} {
5120 if {$tagisdesc($x,$y) > 0} {
5121 # x is a descendent of y, exclude x
5122 set res [lreplace $res $i $i]
5123 incr i -1
5124 break
5125 } else {
5126 # y is a descendent of x, exclude y
5127 set res [lreplace $res $j $j]
5128 }
5129 } else {
5130 # no relation, keep going
5131 incr j
5132 }
5133 }
5134 }
5135 return $res
5136}
5137
5138proc combine_atags {l1 l2} {
5139 global tagisdesc
5140
5141 set res [lsort -unique [concat $l1 $l2]]
5142 for {set i 0} {$i < [llength $res]} {incr i} {
5143 set x [lindex $res $i]
5144 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5145 set y [lindex $res $j]
5146 if {[info exists tagisdesc($x,$y)]} {
5147 if {$tagisdesc($x,$y) < 0} {
5148 # x is an ancestor of y, exclude x
5149 set res [lreplace $res $i $i]
5150 incr i -1
5151 break
5152 } else {
5153 # y is an ancestor of x, exclude y
5154 set res [lreplace $res $j $j]
5155 }
5156 } else {
5157 # no relation, keep going
5158 incr j
5159 }
5160 }
5161 }
5162 return $res
5163}
5164
5165proc forward_pass {id children} {
5166 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5167
5168 set dtags {}
5169 set dheads {}
5170 foreach child $children {
5171 if {[info exists idtags($child)]} {
5172 set ctags [list $child]
5173 } else {
5174 set ctags $desc_tags($child)
5175 }
5176 if {$dtags eq {}} {
5177 set dtags $ctags
5178 } elseif {$ctags ne $dtags} {
5179 set dtags [combine_dtags $dtags $ctags]
5180 }
5181 set cheads $desc_heads($child)
5182 if {$dheads eq {}} {
5183 set dheads $cheads
5184 } elseif {$cheads ne $dheads} {
5185 set dheads [lsort -unique [concat $dheads $cheads]]
5186 }
5187 }
5188 set desc_tags($id) $dtags
5189 if {[info exists idtags($id)]} {
5190 set adt $dtags
5191 foreach tag $dtags {
5192 set adt [concat $adt $alldtags($tag)]
5193 }
5194 set adt [lsort -unique $adt]
5195 set alldtags($id) $adt
5196 foreach tag $adt {
5197 set tagisdesc($id,$tag) -1
5198 set tagisdesc($tag,$id) 1
5199 }
5200 }
5201 if {[info exists idheads($id)]} {
5202 lappend dheads $id
5203 }
5204 set desc_heads($id) $dheads
5205}
5206
5207proc getallclines {fd} {
5208 global allparents allchildren allcommits allcstart
5209 global desc_tags anc_tags idtags tagisdesc allids
5210 global desc_heads idheads travindex
5211
5212 while {[gets $fd line] >= 0} {
5213 set id [lindex $line 0]
5214 lappend allids $id
5215 set olds [lrange $line 1 end]
5216 set allparents($id) $olds
5217 if {![info exists allchildren($id)]} {
5218 set allchildren($id) {}
5219 }
5220 foreach p $olds {
5221 lappend allchildren($p) $id
5222 }
5223 # compute nearest tagged descendents as we go
5224 # also compute descendent heads
5225 forward_pass $id $allchildren($id)
5226 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5227 fileevent $fd readable {}
5228 after idle restartgetall $fd
5229 return
5230 }
5231 }
5232 if {[eof $fd]} {
5233 set travindex [llength $allids]
5234 set allcommits "traversing"
5235 after idle restartatags
5236 if {[catch {close $fd} err]} {
5237 error_popup "Error reading full commit graph: $err.\n\
5238 Results may be incomplete."
5239 }
5240 }
5241}
5242
5243# walk backward through the tree and compute nearest tagged ancestors
5244proc restartatags {} {
5245 global allids allparents idtags anc_tags travindex
5246
5247 set t0 [clock clicks -milliseconds]
5248 set i $travindex
5249 while {[incr i -1] >= 0} {
5250 set id [lindex $allids $i]
5251 set atags {}
5252 foreach p $allparents($id) {
5253 if {[info exists idtags($p)]} {
5254 set ptags [list $p]
5255 } else {
5256 set ptags $anc_tags($p)
5257 }
5258 if {$atags eq {}} {
5259 set atags $ptags
5260 } elseif {$ptags ne $atags} {
5261 set atags [combine_atags $atags $ptags]
5262 }
5263 }
5264 set anc_tags($id) $atags
5265 if {[clock clicks -milliseconds] - $t0 >= 50} {
5266 set travindex $i
5267 after idle restartatags
5268 return
5269 }
5270 }
5271 set allcommits "done"
5272 set travindex 0
5273 notbusy allcommits
5274 dispneartags
5275}
5276
5277# update the desc_heads array for a new head just added
5278proc addedhead {hid} {
5279 global desc_heads allparents
5280
5281 set todo [list $hid]
5282 while {$todo ne {}} {
5283 set do [lindex $todo 0]
5284 set todo [lrange $todo 1 end]
5285 if {![info exists desc_heads($do)] ||
5286 [lsearch -exact $desc_heads($do) $hid] >= 0} continue
5287 set oldheads $desc_heads($do)
5288 lappend desc_heads($do) $hid
5289 set heads $desc_heads($do)
5290 while {1} {
5291 set p $allparents($do)
5292 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5293 $desc_heads($p) ne $oldheads} break
5294 set do $p
5295 set desc_heads($do) $heads
5296 }
5297 set todo [concat $todo $p]
5298 }
5299}
5300
5301proc changedrefs {} {
5302 global desc_heads desc_tags anc_tags allcommits allids
5303 global allchildren allparents idtags travindex
5304
5305 if {![info exists allcommits]} return
5306 catch {unset desc_heads}
5307 catch {unset desc_tags}
5308 catch {unset anc_tags}
5309 catch {unset alldtags}
5310 catch {unset tagisdesc}
5311 foreach id $allids {
5312 forward_pass $id $allchildren($id)
5313 }
5314 if {$allcommits ne "reading"} {
5315 set travindex [llength $allids]
5316 if {$allcommits ne "traversing"} {
5317 set allcommits "traversing"
5318 after idle restartatags
5319 }
5320 }
5321}
5322
5323proc rereadrefs {} {
5324 global idtags idheads idotherrefs mainhead
5325
5326 set refids [concat [array names idtags] \
5327 [array names idheads] [array names idotherrefs]]
5328 foreach id $refids {
5329 if {![info exists ref($id)]} {
5330 set ref($id) [listrefs $id]
5331 }
5332 }
5333 set oldmainhead $mainhead
5334 readrefs
5335 changedrefs
5336 set refids [lsort -unique [concat $refids [array names idtags] \
5337 [array names idheads] [array names idotherrefs]]]
5338 foreach id $refids {
5339 set v [listrefs $id]
5340 if {![info exists ref($id)] || $ref($id) != $v ||
5341 ($id eq $oldmainhead && $id ne $mainhead) ||
5342 ($id eq $mainhead && $id ne $oldmainhead)} {
5343 redrawtags $id
5344 }
5345 }
5346}
5347
5348proc listrefs {id} {
5349 global idtags idheads idotherrefs
5350
5351 set x {}
5352 if {[info exists idtags($id)]} {
5353 set x $idtags($id)
5354 }
5355 set y {}
5356 if {[info exists idheads($id)]} {
5357 set y $idheads($id)
5358 }
5359 set z {}
5360 if {[info exists idotherrefs($id)]} {
5361 set z $idotherrefs($id)
5362 }
5363 return [list $x $y $z]
5364}
5365
5366proc showtag {tag isnew} {
5367 global ctext tagcontents tagids linknum
5368
5369 if {$isnew} {
5370 addtohistory [list showtag $tag 0]
5371 }
5372 $ctext conf -state normal
5373 clear_ctext
5374 set linknum 0
5375 if {[info exists tagcontents($tag)]} {
5376 set text $tagcontents($tag)
5377 } else {
5378 set text "Tag: $tag\nId: $tagids($tag)"
5379 }
5380 appendwithlinks $text {}
5381 $ctext conf -state disabled
5382 init_flist {}
5383}
5384
5385proc doquit {} {
5386 global stopped
5387 set stopped 100
5388 destroy .
5389}
5390
5391proc doprefs {} {
5392 global maxwidth maxgraphpct diffopts
5393 global oldprefs prefstop showneartags
5394 global bgcolor fgcolor ctext diffcolors
5395
5396 set top .gitkprefs
5397 set prefstop $top
5398 if {[winfo exists $top]} {
5399 raise $top
5400 return
5401 }
5402 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5403 set oldprefs($v) [set $v]
5404 }
5405 toplevel $top
5406 wm title $top "Gitk preferences"
5407 label $top.ldisp -text "Commit list display options"
5408 grid $top.ldisp - -sticky w -pady 10
5409 label $top.spacer -text " "
5410 label $top.maxwidthl -text "Maximum graph width (lines)" \
5411 -font optionfont
5412 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5413 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5414 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5415 -font optionfont
5416 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5417 grid x $top.maxpctl $top.maxpct -sticky w
5418
5419 label $top.ddisp -text "Diff display options"
5420 grid $top.ddisp - -sticky w -pady 10
5421 label $top.diffoptl -text "Options for diff program" \
5422 -font optionfont
5423 entry $top.diffopt -width 20 -textvariable diffopts
5424 grid x $top.diffoptl $top.diffopt -sticky w
5425 frame $top.ntag
5426 label $top.ntag.l -text "Display nearby tags" -font optionfont
5427 checkbutton $top.ntag.b -variable showneartags
5428 pack $top.ntag.b $top.ntag.l -side left
5429 grid x $top.ntag -sticky w
5430
5431 label $top.cdisp -text "Colors: press to choose"
5432 grid $top.cdisp - -sticky w -pady 10
5433 label $top.bg -padx 40 -relief sunk -background $bgcolor
5434 button $top.bgbut -text "Background" -font optionfont \
5435 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5436 grid x $top.bgbut $top.bg -sticky w
5437 label $top.fg -padx 40 -relief sunk -background $fgcolor
5438 button $top.fgbut -text "Foreground" -font optionfont \
5439 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5440 grid x $top.fgbut $top.fg -sticky w
5441 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5442 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5443 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5444 [list $ctext tag conf d0 -foreground]]
5445 grid x $top.diffoldbut $top.diffold -sticky w
5446 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5447 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5448 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5449 [list $ctext tag conf d1 -foreground]]
5450 grid x $top.diffnewbut $top.diffnew -sticky w
5451 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5452 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5453 -command [list choosecolor diffcolors 2 $top.hunksep \
5454 "diff hunk header" \
5455 [list $ctext tag conf hunksep -foreground]]
5456 grid x $top.hunksepbut $top.hunksep -sticky w
5457
5458 frame $top.buts
5459 button $top.buts.ok -text "OK" -command prefsok
5460 button $top.buts.can -text "Cancel" -command prefscan
5461 grid $top.buts.ok $top.buts.can
5462 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5463 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5464 grid $top.buts - - -pady 10 -sticky ew
5465}
5466
5467proc choosecolor {v vi w x cmd} {
5468 global $v
5469
5470 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5471 -title "Gitk: choose color for $x"]
5472 if {$c eq {}} return
5473 $w conf -background $c
5474 lset $v $vi $c
5475 eval $cmd $c
5476}
5477
5478proc setbg {c} {
5479 global bglist
5480
5481 foreach w $bglist {
5482 $w conf -background $c
5483 }
5484}
5485
5486proc setfg {c} {
5487 global fglist canv
5488
5489 foreach w $fglist {
5490 $w conf -foreground $c
5491 }
5492 allcanvs itemconf text -fill $c
5493 $canv itemconf circle -outline $c
5494}
5495
5496proc prefscan {} {
5497 global maxwidth maxgraphpct diffopts
5498 global oldprefs prefstop showneartags
5499
5500 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5501 set $v $oldprefs($v)
5502 }
5503 catch {destroy $prefstop}
5504 unset prefstop
5505}
5506
5507proc prefsok {} {
5508 global maxwidth maxgraphpct
5509 global oldprefs prefstop showneartags
5510
5511 catch {destroy $prefstop}
5512 unset prefstop
5513 if {$maxwidth != $oldprefs(maxwidth)
5514 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5515 redisplay
5516 } elseif {$showneartags != $oldprefs(showneartags)} {
5517 reselectline
5518 }
5519}
5520
5521proc formatdate {d} {
5522 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5523}
5524
5525# This list of encoding names and aliases is distilled from
5526# http://www.iana.org/assignments/character-sets.
5527# Not all of them are supported by Tcl.
5528set encoding_aliases {
5529 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5530 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5531 { ISO-10646-UTF-1 csISO10646UTF1 }
5532 { ISO_646.basic:1983 ref csISO646basic1983 }
5533 { INVARIANT csINVARIANT }
5534 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5535 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5536 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5537 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5538 { NATS-DANO iso-ir-9-1 csNATSDANO }
5539 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5540 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5541 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5542 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5543 { ISO-2022-KR csISO2022KR }
5544 { EUC-KR csEUCKR }
5545 { ISO-2022-JP csISO2022JP }
5546 { ISO-2022-JP-2 csISO2022JP2 }
5547 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5548 csISO13JISC6220jp }
5549 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5550 { IT iso-ir-15 ISO646-IT csISO15Italian }
5551 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5552 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5553 { greek7-old iso-ir-18 csISO18Greek7Old }
5554 { latin-greek iso-ir-19 csISO19LatinGreek }
5555 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5556 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5557 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5558 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5559 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5560 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5561 { INIS iso-ir-49 csISO49INIS }
5562 { INIS-8 iso-ir-50 csISO50INIS8 }
5563 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5564 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5565 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5566 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5567 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5568 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5569 csISO60Norwegian1 }
5570 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5571 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5572 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5573 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5574 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5575 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5576 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5577 { greek7 iso-ir-88 csISO88Greek7 }
5578 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5579 { iso-ir-90 csISO90 }
5580 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5581 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5582 csISO92JISC62991984b }
5583 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5584 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5585 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5586 csISO95JIS62291984handadd }
5587 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5588 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5589 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5590 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5591 CP819 csISOLatin1 }
5592 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5593 { T.61-7bit iso-ir-102 csISO102T617bit }
5594 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5595 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5596 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5597 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5598 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5599 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5600 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5601 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5602 arabic csISOLatinArabic }
5603 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5604 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5605 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5606 greek greek8 csISOLatinGreek }
5607 { T.101-G2 iso-ir-128 csISO128T101G2 }
5608 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5609 csISOLatinHebrew }
5610 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5611 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5612 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5613 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5614 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5615 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5616 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5617 csISOLatinCyrillic }
5618 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5619 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5620 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5621 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5622 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5623 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5624 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5625 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5626 { ISO_10367-box iso-ir-155 csISO10367Box }
5627 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5628 { latin-lap lap iso-ir-158 csISO158Lap }
5629 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5630 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5631 { us-dk csUSDK }
5632 { dk-us csDKUS }
5633 { JIS_X0201 X0201 csHalfWidthKatakana }
5634 { KSC5636 ISO646-KR csKSC5636 }
5635 { ISO-10646-UCS-2 csUnicode }
5636 { ISO-10646-UCS-4 csUCS4 }
5637 { DEC-MCS dec csDECMCS }
5638 { hp-roman8 roman8 r8 csHPRoman8 }
5639 { macintosh mac csMacintosh }
5640 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5641 csIBM037 }
5642 { IBM038 EBCDIC-INT cp038 csIBM038 }
5643 { IBM273 CP273 csIBM273 }
5644 { IBM274 EBCDIC-BE CP274 csIBM274 }
5645 { IBM275 EBCDIC-BR cp275 csIBM275 }
5646 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5647 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5648 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5649 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5650 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5651 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5652 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5653 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5654 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5655 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5656 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5657 { IBM437 cp437 437 csPC8CodePage437 }
5658 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5659 { IBM775 cp775 csPC775Baltic }
5660 { IBM850 cp850 850 csPC850Multilingual }
5661 { IBM851 cp851 851 csIBM851 }
5662 { IBM852 cp852 852 csPCp852 }
5663 { IBM855 cp855 855 csIBM855 }
5664 { IBM857 cp857 857 csIBM857 }
5665 { IBM860 cp860 860 csIBM860 }
5666 { IBM861 cp861 861 cp-is csIBM861 }
5667 { IBM862 cp862 862 csPC862LatinHebrew }
5668 { IBM863 cp863 863 csIBM863 }
5669 { IBM864 cp864 csIBM864 }
5670 { IBM865 cp865 865 csIBM865 }
5671 { IBM866 cp866 866 csIBM866 }
5672 { IBM868 CP868 cp-ar csIBM868 }
5673 { IBM869 cp869 869 cp-gr csIBM869 }
5674 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5675 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5676 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5677 { IBM891 cp891 csIBM891 }
5678 { IBM903 cp903 csIBM903 }
5679 { IBM904 cp904 904 csIBBM904 }
5680 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5681 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5682 { IBM1026 CP1026 csIBM1026 }
5683 { EBCDIC-AT-DE csIBMEBCDICATDE }
5684 { EBCDIC-AT-DE-A csEBCDICATDEA }
5685 { EBCDIC-CA-FR csEBCDICCAFR }
5686 { EBCDIC-DK-NO csEBCDICDKNO }
5687 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5688 { EBCDIC-FI-SE csEBCDICFISE }
5689 { EBCDIC-FI-SE-A csEBCDICFISEA }
5690 { EBCDIC-FR csEBCDICFR }
5691 { EBCDIC-IT csEBCDICIT }
5692 { EBCDIC-PT csEBCDICPT }
5693 { EBCDIC-ES csEBCDICES }
5694 { EBCDIC-ES-A csEBCDICESA }
5695 { EBCDIC-ES-S csEBCDICESS }
5696 { EBCDIC-UK csEBCDICUK }
5697 { EBCDIC-US csEBCDICUS }
5698 { UNKNOWN-8BIT csUnknown8BiT }
5699 { MNEMONIC csMnemonic }
5700 { MNEM csMnem }
5701 { VISCII csVISCII }
5702 { VIQR csVIQR }
5703 { KOI8-R csKOI8R }
5704 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5705 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5706 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5707 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5708 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5709 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5710 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5711 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5712 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5713 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5714 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5715 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5716 { IBM1047 IBM-1047 }
5717 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5718 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5719 { UNICODE-1-1 csUnicode11 }
5720 { CESU-8 csCESU-8 }
5721 { BOCU-1 csBOCU-1 }
5722 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5723 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5724 l8 }
5725 { ISO-8859-15 ISO_8859-15 Latin-9 }
5726 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5727 { GBK CP936 MS936 windows-936 }
5728 { JIS_Encoding csJISEncoding }
5729 { Shift_JIS MS_Kanji csShiftJIS }
5730 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5731 EUC-JP }
5732 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5733 { ISO-10646-UCS-Basic csUnicodeASCII }
5734 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5735 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5736 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5737 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5738 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5739 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5740 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5741 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5742 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5743 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5744 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5745 { Ventura-US csVenturaUS }
5746 { Ventura-International csVenturaInternational }
5747 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5748 { PC8-Turkish csPC8Turkish }
5749 { IBM-Symbols csIBMSymbols }
5750 { IBM-Thai csIBMThai }
5751 { HP-Legal csHPLegal }
5752 { HP-Pi-font csHPPiFont }
5753 { HP-Math8 csHPMath8 }
5754 { Adobe-Symbol-Encoding csHPPSMath }
5755 { HP-DeskTop csHPDesktop }
5756 { Ventura-Math csVenturaMath }
5757 { Microsoft-Publishing csMicrosoftPublishing }
5758 { Windows-31J csWindows31J }
5759 { GB2312 csGB2312 }
5760 { Big5 csBig5 }
5761}
5762
5763proc tcl_encoding {enc} {
5764 global encoding_aliases
5765 set names [encoding names]
5766 set lcnames [string tolower $names]
5767 set enc [string tolower $enc]
5768 set i [lsearch -exact $lcnames $enc]
5769 if {$i < 0} {
5770 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5771 if {[regsub {^iso[-_]} $enc iso encx]} {
5772 set i [lsearch -exact $lcnames $encx]
5773 }
5774 }
5775 if {$i < 0} {
5776 foreach l $encoding_aliases {
5777 set ll [string tolower $l]
5778 if {[lsearch -exact $ll $enc] < 0} continue
5779 # look through the aliases for one that tcl knows about
5780 foreach e $ll {
5781 set i [lsearch -exact $lcnames $e]
5782 if {$i < 0} {
5783 if {[regsub {^iso[-_]} $e iso ex]} {
5784 set i [lsearch -exact $lcnames $ex]
5785 }
5786 }
5787 if {$i >= 0} break
5788 }
5789 break
5790 }
5791 }
5792 if {$i >= 0} {
5793 return [lindex $names $i]
5794 }
5795 return {}
5796}
5797
5798# defaults...
5799set datemode 0
5800set diffopts "-U 5 -p"
5801set wrcomcmd "git diff-tree --stdin -p --pretty"
5802
5803set gitencoding {}
5804catch {
5805 set gitencoding [exec git repo-config --get i18n.commitencoding]
5806}
5807if {$gitencoding == ""} {
5808 set gitencoding "utf-8"
5809}
5810set tclencoding [tcl_encoding $gitencoding]
5811if {$tclencoding == {}} {
5812 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5813}
5814
5815set mainfont {Helvetica 9}
5816set textfont {Courier 9}
5817set uifont {Helvetica 9 bold}
5818set findmergefiles 0
5819set maxgraphpct 50
5820set maxwidth 16
5821set revlistorder 0
5822set fastdate 0
5823set uparrowlen 7
5824set downarrowlen 7
5825set mingaplen 30
5826set cmitmode "patch"
5827set wrapcomment "none"
5828set showneartags 1
5829
5830set colors {green red blue magenta darkgrey brown orange}
5831set bgcolor white
5832set fgcolor black
5833set diffcolors {red "#00a000" blue}
5834
5835catch {source ~/.gitk}
5836
5837font create optionfont -family sans-serif -size -12
5838
5839set revtreeargs {}
5840foreach arg $argv {
5841 switch -regexp -- $arg {
5842 "^$" { }
5843 "^-d" { set datemode 1 }
5844 default {
5845 lappend revtreeargs $arg
5846 }
5847 }
5848}
5849
5850# check that we can find a .git directory somewhere...
5851set gitdir [gitdir]
5852if {![file isdirectory $gitdir]} {
5853 show_error {} . "Cannot find the git directory \"$gitdir\"."
5854 exit 1
5855}
5856
5857set cmdline_files {}
5858set i [lsearch -exact $revtreeargs "--"]
5859if {$i >= 0} {
5860 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5861 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5862} elseif {$revtreeargs ne {}} {
5863 if {[catch {
5864 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5865 set cmdline_files [split $f "\n"]
5866 set n [llength $cmdline_files]
5867 set revtreeargs [lrange $revtreeargs 0 end-$n]
5868 } err]} {
5869 # unfortunately we get both stdout and stderr in $err,
5870 # so look for "fatal:".
5871 set i [string first "fatal:" $err]
5872 if {$i > 0} {
5873 set err [string range $err [expr {$i + 6}] end]
5874 }
5875 show_error {} . "Bad arguments to gitk:\n$err"
5876 exit 1
5877 }
5878}
5879
5880set history {}
5881set historyindex 0
5882set fh_serial 0
5883set nhl_names {}
5884set highlight_paths {}
5885set searchdirn -forwards
5886set boldrows {}
5887set boldnamerows {}
5888
5889set optim_delay 16
5890
5891set nextviewnum 1
5892set curview 0
5893set selectedview 0
5894set selectedhlview None
5895set viewfiles(0) {}
5896set viewperm(0) 0
5897set viewargs(0) {}
5898
5899set cmdlineok 0
5900set stopped 0
5901set stuffsaved 0
5902set patchnum 0
5903setcoords
5904makewindow
5905readrefs
5906
5907if {$cmdline_files ne {} || $revtreeargs ne {}} {
5908 # create a view for the files/dirs specified on the command line
5909 set curview 1
5910 set selectedview 1
5911 set nextviewnum 2
5912 set viewname(1) "Command line"
5913 set viewfiles(1) $cmdline_files
5914 set viewargs(1) $revtreeargs
5915 set viewperm(1) 0
5916 addviewmenu 1
5917 .bar.view entryconf 2 -state normal
5918 .bar.view entryconf 3 -state normal
5919}
5920
5921if {[info exists permviews]} {
5922 foreach v $permviews {
5923 set n $nextviewnum
5924 incr nextviewnum
5925 set viewname($n) [lindex $v 0]
5926 set viewfiles($n) [lindex $v 1]
5927 set viewargs($n) [lindex $v 2]
5928 set viewperm($n) 1
5929 addviewmenu $n
5930 }
5931}
5932getcommits