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