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