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 None -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 5 [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 5 [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 Edit* -state [expr {$n == 0? "disabled": "normal"}]
1636 .bar.view entryconf Delete* -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# Insert 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 selectedline
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 commitlisted [linsert $commitlisted $row 1]
3338 set l [llength $displayorder]
3339 for {set r $row} {$r < $l} {incr r} {
3340 set id [lindex $displayorder $r]
3341 set commitrow($curview,$id) $r
3342 }
3343
3344 set idlist [lindex $rowidlist $row]
3345 set offs [lindex $rowoffsets $row]
3346 set newoffs {}
3347 foreach x $idlist {
3348 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3349 lappend newoffs {}
3350 } else {
3351 lappend newoffs 0
3352 }
3353 }
3354 if {[llength $kids] == 1} {
3355 set col [lsearch -exact $idlist $p]
3356 lset idlist $col $newcmit
3357 } else {
3358 set col [llength $idlist]
3359 lappend idlist $newcmit
3360 lappend offs {}
3361 lset rowoffsets $row $offs
3362 }
3363 set rowidlist [linsert $rowidlist $row $idlist]
3364 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3365
3366 set rowrangelist [linsert $rowrangelist $row {}]
3367 set l [llength $rowrangelist]
3368 for {set r 0} {$r < $l} {incr r} {
3369 set ranges [lindex $rowrangelist $r]
3370 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3371 set newranges {}
3372 foreach x $ranges {
3373 if {$x >= $row} {
3374 lappend newranges [expr {$x + 1}]
3375 } else {
3376 lappend newranges $x
3377 }
3378 }
3379 lset rowrangelist $r $newranges
3380 }
3381 }
3382 if {[llength $kids] > 1} {
3383 set rp1 [expr {$row + 1}]
3384 set ranges [lindex $rowrangelist $rp1]
3385 if {$ranges eq {}} {
3386 set ranges [list $row $rp1]
3387 } elseif {[lindex $ranges end-1] == $rp1} {
3388 lset ranges end-1 $row
3389 }
3390 lset rowrangelist $rp1 $ranges
3391 }
3392 foreach id [array names idrowranges] {
3393 set ranges $idrowranges($id)
3394 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3395 set newranges {}
3396 foreach x $ranges {
3397 if {$x >= $row} {
3398 lappend newranges [expr {$x + 1}]
3399 } else {
3400 lappend newranges $x
3401 }
3402 }
3403 set idrowranges($id) $newranges
3404 }
3405 }
3406
3407 set linesegends [linsert $linesegends $row {}]
3408
3409 incr rowlaidout
3410 incr rowoptim
3411 incr numcommits
3412
3413 if {[info exists selectedline] && $selectedline >= $row} {
3414 incr selectedline
3415 }
3416 redisplay
3417}
3418
3419# Don't change the text pane cursor if it is currently the hand cursor,
3420# showing that we are over a sha1 ID link.
3421proc settextcursor {c} {
3422 global ctext curtextcursor
3423
3424 if {[$ctext cget -cursor] == $curtextcursor} {
3425 $ctext config -cursor $c
3426 }
3427 set curtextcursor $c
3428}
3429
3430proc nowbusy {what} {
3431 global isbusy
3432
3433 if {[array names isbusy] eq {}} {
3434 . config -cursor watch
3435 settextcursor watch
3436 }
3437 set isbusy($what) 1
3438}
3439
3440proc notbusy {what} {
3441 global isbusy maincursor textcursor
3442
3443 catch {unset isbusy($what)}
3444 if {[array names isbusy] eq {}} {
3445 . config -cursor $maincursor
3446 settextcursor $textcursor
3447 }
3448}
3449
3450proc drawrest {} {
3451 global startmsecs
3452 global rowlaidout commitidx curview
3453 global pending_select
3454
3455 set row $rowlaidout
3456 layoutrows $rowlaidout $commitidx($curview) 1
3457 layouttail
3458 optimize_rows $row 0 $commitidx($curview)
3459 showstuff $commitidx($curview)
3460 if {[info exists pending_select]} {
3461 selectline 0 1
3462 }
3463
3464 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3465 #global numcommits
3466 #puts "overall $drawmsecs ms for $numcommits commits"
3467}
3468
3469proc findmatches {f} {
3470 global findtype foundstring foundstrlen
3471 if {$findtype == "Regexp"} {
3472 set matches [regexp -indices -all -inline $foundstring $f]
3473 } else {
3474 if {$findtype == "IgnCase"} {
3475 set str [string tolower $f]
3476 } else {
3477 set str $f
3478 }
3479 set matches {}
3480 set i 0
3481 while {[set j [string first $foundstring $str $i]] >= 0} {
3482 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3483 set i [expr {$j + $foundstrlen}]
3484 }
3485 }
3486 return $matches
3487}
3488
3489proc dofind {} {
3490 global findtype findloc findstring markedmatches commitinfo
3491 global numcommits displayorder linehtag linentag linedtag
3492 global mainfont canv canv2 canv3 selectedline
3493 global matchinglines foundstring foundstrlen matchstring
3494 global commitdata
3495
3496 stopfindproc
3497 unmarkmatches
3498 cancel_next_highlight
3499 focus .
3500 set matchinglines {}
3501 if {$findtype == "IgnCase"} {
3502 set foundstring [string tolower $findstring]
3503 } else {
3504 set foundstring $findstring
3505 }
3506 set foundstrlen [string length $findstring]
3507 if {$foundstrlen == 0} return
3508 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3509 set matchstring "*$matchstring*"
3510 if {![info exists selectedline]} {
3511 set oldsel -1
3512 } else {
3513 set oldsel $selectedline
3514 }
3515 set didsel 0
3516 set fldtypes {Headline Author Date Committer CDate Comments}
3517 set l -1
3518 foreach id $displayorder {
3519 set d $commitdata($id)
3520 incr l
3521 if {$findtype == "Regexp"} {
3522 set doesmatch [regexp $foundstring $d]
3523 } elseif {$findtype == "IgnCase"} {
3524 set doesmatch [string match -nocase $matchstring $d]
3525 } else {
3526 set doesmatch [string match $matchstring $d]
3527 }
3528 if {!$doesmatch} continue
3529 if {![info exists commitinfo($id)]} {
3530 getcommit $id
3531 }
3532 set info $commitinfo($id)
3533 set doesmatch 0
3534 foreach f $info ty $fldtypes {
3535 if {$findloc != "All fields" && $findloc != $ty} {
3536 continue
3537 }
3538 set matches [findmatches $f]
3539 if {$matches == {}} continue
3540 set doesmatch 1
3541 if {$ty == "Headline"} {
3542 drawcmitrow $l
3543 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3544 } elseif {$ty == "Author"} {
3545 drawcmitrow $l
3546 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3547 } elseif {$ty == "Date"} {
3548 drawcmitrow $l
3549 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3550 }
3551 }
3552 if {$doesmatch} {
3553 lappend matchinglines $l
3554 if {!$didsel && $l > $oldsel} {
3555 findselectline $l
3556 set didsel 1
3557 }
3558 }
3559 }
3560 if {$matchinglines == {}} {
3561 bell
3562 } elseif {!$didsel} {
3563 findselectline [lindex $matchinglines 0]
3564 }
3565}
3566
3567proc findselectline {l} {
3568 global findloc commentend ctext
3569 selectline $l 1
3570 if {$findloc == "All fields" || $findloc == "Comments"} {
3571 # highlight the matches in the comments
3572 set f [$ctext get 1.0 $commentend]
3573 set matches [findmatches $f]
3574 foreach match $matches {
3575 set start [lindex $match 0]
3576 set end [expr {[lindex $match 1] + 1}]
3577 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3578 }
3579 }
3580}
3581
3582proc findnext {restart} {
3583 global matchinglines selectedline
3584 if {![info exists matchinglines]} {
3585 if {$restart} {
3586 dofind
3587 }
3588 return
3589 }
3590 if {![info exists selectedline]} return
3591 foreach l $matchinglines {
3592 if {$l > $selectedline} {
3593 findselectline $l
3594 return
3595 }
3596 }
3597 bell
3598}
3599
3600proc findprev {} {
3601 global matchinglines selectedline
3602 if {![info exists matchinglines]} {
3603 dofind
3604 return
3605 }
3606 if {![info exists selectedline]} return
3607 set prev {}
3608 foreach l $matchinglines {
3609 if {$l >= $selectedline} break
3610 set prev $l
3611 }
3612 if {$prev != {}} {
3613 findselectline $prev
3614 } else {
3615 bell
3616 }
3617}
3618
3619proc stopfindproc {{done 0}} {
3620 global findprocpid findprocfile findids
3621 global ctext findoldcursor phase maincursor textcursor
3622 global findinprogress
3623
3624 catch {unset findids}
3625 if {[info exists findprocpid]} {
3626 if {!$done} {
3627 catch {exec kill $findprocpid}
3628 }
3629 catch {close $findprocfile}
3630 unset findprocpid
3631 }
3632 catch {unset findinprogress}
3633 notbusy find
3634}
3635
3636# mark a commit as matching by putting a yellow background
3637# behind the headline
3638proc markheadline {l id} {
3639 global canv mainfont linehtag
3640
3641 drawcmitrow $l
3642 set bbox [$canv bbox $linehtag($l)]
3643 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3644 $canv lower $t
3645}
3646
3647# mark the bits of a headline, author or date that match a find string
3648proc markmatches {canv l str tag matches font} {
3649 set bbox [$canv bbox $tag]
3650 set x0 [lindex $bbox 0]
3651 set y0 [lindex $bbox 1]
3652 set y1 [lindex $bbox 3]
3653 foreach match $matches {
3654 set start [lindex $match 0]
3655 set end [lindex $match 1]
3656 if {$start > $end} continue
3657 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3658 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3659 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3660 [expr {$x0+$xlen+2}] $y1 \
3661 -outline {} -tags matches -fill yellow]
3662 $canv lower $t
3663 }
3664}
3665
3666proc unmarkmatches {} {
3667 global matchinglines findids
3668 allcanvs delete matches
3669 catch {unset matchinglines}
3670 catch {unset findids}
3671}
3672
3673proc selcanvline {w x y} {
3674 global canv canvy0 ctext linespc
3675 global rowtextx
3676 set ymax [lindex [$canv cget -scrollregion] 3]
3677 if {$ymax == {}} return
3678 set yfrac [lindex [$canv yview] 0]
3679 set y [expr {$y + $yfrac * $ymax}]
3680 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3681 if {$l < 0} {
3682 set l 0
3683 }
3684 if {$w eq $canv} {
3685 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3686 }
3687 unmarkmatches
3688 selectline $l 1
3689}
3690
3691proc commit_descriptor {p} {
3692 global commitinfo
3693 if {![info exists commitinfo($p)]} {
3694 getcommit $p
3695 }
3696 set l "..."
3697 if {[llength $commitinfo($p)] > 1} {
3698 set l [lindex $commitinfo($p) 0]
3699 }
3700 return "$p ($l)\n"
3701}
3702
3703# append some text to the ctext widget, and make any SHA1 ID
3704# that we know about be a clickable link.
3705proc appendwithlinks {text tags} {
3706 global ctext commitrow linknum curview
3707
3708 set start [$ctext index "end - 1c"]
3709 $ctext insert end $text $tags
3710 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3711 foreach l $links {
3712 set s [lindex $l 0]
3713 set e [lindex $l 1]
3714 set linkid [string range $text $s $e]
3715 if {![info exists commitrow($curview,$linkid)]} continue
3716 incr e
3717 $ctext tag add link "$start + $s c" "$start + $e c"
3718 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3719 $ctext tag bind link$linknum <1> \
3720 [list selectline $commitrow($curview,$linkid) 1]
3721 incr linknum
3722 }
3723 $ctext tag conf link -foreground blue -underline 1
3724 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3725 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3726}
3727
3728proc viewnextline {dir} {
3729 global canv linespc
3730
3731 $canv delete hover
3732 set ymax [lindex [$canv cget -scrollregion] 3]
3733 set wnow [$canv yview]
3734 set wtop [expr {[lindex $wnow 0] * $ymax}]
3735 set newtop [expr {$wtop + $dir * $linespc}]
3736 if {$newtop < 0} {
3737 set newtop 0
3738 } elseif {$newtop > $ymax} {
3739 set newtop $ymax
3740 }
3741 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3742}
3743
3744# add a list of tag or branch names at position pos
3745# returns the number of names inserted
3746proc appendrefs {pos tags var} {
3747 global ctext commitrow linknum curview $var
3748
3749 if {[catch {$ctext index $pos}]} {
3750 return 0
3751 }
3752 set tags [lsort $tags]
3753 set sep {}
3754 foreach tag $tags {
3755 set id [set $var\($tag\)]
3756 set lk link$linknum
3757 incr linknum
3758 $ctext insert $pos $sep
3759 $ctext insert $pos $tag $lk
3760 $ctext tag conf $lk -foreground blue
3761 if {[info exists commitrow($curview,$id)]} {
3762 $ctext tag bind $lk <1> \
3763 [list selectline $commitrow($curview,$id) 1]
3764 $ctext tag conf $lk -underline 1
3765 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3766 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3767 }
3768 set sep ", "
3769 }
3770 return [llength $tags]
3771}
3772
3773proc taglist {ids} {
3774 global idtags
3775
3776 set tags {}
3777 foreach id $ids {
3778 foreach tag $idtags($id) {
3779 lappend tags $tag
3780 }
3781 }
3782 return $tags
3783}
3784
3785# called when we have finished computing the nearby tags
3786proc dispneartags {} {
3787 global selectedline currentid ctext anc_tags desc_tags showneartags
3788 global desc_heads
3789
3790 if {![info exists selectedline] || !$showneartags} return
3791 set id $currentid
3792 $ctext conf -state normal
3793 if {[info exists desc_heads($id)]} {
3794 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3795 $ctext insert "branch -2c" "es"
3796 }
3797 }
3798 if {[info exists anc_tags($id)]} {
3799 appendrefs follows [taglist $anc_tags($id)] tagids
3800 }
3801 if {[info exists desc_tags($id)]} {
3802 appendrefs precedes [taglist $desc_tags($id)] tagids
3803 }
3804 $ctext conf -state disabled
3805}
3806
3807proc selectline {l isnew} {
3808 global canv canv2 canv3 ctext commitinfo selectedline
3809 global displayorder linehtag linentag linedtag
3810 global canvy0 linespc parentlist childlist
3811 global currentid sha1entry
3812 global commentend idtags linknum
3813 global mergemax numcommits pending_select
3814 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3815
3816 catch {unset pending_select}
3817 $canv delete hover
3818 normalline
3819 cancel_next_highlight
3820 if {$l < 0 || $l >= $numcommits} return
3821 set y [expr {$canvy0 + $l * $linespc}]
3822 set ymax [lindex [$canv cget -scrollregion] 3]
3823 set ytop [expr {$y - $linespc - 1}]
3824 set ybot [expr {$y + $linespc + 1}]
3825 set wnow [$canv yview]
3826 set wtop [expr {[lindex $wnow 0] * $ymax}]
3827 set wbot [expr {[lindex $wnow 1] * $ymax}]
3828 set wh [expr {$wbot - $wtop}]
3829 set newtop $wtop
3830 if {$ytop < $wtop} {
3831 if {$ybot < $wtop} {
3832 set newtop [expr {$y - $wh / 2.0}]
3833 } else {
3834 set newtop $ytop
3835 if {$newtop > $wtop - $linespc} {
3836 set newtop [expr {$wtop - $linespc}]
3837 }
3838 }
3839 } elseif {$ybot > $wbot} {
3840 if {$ytop > $wbot} {
3841 set newtop [expr {$y - $wh / 2.0}]
3842 } else {
3843 set newtop [expr {$ybot - $wh}]
3844 if {$newtop < $wtop + $linespc} {
3845 set newtop [expr {$wtop + $linespc}]
3846 }
3847 }
3848 }
3849 if {$newtop != $wtop} {
3850 if {$newtop < 0} {
3851 set newtop 0
3852 }
3853 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3854 drawvisible
3855 }
3856
3857 if {![info exists linehtag($l)]} return
3858 $canv delete secsel
3859 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3860 -tags secsel -fill [$canv cget -selectbackground]]
3861 $canv lower $t
3862 $canv2 delete secsel
3863 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3864 -tags secsel -fill [$canv2 cget -selectbackground]]
3865 $canv2 lower $t
3866 $canv3 delete secsel
3867 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3868 -tags secsel -fill [$canv3 cget -selectbackground]]
3869 $canv3 lower $t
3870
3871 if {$isnew} {
3872 addtohistory [list selectline $l 0]
3873 }
3874
3875 set selectedline $l
3876
3877 set id [lindex $displayorder $l]
3878 set currentid $id
3879 $sha1entry delete 0 end
3880 $sha1entry insert 0 $id
3881 $sha1entry selection from 0
3882 $sha1entry selection to end
3883 rhighlight_sel $id
3884
3885 $ctext conf -state normal
3886 clear_ctext
3887 set linknum 0
3888 set info $commitinfo($id)
3889 set date [formatdate [lindex $info 2]]
3890 $ctext insert end "Author: [lindex $info 1] $date\n"
3891 set date [formatdate [lindex $info 4]]
3892 $ctext insert end "Committer: [lindex $info 3] $date\n"
3893 if {[info exists idtags($id)]} {
3894 $ctext insert end "Tags:"
3895 foreach tag $idtags($id) {
3896 $ctext insert end " $tag"
3897 }
3898 $ctext insert end "\n"
3899 }
3900
3901 set headers {}
3902 set olds [lindex $parentlist $l]
3903 if {[llength $olds] > 1} {
3904 set np 0
3905 foreach p $olds {
3906 if {$np >= $mergemax} {
3907 set tag mmax
3908 } else {
3909 set tag m$np
3910 }
3911 $ctext insert end "Parent: " $tag
3912 appendwithlinks [commit_descriptor $p] {}
3913 incr np
3914 }
3915 } else {
3916 foreach p $olds {
3917 append headers "Parent: [commit_descriptor $p]"
3918 }
3919 }
3920
3921 foreach c [lindex $childlist $l] {
3922 append headers "Child: [commit_descriptor $c]"
3923 }
3924
3925 # make anything that looks like a SHA1 ID be a clickable link
3926 appendwithlinks $headers {}
3927 if {$showneartags} {
3928 if {![info exists allcommits]} {
3929 getallcommits
3930 }
3931 $ctext insert end "Branch: "
3932 $ctext mark set branch "end -1c"
3933 $ctext mark gravity branch left
3934 if {[info exists desc_heads($id)]} {
3935 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3936 # turn "Branch" into "Branches"
3937 $ctext insert "branch -2c" "es"
3938 }
3939 }
3940 $ctext insert end "\nFollows: "
3941 $ctext mark set follows "end -1c"
3942 $ctext mark gravity follows left
3943 if {[info exists anc_tags($id)]} {
3944 appendrefs follows [taglist $anc_tags($id)] tagids
3945 }
3946 $ctext insert end "\nPrecedes: "
3947 $ctext mark set precedes "end -1c"
3948 $ctext mark gravity precedes left
3949 if {[info exists desc_tags($id)]} {
3950 appendrefs precedes [taglist $desc_tags($id)] tagids
3951 }
3952 $ctext insert end "\n"
3953 }
3954 $ctext insert end "\n"
3955 appendwithlinks [lindex $info 5] {comment}
3956
3957 $ctext tag delete Comments
3958 $ctext tag remove found 1.0 end
3959 $ctext conf -state disabled
3960 set commentend [$ctext index "end - 1c"]
3961
3962 init_flist "Comments"
3963 if {$cmitmode eq "tree"} {
3964 gettree $id
3965 } elseif {[llength $olds] <= 1} {
3966 startdiff $id
3967 } else {
3968 mergediff $id $l
3969 }
3970}
3971
3972proc selfirstline {} {
3973 unmarkmatches
3974 selectline 0 1
3975}
3976
3977proc sellastline {} {
3978 global numcommits
3979 unmarkmatches
3980 set l [expr {$numcommits - 1}]
3981 selectline $l 1
3982}
3983
3984proc selnextline {dir} {
3985 global selectedline
3986 if {![info exists selectedline]} return
3987 set l [expr {$selectedline + $dir}]
3988 unmarkmatches
3989 selectline $l 1
3990}
3991
3992proc selnextpage {dir} {
3993 global canv linespc selectedline numcommits
3994
3995 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3996 if {$lpp < 1} {
3997 set lpp 1
3998 }
3999 allcanvs yview scroll [expr {$dir * $lpp}] units
4000 drawvisible
4001 if {![info exists selectedline]} return
4002 set l [expr {$selectedline + $dir * $lpp}]
4003 if {$l < 0} {
4004 set l 0
4005 } elseif {$l >= $numcommits} {
4006 set l [expr $numcommits - 1]
4007 }
4008 unmarkmatches
4009 selectline $l 1
4010}
4011
4012proc unselectline {} {
4013 global selectedline currentid
4014
4015 catch {unset selectedline}
4016 catch {unset currentid}
4017 allcanvs delete secsel
4018 rhighlight_none
4019 cancel_next_highlight
4020}
4021
4022proc reselectline {} {
4023 global selectedline
4024
4025 if {[info exists selectedline]} {
4026 selectline $selectedline 0
4027 }
4028}
4029
4030proc addtohistory {cmd} {
4031 global history historyindex curview
4032
4033 set elt [list $curview $cmd]
4034 if {$historyindex > 0
4035 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4036 return
4037 }
4038
4039 if {$historyindex < [llength $history]} {
4040 set history [lreplace $history $historyindex end $elt]
4041 } else {
4042 lappend history $elt
4043 }
4044 incr historyindex
4045 if {$historyindex > 1} {
4046 .ctop.top.bar.leftbut conf -state normal
4047 } else {
4048 .ctop.top.bar.leftbut conf -state disabled
4049 }
4050 .ctop.top.bar.rightbut conf -state disabled
4051}
4052
4053proc godo {elt} {
4054 global curview
4055
4056 set view [lindex $elt 0]
4057 set cmd [lindex $elt 1]
4058 if {$curview != $view} {
4059 showview $view
4060 }
4061 eval $cmd
4062}
4063
4064proc goback {} {
4065 global history historyindex
4066
4067 if {$historyindex > 1} {
4068 incr historyindex -1
4069 godo [lindex $history [expr {$historyindex - 1}]]
4070 .ctop.top.bar.rightbut conf -state normal
4071 }
4072 if {$historyindex <= 1} {
4073 .ctop.top.bar.leftbut conf -state disabled
4074 }
4075}
4076
4077proc goforw {} {
4078 global history historyindex
4079
4080 if {$historyindex < [llength $history]} {
4081 set cmd [lindex $history $historyindex]
4082 incr historyindex
4083 godo $cmd
4084 .ctop.top.bar.leftbut conf -state normal
4085 }
4086 if {$historyindex >= [llength $history]} {
4087 .ctop.top.bar.rightbut conf -state disabled
4088 }
4089}
4090
4091proc gettree {id} {
4092 global treefilelist treeidlist diffids diffmergeid treepending
4093
4094 set diffids $id
4095 catch {unset diffmergeid}
4096 if {![info exists treefilelist($id)]} {
4097 if {![info exists treepending]} {
4098 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4099 return
4100 }
4101 set treepending $id
4102 set treefilelist($id) {}
4103 set treeidlist($id) {}
4104 fconfigure $gtf -blocking 0
4105 fileevent $gtf readable [list gettreeline $gtf $id]
4106 }
4107 } else {
4108 setfilelist $id
4109 }
4110}
4111
4112proc gettreeline {gtf id} {
4113 global treefilelist treeidlist treepending cmitmode diffids
4114
4115 while {[gets $gtf line] >= 0} {
4116 if {[lindex $line 1] ne "blob"} continue
4117 set sha1 [lindex $line 2]
4118 set fname [lindex $line 3]
4119 lappend treefilelist($id) $fname
4120 lappend treeidlist($id) $sha1
4121 }
4122 if {![eof $gtf]} return
4123 close $gtf
4124 unset treepending
4125 if {$cmitmode ne "tree"} {
4126 if {![info exists diffmergeid]} {
4127 gettreediffs $diffids
4128 }
4129 } elseif {$id ne $diffids} {
4130 gettree $diffids
4131 } else {
4132 setfilelist $id
4133 }
4134}
4135
4136proc showfile {f} {
4137 global treefilelist treeidlist diffids
4138 global ctext commentend
4139
4140 set i [lsearch -exact $treefilelist($diffids) $f]
4141 if {$i < 0} {
4142 puts "oops, $f not in list for id $diffids"
4143 return
4144 }
4145 set blob [lindex $treeidlist($diffids) $i]
4146 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4147 puts "oops, error reading blob $blob: $err"
4148 return
4149 }
4150 fconfigure $bf -blocking 0
4151 fileevent $bf readable [list getblobline $bf $diffids]
4152 $ctext config -state normal
4153 clear_ctext $commentend
4154 $ctext insert end "\n"
4155 $ctext insert end "$f\n" filesep
4156 $ctext config -state disabled
4157 $ctext yview $commentend
4158}
4159
4160proc getblobline {bf id} {
4161 global diffids cmitmode ctext
4162
4163 if {$id ne $diffids || $cmitmode ne "tree"} {
4164 catch {close $bf}
4165 return
4166 }
4167 $ctext config -state normal
4168 while {[gets $bf line] >= 0} {
4169 $ctext insert end "$line\n"
4170 }
4171 if {[eof $bf]} {
4172 # delete last newline
4173 $ctext delete "end - 2c" "end - 1c"
4174 close $bf
4175 }
4176 $ctext config -state disabled
4177}
4178
4179proc mergediff {id l} {
4180 global diffmergeid diffopts mdifffd
4181 global diffids
4182 global parentlist
4183
4184 set diffmergeid $id
4185 set diffids $id
4186 # this doesn't seem to actually affect anything...
4187 set env(GIT_DIFF_OPTS) $diffopts
4188 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4189 if {[catch {set mdf [open $cmd r]} err]} {
4190 error_popup "Error getting merge diffs: $err"
4191 return
4192 }
4193 fconfigure $mdf -blocking 0
4194 set mdifffd($id) $mdf
4195 set np [llength [lindex $parentlist $l]]
4196 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4197 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4198}
4199
4200proc getmergediffline {mdf id np} {
4201 global diffmergeid ctext cflist nextupdate mergemax
4202 global difffilestart mdifffd
4203
4204 set n [gets $mdf line]
4205 if {$n < 0} {
4206 if {[eof $mdf]} {
4207 close $mdf
4208 }
4209 return
4210 }
4211 if {![info exists diffmergeid] || $id != $diffmergeid
4212 || $mdf != $mdifffd($id)} {
4213 return
4214 }
4215 $ctext conf -state normal
4216 if {[regexp {^diff --cc (.*)} $line match fname]} {
4217 # start of a new file
4218 $ctext insert end "\n"
4219 set here [$ctext index "end - 1c"]
4220 lappend difffilestart $here
4221 add_flist [list $fname]
4222 set l [expr {(78 - [string length $fname]) / 2}]
4223 set pad [string range "----------------------------------------" 1 $l]
4224 $ctext insert end "$pad $fname $pad\n" filesep
4225 } elseif {[regexp {^@@} $line]} {
4226 $ctext insert end "$line\n" hunksep
4227 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4228 # do nothing
4229 } else {
4230 # parse the prefix - one ' ', '-' or '+' for each parent
4231 set spaces {}
4232 set minuses {}
4233 set pluses {}
4234 set isbad 0
4235 for {set j 0} {$j < $np} {incr j} {
4236 set c [string range $line $j $j]
4237 if {$c == " "} {
4238 lappend spaces $j
4239 } elseif {$c == "-"} {
4240 lappend minuses $j
4241 } elseif {$c == "+"} {
4242 lappend pluses $j
4243 } else {
4244 set isbad 1
4245 break
4246 }
4247 }
4248 set tags {}
4249 set num {}
4250 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4251 # line doesn't appear in result, parents in $minuses have the line
4252 set num [lindex $minuses 0]
4253 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4254 # line appears in result, parents in $pluses don't have the line
4255 lappend tags mresult
4256 set num [lindex $spaces 0]
4257 }
4258 if {$num ne {}} {
4259 if {$num >= $mergemax} {
4260 set num "max"
4261 }
4262 lappend tags m$num
4263 }
4264 $ctext insert end "$line\n" $tags
4265 }
4266 $ctext conf -state disabled
4267 if {[clock clicks -milliseconds] >= $nextupdate} {
4268 incr nextupdate 100
4269 fileevent $mdf readable {}
4270 update
4271 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4272 }
4273}
4274
4275proc startdiff {ids} {
4276 global treediffs diffids treepending diffmergeid
4277
4278 set diffids $ids
4279 catch {unset diffmergeid}
4280 if {![info exists treediffs($ids)]} {
4281 if {![info exists treepending]} {
4282 gettreediffs $ids
4283 }
4284 } else {
4285 addtocflist $ids
4286 }
4287}
4288
4289proc addtocflist {ids} {
4290 global treediffs cflist
4291 add_flist $treediffs($ids)
4292 getblobdiffs $ids
4293}
4294
4295proc gettreediffs {ids} {
4296 global treediff treepending
4297 set treepending $ids
4298 set treediff {}
4299 if {[catch \
4300 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4301 ]} return
4302 fconfigure $gdtf -blocking 0
4303 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4304}
4305
4306proc gettreediffline {gdtf ids} {
4307 global treediff treediffs treepending diffids diffmergeid
4308 global cmitmode
4309
4310 set n [gets $gdtf line]
4311 if {$n < 0} {
4312 if {![eof $gdtf]} return
4313 close $gdtf
4314 set treediffs($ids) $treediff
4315 unset treepending
4316 if {$cmitmode eq "tree"} {
4317 gettree $diffids
4318 } elseif {$ids != $diffids} {
4319 if {![info exists diffmergeid]} {
4320 gettreediffs $diffids
4321 }
4322 } else {
4323 addtocflist $ids
4324 }
4325 return
4326 }
4327 set file [lindex $line 5]
4328 lappend treediff $file
4329}
4330
4331proc getblobdiffs {ids} {
4332 global diffopts blobdifffd diffids env curdifftag curtagstart
4333 global nextupdate diffinhdr treediffs
4334
4335 set env(GIT_DIFF_OPTS) $diffopts
4336 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4337 if {[catch {set bdf [open $cmd r]} err]} {
4338 puts "error getting diffs: $err"
4339 return
4340 }
4341 set diffinhdr 0
4342 fconfigure $bdf -blocking 0
4343 set blobdifffd($ids) $bdf
4344 set curdifftag Comments
4345 set curtagstart 0.0
4346 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4347 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4348}
4349
4350proc setinlist {var i val} {
4351 global $var
4352
4353 while {[llength [set $var]] < $i} {
4354 lappend $var {}
4355 }
4356 if {[llength [set $var]] == $i} {
4357 lappend $var $val
4358 } else {
4359 lset $var $i $val
4360 }
4361}
4362
4363proc getblobdiffline {bdf ids} {
4364 global diffids blobdifffd ctext curdifftag curtagstart
4365 global diffnexthead diffnextnote difffilestart
4366 global nextupdate diffinhdr treediffs
4367
4368 set n [gets $bdf line]
4369 if {$n < 0} {
4370 if {[eof $bdf]} {
4371 close $bdf
4372 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4373 $ctext tag add $curdifftag $curtagstart end
4374 }
4375 }
4376 return
4377 }
4378 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4379 return
4380 }
4381 $ctext conf -state normal
4382 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4383 # start of a new file
4384 $ctext insert end "\n"
4385 $ctext tag add $curdifftag $curtagstart end
4386 set here [$ctext index "end - 1c"]
4387 set curtagstart $here
4388 set header $newname
4389 set i [lsearch -exact $treediffs($ids) $fname]
4390 if {$i >= 0} {
4391 setinlist difffilestart $i $here
4392 }
4393 if {$newname ne $fname} {
4394 set i [lsearch -exact $treediffs($ids) $newname]
4395 if {$i >= 0} {
4396 setinlist difffilestart $i $here
4397 }
4398 }
4399 set curdifftag "f:$fname"
4400 $ctext tag delete $curdifftag
4401 set l [expr {(78 - [string length $header]) / 2}]
4402 set pad [string range "----------------------------------------" 1 $l]
4403 $ctext insert end "$pad $header $pad\n" filesep
4404 set diffinhdr 1
4405 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4406 # do nothing
4407 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4408 set diffinhdr 0
4409 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4410 $line match f1l f1c f2l f2c rest]} {
4411 $ctext insert end "$line\n" hunksep
4412 set diffinhdr 0
4413 } else {
4414 set x [string range $line 0 0]
4415 if {$x == "-" || $x == "+"} {
4416 set tag [expr {$x == "+"}]
4417 $ctext insert end "$line\n" d$tag
4418 } elseif {$x == " "} {
4419 $ctext insert end "$line\n"
4420 } elseif {$diffinhdr || $x == "\\"} {
4421 # e.g. "\ No newline at end of file"
4422 $ctext insert end "$line\n" filesep
4423 } else {
4424 # Something else we don't recognize
4425 if {$curdifftag != "Comments"} {
4426 $ctext insert end "\n"
4427 $ctext tag add $curdifftag $curtagstart end
4428 set curtagstart [$ctext index "end - 1c"]
4429 set curdifftag Comments
4430 }
4431 $ctext insert end "$line\n" filesep
4432 }
4433 }
4434 $ctext conf -state disabled
4435 if {[clock clicks -milliseconds] >= $nextupdate} {
4436 incr nextupdate 100
4437 fileevent $bdf readable {}
4438 update
4439 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4440 }
4441}
4442
4443proc prevfile {} {
4444 global difffilestart ctext
4445 set prev [lindex $difffilestart 0]
4446 set here [$ctext index @0,0]
4447 foreach loc $difffilestart {
4448 if {[$ctext compare $loc >= $here]} {
4449 $ctext yview $prev
4450 return
4451 }
4452 set prev $loc
4453 }
4454 $ctext yview $prev
4455}
4456
4457proc nextfile {} {
4458 global difffilestart ctext
4459 set here [$ctext index @0,0]
4460 foreach loc $difffilestart {
4461 if {[$ctext compare $loc > $here]} {
4462 $ctext yview $loc
4463 return
4464 }
4465 }
4466}
4467
4468proc clear_ctext {{first 1.0}} {
4469 global ctext smarktop smarkbot
4470
4471 set l [lindex [split $first .] 0]
4472 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4473 set smarktop $l
4474 }
4475 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4476 set smarkbot $l
4477 }
4478 $ctext delete $first end
4479}
4480
4481proc incrsearch {name ix op} {
4482 global ctext searchstring searchdirn
4483
4484 $ctext tag remove found 1.0 end
4485 if {[catch {$ctext index anchor}]} {
4486 # no anchor set, use start of selection, or of visible area
4487 set sel [$ctext tag ranges sel]
4488 if {$sel ne {}} {
4489 $ctext mark set anchor [lindex $sel 0]
4490 } elseif {$searchdirn eq "-forwards"} {
4491 $ctext mark set anchor @0,0
4492 } else {
4493 $ctext mark set anchor @0,[winfo height $ctext]
4494 }
4495 }
4496 if {$searchstring ne {}} {
4497 set here [$ctext search $searchdirn -- $searchstring anchor]
4498 if {$here ne {}} {
4499 $ctext see $here
4500 }
4501 searchmarkvisible 1
4502 }
4503}
4504
4505proc dosearch {} {
4506 global sstring ctext searchstring searchdirn
4507
4508 focus $sstring
4509 $sstring icursor end
4510 set searchdirn -forwards
4511 if {$searchstring ne {}} {
4512 set sel [$ctext tag ranges sel]
4513 if {$sel ne {}} {
4514 set start "[lindex $sel 0] + 1c"
4515 } elseif {[catch {set start [$ctext index anchor]}]} {
4516 set start "@0,0"
4517 }
4518 set match [$ctext search -count mlen -- $searchstring $start]
4519 $ctext tag remove sel 1.0 end
4520 if {$match eq {}} {
4521 bell
4522 return
4523 }
4524 $ctext see $match
4525 set mend "$match + $mlen c"
4526 $ctext tag add sel $match $mend
4527 $ctext mark unset anchor
4528 }
4529}
4530
4531proc dosearchback {} {
4532 global sstring ctext searchstring searchdirn
4533
4534 focus $sstring
4535 $sstring icursor end
4536 set searchdirn -backwards
4537 if {$searchstring ne {}} {
4538 set sel [$ctext tag ranges sel]
4539 if {$sel ne {}} {
4540 set start [lindex $sel 0]
4541 } elseif {[catch {set start [$ctext index anchor]}]} {
4542 set start @0,[winfo height $ctext]
4543 }
4544 set match [$ctext search -backwards -count ml -- $searchstring $start]
4545 $ctext tag remove sel 1.0 end
4546 if {$match eq {}} {
4547 bell
4548 return
4549 }
4550 $ctext see $match
4551 set mend "$match + $ml c"
4552 $ctext tag add sel $match $mend
4553 $ctext mark unset anchor
4554 }
4555}
4556
4557proc searchmark {first last} {
4558 global ctext searchstring
4559
4560 set mend $first.0
4561 while {1} {
4562 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4563 if {$match eq {}} break
4564 set mend "$match + $mlen c"
4565 $ctext tag add found $match $mend
4566 }
4567}
4568
4569proc searchmarkvisible {doall} {
4570 global ctext smarktop smarkbot
4571
4572 set topline [lindex [split [$ctext index @0,0] .] 0]
4573 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4574 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4575 # no overlap with previous
4576 searchmark $topline $botline
4577 set smarktop $topline
4578 set smarkbot $botline
4579 } else {
4580 if {$topline < $smarktop} {
4581 searchmark $topline [expr {$smarktop-1}]
4582 set smarktop $topline
4583 }
4584 if {$botline > $smarkbot} {
4585 searchmark [expr {$smarkbot+1}] $botline
4586 set smarkbot $botline
4587 }
4588 }
4589}
4590
4591proc scrolltext {f0 f1} {
4592 global searchstring
4593
4594 .ctop.cdet.left.sb set $f0 $f1
4595 if {$searchstring ne {}} {
4596 searchmarkvisible 0
4597 }
4598}
4599
4600proc setcoords {} {
4601 global linespc charspc canvx0 canvy0 mainfont
4602 global xspc1 xspc2 lthickness
4603
4604 set linespc [font metrics $mainfont -linespace]
4605 set charspc [font measure $mainfont "m"]
4606 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4607 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4608 set lthickness [expr {int($linespc / 9) + 1}]
4609 set xspc1(0) $linespc
4610 set xspc2 $linespc
4611}
4612
4613proc redisplay {} {
4614 global canv
4615 global selectedline
4616
4617 set ymax [lindex [$canv cget -scrollregion] 3]
4618 if {$ymax eq {} || $ymax == 0} return
4619 set span [$canv yview]
4620 clear_display
4621 setcanvscroll
4622 allcanvs yview moveto [lindex $span 0]
4623 drawvisible
4624 if {[info exists selectedline]} {
4625 selectline $selectedline 0
4626 allcanvs yview moveto [lindex $span 0]
4627 }
4628}
4629
4630proc incrfont {inc} {
4631 global mainfont textfont ctext canv phase
4632 global stopped entries
4633 unmarkmatches
4634 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4635 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4636 setcoords
4637 $ctext conf -font $textfont
4638 $ctext tag conf filesep -font [concat $textfont bold]
4639 foreach e $entries {
4640 $e conf -font $mainfont
4641 }
4642 if {$phase eq "getcommits"} {
4643 $canv itemconf textitems -font $mainfont
4644 }
4645 redisplay
4646}
4647
4648proc clearsha1 {} {
4649 global sha1entry sha1string
4650 if {[string length $sha1string] == 40} {
4651 $sha1entry delete 0 end
4652 }
4653}
4654
4655proc sha1change {n1 n2 op} {
4656 global sha1string currentid sha1but
4657 if {$sha1string == {}
4658 || ([info exists currentid] && $sha1string == $currentid)} {
4659 set state disabled
4660 } else {
4661 set state normal
4662 }
4663 if {[$sha1but cget -state] == $state} return
4664 if {$state == "normal"} {
4665 $sha1but conf -state normal -relief raised -text "Goto: "
4666 } else {
4667 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4668 }
4669}
4670
4671proc gotocommit {} {
4672 global sha1string currentid commitrow tagids headids
4673 global displayorder numcommits curview
4674
4675 if {$sha1string == {}
4676 || ([info exists currentid] && $sha1string == $currentid)} return
4677 if {[info exists tagids($sha1string)]} {
4678 set id $tagids($sha1string)
4679 } elseif {[info exists headids($sha1string)]} {
4680 set id $headids($sha1string)
4681 } else {
4682 set id [string tolower $sha1string]
4683 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4684 set matches {}
4685 foreach i $displayorder {
4686 if {[string match $id* $i]} {
4687 lappend matches $i
4688 }
4689 }
4690 if {$matches ne {}} {
4691 if {[llength $matches] > 1} {
4692 error_popup "Short SHA1 id $id is ambiguous"
4693 return
4694 }
4695 set id [lindex $matches 0]
4696 }
4697 }
4698 }
4699 if {[info exists commitrow($curview,$id)]} {
4700 selectline $commitrow($curview,$id) 1
4701 return
4702 }
4703 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4704 set type "SHA1 id"
4705 } else {
4706 set type "Tag/Head"
4707 }
4708 error_popup "$type $sha1string is not known"
4709}
4710
4711proc lineenter {x y id} {
4712 global hoverx hovery hoverid hovertimer
4713 global commitinfo canv
4714
4715 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4716 set hoverx $x
4717 set hovery $y
4718 set hoverid $id
4719 if {[info exists hovertimer]} {
4720 after cancel $hovertimer
4721 }
4722 set hovertimer [after 500 linehover]
4723 $canv delete hover
4724}
4725
4726proc linemotion {x y id} {
4727 global hoverx hovery hoverid hovertimer
4728
4729 if {[info exists hoverid] && $id == $hoverid} {
4730 set hoverx $x
4731 set hovery $y
4732 if {[info exists hovertimer]} {
4733 after cancel $hovertimer
4734 }
4735 set hovertimer [after 500 linehover]
4736 }
4737}
4738
4739proc lineleave {id} {
4740 global hoverid hovertimer canv
4741
4742 if {[info exists hoverid] && $id == $hoverid} {
4743 $canv delete hover
4744 if {[info exists hovertimer]} {
4745 after cancel $hovertimer
4746 unset hovertimer
4747 }
4748 unset hoverid
4749 }
4750}
4751
4752proc linehover {} {
4753 global hoverx hovery hoverid hovertimer
4754 global canv linespc lthickness
4755 global commitinfo mainfont
4756
4757 set text [lindex $commitinfo($hoverid) 0]
4758 set ymax [lindex [$canv cget -scrollregion] 3]
4759 if {$ymax == {}} return
4760 set yfrac [lindex [$canv yview] 0]
4761 set x [expr {$hoverx + 2 * $linespc}]
4762 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4763 set x0 [expr {$x - 2 * $lthickness}]
4764 set y0 [expr {$y - 2 * $lthickness}]
4765 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4766 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4767 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4768 -fill \#ffff80 -outline black -width 1 -tags hover]
4769 $canv raise $t
4770 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4771 -font $mainfont]
4772 $canv raise $t
4773}
4774
4775proc clickisonarrow {id y} {
4776 global lthickness
4777
4778 set ranges [rowranges $id]
4779 set thresh [expr {2 * $lthickness + 6}]
4780 set n [expr {[llength $ranges] - 1}]
4781 for {set i 1} {$i < $n} {incr i} {
4782 set row [lindex $ranges $i]
4783 if {abs([yc $row] - $y) < $thresh} {
4784 return $i
4785 }
4786 }
4787 return {}
4788}
4789
4790proc arrowjump {id n y} {
4791 global canv
4792
4793 # 1 <-> 2, 3 <-> 4, etc...
4794 set n [expr {(($n - 1) ^ 1) + 1}]
4795 set row [lindex [rowranges $id] $n]
4796 set yt [yc $row]
4797 set ymax [lindex [$canv cget -scrollregion] 3]
4798 if {$ymax eq {} || $ymax <= 0} return
4799 set view [$canv yview]
4800 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4801 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4802 if {$yfrac < 0} {
4803 set yfrac 0
4804 }
4805 allcanvs yview moveto $yfrac
4806}
4807
4808proc lineclick {x y id isnew} {
4809 global ctext commitinfo children canv thickerline curview
4810
4811 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4812 unmarkmatches
4813 unselectline
4814 normalline
4815 $canv delete hover
4816 # draw this line thicker than normal
4817 set thickerline $id
4818 drawlines $id
4819 if {$isnew} {
4820 set ymax [lindex [$canv cget -scrollregion] 3]
4821 if {$ymax eq {}} return
4822 set yfrac [lindex [$canv yview] 0]
4823 set y [expr {$y + $yfrac * $ymax}]
4824 }
4825 set dirn [clickisonarrow $id $y]
4826 if {$dirn ne {}} {
4827 arrowjump $id $dirn $y
4828 return
4829 }
4830
4831 if {$isnew} {
4832 addtohistory [list lineclick $x $y $id 0]
4833 }
4834 # fill the details pane with info about this line
4835 $ctext conf -state normal
4836 clear_ctext
4837 $ctext tag conf link -foreground blue -underline 1
4838 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4839 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4840 $ctext insert end "Parent:\t"
4841 $ctext insert end $id [list link link0]
4842 $ctext tag bind link0 <1> [list selbyid $id]
4843 set info $commitinfo($id)
4844 $ctext insert end "\n\t[lindex $info 0]\n"
4845 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4846 set date [formatdate [lindex $info 2]]
4847 $ctext insert end "\tDate:\t$date\n"
4848 set kids $children($curview,$id)
4849 if {$kids ne {}} {
4850 $ctext insert end "\nChildren:"
4851 set i 0
4852 foreach child $kids {
4853 incr i
4854 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4855 set info $commitinfo($child)
4856 $ctext insert end "\n\t"
4857 $ctext insert end $child [list link link$i]
4858 $ctext tag bind link$i <1> [list selbyid $child]
4859 $ctext insert end "\n\t[lindex $info 0]"
4860 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4861 set date [formatdate [lindex $info 2]]
4862 $ctext insert end "\n\tDate:\t$date\n"
4863 }
4864 }
4865 $ctext conf -state disabled
4866 init_flist {}
4867}
4868
4869proc normalline {} {
4870 global thickerline
4871 if {[info exists thickerline]} {
4872 set id $thickerline
4873 unset thickerline
4874 drawlines $id
4875 }
4876}
4877
4878proc selbyid {id} {
4879 global commitrow curview
4880 if {[info exists commitrow($curview,$id)]} {
4881 selectline $commitrow($curview,$id) 1
4882 }
4883}
4884
4885proc mstime {} {
4886 global startmstime
4887 if {![info exists startmstime]} {
4888 set startmstime [clock clicks -milliseconds]
4889 }
4890 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4891}
4892
4893proc rowmenu {x y id} {
4894 global rowctxmenu commitrow selectedline rowmenuid curview
4895
4896 if {![info exists selectedline]
4897 || $commitrow($curview,$id) eq $selectedline} {
4898 set state disabled
4899 } else {
4900 set state normal
4901 }
4902 $rowctxmenu entryconfigure "Diff this*" -state $state
4903 $rowctxmenu entryconfigure "Diff selected*" -state $state
4904 $rowctxmenu entryconfigure "Make patch" -state $state
4905 set rowmenuid $id
4906 tk_popup $rowctxmenu $x $y
4907}
4908
4909proc diffvssel {dirn} {
4910 global rowmenuid selectedline displayorder
4911
4912 if {![info exists selectedline]} return
4913 if {$dirn} {
4914 set oldid [lindex $displayorder $selectedline]
4915 set newid $rowmenuid
4916 } else {
4917 set oldid $rowmenuid
4918 set newid [lindex $displayorder $selectedline]
4919 }
4920 addtohistory [list doseldiff $oldid $newid]
4921 doseldiff $oldid $newid
4922}
4923
4924proc doseldiff {oldid newid} {
4925 global ctext
4926 global commitinfo
4927
4928 $ctext conf -state normal
4929 clear_ctext
4930 init_flist "Top"
4931 $ctext insert end "From "
4932 $ctext tag conf link -foreground blue -underline 1
4933 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4934 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4935 $ctext tag bind link0 <1> [list selbyid $oldid]
4936 $ctext insert end $oldid [list link link0]
4937 $ctext insert end "\n "
4938 $ctext insert end [lindex $commitinfo($oldid) 0]
4939 $ctext insert end "\n\nTo "
4940 $ctext tag bind link1 <1> [list selbyid $newid]
4941 $ctext insert end $newid [list link link1]
4942 $ctext insert end "\n "
4943 $ctext insert end [lindex $commitinfo($newid) 0]
4944 $ctext insert end "\n"
4945 $ctext conf -state disabled
4946 $ctext tag delete Comments
4947 $ctext tag remove found 1.0 end
4948 startdiff [list $oldid $newid]
4949}
4950
4951proc mkpatch {} {
4952 global rowmenuid currentid commitinfo patchtop patchnum
4953
4954 if {![info exists currentid]} return
4955 set oldid $currentid
4956 set oldhead [lindex $commitinfo($oldid) 0]
4957 set newid $rowmenuid
4958 set newhead [lindex $commitinfo($newid) 0]
4959 set top .patch
4960 set patchtop $top
4961 catch {destroy $top}
4962 toplevel $top
4963 label $top.title -text "Generate patch"
4964 grid $top.title - -pady 10
4965 label $top.from -text "From:"
4966 entry $top.fromsha1 -width 40 -relief flat
4967 $top.fromsha1 insert 0 $oldid
4968 $top.fromsha1 conf -state readonly
4969 grid $top.from $top.fromsha1 -sticky w
4970 entry $top.fromhead -width 60 -relief flat
4971 $top.fromhead insert 0 $oldhead
4972 $top.fromhead conf -state readonly
4973 grid x $top.fromhead -sticky w
4974 label $top.to -text "To:"
4975 entry $top.tosha1 -width 40 -relief flat
4976 $top.tosha1 insert 0 $newid
4977 $top.tosha1 conf -state readonly
4978 grid $top.to $top.tosha1 -sticky w
4979 entry $top.tohead -width 60 -relief flat
4980 $top.tohead insert 0 $newhead
4981 $top.tohead conf -state readonly
4982 grid x $top.tohead -sticky w
4983 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4984 grid $top.rev x -pady 10
4985 label $top.flab -text "Output file:"
4986 entry $top.fname -width 60
4987 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4988 incr patchnum
4989 grid $top.flab $top.fname -sticky w
4990 frame $top.buts
4991 button $top.buts.gen -text "Generate" -command mkpatchgo
4992 button $top.buts.can -text "Cancel" -command mkpatchcan
4993 grid $top.buts.gen $top.buts.can
4994 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4995 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4996 grid $top.buts - -pady 10 -sticky ew
4997 focus $top.fname
4998}
4999
5000proc mkpatchrev {} {
5001 global patchtop
5002
5003 set oldid [$patchtop.fromsha1 get]
5004 set oldhead [$patchtop.fromhead get]
5005 set newid [$patchtop.tosha1 get]
5006 set newhead [$patchtop.tohead get]
5007 foreach e [list fromsha1 fromhead tosha1 tohead] \
5008 v [list $newid $newhead $oldid $oldhead] {
5009 $patchtop.$e conf -state normal
5010 $patchtop.$e delete 0 end
5011 $patchtop.$e insert 0 $v
5012 $patchtop.$e conf -state readonly
5013 }
5014}
5015
5016proc mkpatchgo {} {
5017 global patchtop
5018
5019 set oldid [$patchtop.fromsha1 get]
5020 set newid [$patchtop.tosha1 get]
5021 set fname [$patchtop.fname get]
5022 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5023 error_popup "Error creating patch: $err"
5024 }
5025 catch {destroy $patchtop}
5026 unset patchtop
5027}
5028
5029proc mkpatchcan {} {
5030 global patchtop
5031
5032 catch {destroy $patchtop}
5033 unset patchtop
5034}
5035
5036proc mktag {} {
5037 global rowmenuid mktagtop commitinfo
5038
5039 set top .maketag
5040 set mktagtop $top
5041 catch {destroy $top}
5042 toplevel $top
5043 label $top.title -text "Create tag"
5044 grid $top.title - -pady 10
5045 label $top.id -text "ID:"
5046 entry $top.sha1 -width 40 -relief flat
5047 $top.sha1 insert 0 $rowmenuid
5048 $top.sha1 conf -state readonly
5049 grid $top.id $top.sha1 -sticky w
5050 entry $top.head -width 60 -relief flat
5051 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5052 $top.head conf -state readonly
5053 grid x $top.head -sticky w
5054 label $top.tlab -text "Tag name:"
5055 entry $top.tag -width 60
5056 grid $top.tlab $top.tag -sticky w
5057 frame $top.buts
5058 button $top.buts.gen -text "Create" -command mktaggo
5059 button $top.buts.can -text "Cancel" -command mktagcan
5060 grid $top.buts.gen $top.buts.can
5061 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5062 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5063 grid $top.buts - -pady 10 -sticky ew
5064 focus $top.tag
5065}
5066
5067proc domktag {} {
5068 global mktagtop env tagids idtags
5069
5070 set id [$mktagtop.sha1 get]
5071 set tag [$mktagtop.tag get]
5072 if {$tag == {}} {
5073 error_popup "No tag name specified"
5074 return
5075 }
5076 if {[info exists tagids($tag)]} {
5077 error_popup "Tag \"$tag\" already exists"
5078 return
5079 }
5080 if {[catch {
5081 set dir [gitdir]
5082 set fname [file join $dir "refs/tags" $tag]
5083 set f [open $fname w]
5084 puts $f $id
5085 close $f
5086 } err]} {
5087 error_popup "Error creating tag: $err"
5088 return
5089 }
5090
5091 set tagids($tag) $id
5092 lappend idtags($id) $tag
5093 redrawtags $id
5094 addedtag $id
5095}
5096
5097proc redrawtags {id} {
5098 global canv linehtag commitrow idpos selectedline curview
5099 global mainfont canvxmax
5100
5101 if {![info exists commitrow($curview,$id)]} return
5102 drawcmitrow $commitrow($curview,$id)
5103 $canv delete tag.$id
5104 set xt [eval drawtags $id $idpos($id)]
5105 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5106 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5107 set xr [expr {$xt + [font measure $mainfont $text]}]
5108 if {$xr > $canvxmax} {
5109 set canvxmax $xr
5110 setcanvscroll
5111 }
5112 if {[info exists selectedline]
5113 && $selectedline == $commitrow($curview,$id)} {
5114 selectline $selectedline 0
5115 }
5116}
5117
5118proc mktagcan {} {
5119 global mktagtop
5120
5121 catch {destroy $mktagtop}
5122 unset mktagtop
5123}
5124
5125proc mktaggo {} {
5126 domktag
5127 mktagcan
5128}
5129
5130proc writecommit {} {
5131 global rowmenuid wrcomtop commitinfo wrcomcmd
5132
5133 set top .writecommit
5134 set wrcomtop $top
5135 catch {destroy $top}
5136 toplevel $top
5137 label $top.title -text "Write commit to file"
5138 grid $top.title - -pady 10
5139 label $top.id -text "ID:"
5140 entry $top.sha1 -width 40 -relief flat
5141 $top.sha1 insert 0 $rowmenuid
5142 $top.sha1 conf -state readonly
5143 grid $top.id $top.sha1 -sticky w
5144 entry $top.head -width 60 -relief flat
5145 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5146 $top.head conf -state readonly
5147 grid x $top.head -sticky w
5148 label $top.clab -text "Command:"
5149 entry $top.cmd -width 60 -textvariable wrcomcmd
5150 grid $top.clab $top.cmd -sticky w -pady 10
5151 label $top.flab -text "Output file:"
5152 entry $top.fname -width 60
5153 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5154 grid $top.flab $top.fname -sticky w
5155 frame $top.buts
5156 button $top.buts.gen -text "Write" -command wrcomgo
5157 button $top.buts.can -text "Cancel" -command wrcomcan
5158 grid $top.buts.gen $top.buts.can
5159 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5160 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5161 grid $top.buts - -pady 10 -sticky ew
5162 focus $top.fname
5163}
5164
5165proc wrcomgo {} {
5166 global wrcomtop
5167
5168 set id [$wrcomtop.sha1 get]
5169 set cmd "echo $id | [$wrcomtop.cmd get]"
5170 set fname [$wrcomtop.fname get]
5171 if {[catch {exec sh -c $cmd >$fname &} err]} {
5172 error_popup "Error writing commit: $err"
5173 }
5174 catch {destroy $wrcomtop}
5175 unset wrcomtop
5176}
5177
5178proc wrcomcan {} {
5179 global wrcomtop
5180
5181 catch {destroy $wrcomtop}
5182 unset wrcomtop
5183}
5184
5185proc mkbranch {} {
5186 global rowmenuid mkbrtop
5187
5188 set top .makebranch
5189 catch {destroy $top}
5190 toplevel $top
5191 label $top.title -text "Create new branch"
5192 grid $top.title - -pady 10
5193 label $top.id -text "ID:"
5194 entry $top.sha1 -width 40 -relief flat
5195 $top.sha1 insert 0 $rowmenuid
5196 $top.sha1 conf -state readonly
5197 grid $top.id $top.sha1 -sticky w
5198 label $top.nlab -text "Name:"
5199 entry $top.name -width 40
5200 grid $top.nlab $top.name -sticky w
5201 frame $top.buts
5202 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5203 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5204 grid $top.buts.go $top.buts.can
5205 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5206 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5207 grid $top.buts - -pady 10 -sticky ew
5208 focus $top.name
5209}
5210
5211proc mkbrgo {top} {
5212 global headids idheads
5213
5214 set name [$top.name get]
5215 set id [$top.sha1 get]
5216 if {$name eq {}} {
5217 error_popup "Please specify a name for the new branch"
5218 return
5219 }
5220 catch {destroy $top}
5221 nowbusy newbranch
5222 update
5223 if {[catch {
5224 exec git branch $name $id
5225 } err]} {
5226 notbusy newbranch
5227 error_popup $err
5228 } else {
5229 addedhead $id $name
5230 # XXX should update list of heads displayed for selected commit
5231 notbusy newbranch
5232 redrawtags $id
5233 }
5234}
5235
5236proc cherrypick {} {
5237 global rowmenuid curview commitrow
5238 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5239
5240 if {[info exists desc_heads($rowmenuid)]
5241 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5242 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5243 included in branch $mainhead -- really re-apply it?"]
5244 if {!$ok} return
5245 }
5246 nowbusy cherrypick
5247 update
5248 set oldhead [exec git rev-parse HEAD]
5249 # Unfortunately git-cherry-pick writes stuff to stderr even when
5250 # no error occurs, and exec takes that as an indication of error...
5251 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5252 notbusy cherrypick
5253 error_popup $err
5254 return
5255 }
5256 set newhead [exec git rev-parse HEAD]
5257 if {$newhead eq $oldhead} {
5258 notbusy cherrypick
5259 error_popup "No changes committed"
5260 return
5261 }
5262 set allparents($newhead) $oldhead
5263 lappend allchildren($oldhead) $newhead
5264 set desc_heads($newhead) $mainhead
5265 if {[info exists anc_tags($oldhead)]} {
5266 set anc_tags($newhead) $anc_tags($oldhead)
5267 }
5268 set desc_tags($newhead) {}
5269 if {[info exists commitrow($curview,$oldhead)]} {
5270 insertrow $commitrow($curview,$oldhead) $newhead
5271 if {$mainhead ne {}} {
5272 movedhead $newhead $mainhead
5273 }
5274 redrawtags $oldhead
5275 redrawtags $newhead
5276 }
5277 notbusy cherrypick
5278}
5279
5280# context menu for a head
5281proc headmenu {x y id head} {
5282 global headmenuid headmenuhead headctxmenu
5283
5284 set headmenuid $id
5285 set headmenuhead $head
5286 tk_popup $headctxmenu $x $y
5287}
5288
5289proc cobranch {} {
5290 global headmenuid headmenuhead mainhead headids
5291
5292 # check the tree is clean first??
5293 set oldmainhead $mainhead
5294 nowbusy checkout
5295 update
5296 if {[catch {
5297 exec git checkout $headmenuhead
5298 } err]} {
5299 notbusy checkout
5300 error_popup $err
5301 } else {
5302 notbusy checkout
5303 set mainhead $headmenuhead
5304 if {[info exists headids($oldmainhead)]} {
5305 redrawtags $headids($oldmainhead)
5306 }
5307 redrawtags $headmenuid
5308 }
5309}
5310
5311proc rmbranch {} {
5312 global desc_heads headmenuid headmenuhead mainhead
5313 global headids idheads
5314
5315 set head $headmenuhead
5316 set id $headmenuid
5317 if {$head eq $mainhead} {
5318 error_popup "Cannot delete the currently checked-out branch"
5319 return
5320 }
5321 if {$desc_heads($id) eq $head} {
5322 # the stuff on this branch isn't on any other branch
5323 if {![confirm_popup "The commits on branch $head aren't on any other\
5324 branch.\nReally delete branch $head?"]} return
5325 }
5326 nowbusy rmbranch
5327 update
5328 if {[catch {exec git branch -D $head} err]} {
5329 notbusy rmbranch
5330 error_popup $err
5331 return
5332 }
5333 removedhead $id $head
5334 redrawtags $id
5335 notbusy rmbranch
5336}
5337
5338# Stuff for finding nearby tags
5339proc getallcommits {} {
5340 global allcstart allcommits allcfd allids
5341
5342 set allids {}
5343 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5344 set allcfd $fd
5345 fconfigure $fd -blocking 0
5346 set allcommits "reading"
5347 nowbusy allcommits
5348 restartgetall $fd
5349}
5350
5351proc discardallcommits {} {
5352 global allparents allchildren allcommits allcfd
5353 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5354
5355 if {![info exists allcommits]} return
5356 if {$allcommits eq "reading"} {
5357 catch {close $allcfd}
5358 }
5359 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5360 alldtags tagisdesc desc_heads} {
5361 catch {unset $v}
5362 }
5363}
5364
5365proc restartgetall {fd} {
5366 global allcstart
5367
5368 fileevent $fd readable [list getallclines $fd]
5369 set allcstart [clock clicks -milliseconds]
5370}
5371
5372proc combine_dtags {l1 l2} {
5373 global tagisdesc notfirstd
5374
5375 set res [lsort -unique [concat $l1 $l2]]
5376 for {set i 0} {$i < [llength $res]} {incr i} {
5377 set x [lindex $res $i]
5378 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5379 set y [lindex $res $j]
5380 if {[info exists tagisdesc($x,$y)]} {
5381 if {$tagisdesc($x,$y) > 0} {
5382 # x is a descendent of y, exclude x
5383 set res [lreplace $res $i $i]
5384 incr i -1
5385 break
5386 } else {
5387 # y is a descendent of x, exclude y
5388 set res [lreplace $res $j $j]
5389 }
5390 } else {
5391 # no relation, keep going
5392 incr j
5393 }
5394 }
5395 }
5396 return $res
5397}
5398
5399proc combine_atags {l1 l2} {
5400 global tagisdesc
5401
5402 set res [lsort -unique [concat $l1 $l2]]
5403 for {set i 0} {$i < [llength $res]} {incr i} {
5404 set x [lindex $res $i]
5405 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5406 set y [lindex $res $j]
5407 if {[info exists tagisdesc($x,$y)]} {
5408 if {$tagisdesc($x,$y) < 0} {
5409 # x is an ancestor of y, exclude x
5410 set res [lreplace $res $i $i]
5411 incr i -1
5412 break
5413 } else {
5414 # y is an ancestor of x, exclude y
5415 set res [lreplace $res $j $j]
5416 }
5417 } else {
5418 # no relation, keep going
5419 incr j
5420 }
5421 }
5422 }
5423 return $res
5424}
5425
5426proc forward_pass {id children} {
5427 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5428
5429 set dtags {}
5430 set dheads {}
5431 foreach child $children {
5432 if {[info exists idtags($child)]} {
5433 set ctags [list $child]
5434 } else {
5435 set ctags $desc_tags($child)
5436 }
5437 if {$dtags eq {}} {
5438 set dtags $ctags
5439 } elseif {$ctags ne $dtags} {
5440 set dtags [combine_dtags $dtags $ctags]
5441 }
5442 set cheads $desc_heads($child)
5443 if {$dheads eq {}} {
5444 set dheads $cheads
5445 } elseif {$cheads ne $dheads} {
5446 set dheads [lsort -unique [concat $dheads $cheads]]
5447 }
5448 }
5449 set desc_tags($id) $dtags
5450 if {[info exists idtags($id)]} {
5451 set adt $dtags
5452 foreach tag $dtags {
5453 set adt [concat $adt $alldtags($tag)]
5454 }
5455 set adt [lsort -unique $adt]
5456 set alldtags($id) $adt
5457 foreach tag $adt {
5458 set tagisdesc($id,$tag) -1
5459 set tagisdesc($tag,$id) 1
5460 }
5461 }
5462 if {[info exists idheads($id)]} {
5463 set dheads [concat $dheads $idheads($id)]
5464 }
5465 set desc_heads($id) $dheads
5466}
5467
5468proc getallclines {fd} {
5469 global allparents allchildren allcommits allcstart
5470 global desc_tags anc_tags idtags tagisdesc allids
5471 global idheads travindex
5472
5473 while {[gets $fd line] >= 0} {
5474 set id [lindex $line 0]
5475 lappend allids $id
5476 set olds [lrange $line 1 end]
5477 set allparents($id) $olds
5478 if {![info exists allchildren($id)]} {
5479 set allchildren($id) {}
5480 }
5481 foreach p $olds {
5482 lappend allchildren($p) $id
5483 }
5484 # compute nearest tagged descendents as we go
5485 # also compute descendent heads
5486 forward_pass $id $allchildren($id)
5487 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5488 fileevent $fd readable {}
5489 after idle restartgetall $fd
5490 return
5491 }
5492 }
5493 if {[eof $fd]} {
5494 set travindex [llength $allids]
5495 set allcommits "traversing"
5496 after idle restartatags
5497 if {[catch {close $fd} err]} {
5498 error_popup "Error reading full commit graph: $err.\n\
5499 Results may be incomplete."
5500 }
5501 }
5502}
5503
5504# walk backward through the tree and compute nearest tagged ancestors
5505proc restartatags {} {
5506 global allids allparents idtags anc_tags travindex
5507
5508 set t0 [clock clicks -milliseconds]
5509 set i $travindex
5510 while {[incr i -1] >= 0} {
5511 set id [lindex $allids $i]
5512 set atags {}
5513 foreach p $allparents($id) {
5514 if {[info exists idtags($p)]} {
5515 set ptags [list $p]
5516 } else {
5517 set ptags $anc_tags($p)
5518 }
5519 if {$atags eq {}} {
5520 set atags $ptags
5521 } elseif {$ptags ne $atags} {
5522 set atags [combine_atags $atags $ptags]
5523 }
5524 }
5525 set anc_tags($id) $atags
5526 if {[clock clicks -milliseconds] - $t0 >= 50} {
5527 set travindex $i
5528 after idle restartatags
5529 return
5530 }
5531 }
5532 set allcommits "done"
5533 set travindex 0
5534 notbusy allcommits
5535 dispneartags
5536}
5537
5538# update the desc_tags and anc_tags arrays for a new tag just added
5539proc addedtag {id} {
5540 global desc_tags anc_tags allparents allchildren allcommits
5541 global idtags tagisdesc alldtags
5542
5543 if {![info exists desc_tags($id)]} return
5544 set adt $desc_tags($id)
5545 foreach t $desc_tags($id) {
5546 set adt [concat $adt $alldtags($t)]
5547 }
5548 set adt [lsort -unique $adt]
5549 set alldtags($id) $adt
5550 foreach t $adt {
5551 set tagisdesc($id,$t) -1
5552 set tagisdesc($t,$id) 1
5553 }
5554 if {[info exists anc_tags($id)]} {
5555 set todo $anc_tags($id)
5556 while {$todo ne {}} {
5557 set do [lindex $todo 0]
5558 set todo [lrange $todo 1 end]
5559 if {[info exists tagisdesc($id,$do)]} continue
5560 set tagisdesc($do,$id) -1
5561 set tagisdesc($id,$do) 1
5562 if {[info exists anc_tags($do)]} {
5563 set todo [concat $todo $anc_tags($do)]
5564 }
5565 }
5566 }
5567
5568 set lastold $desc_tags($id)
5569 set lastnew [list $id]
5570 set nup 0
5571 set nch 0
5572 set todo $allparents($id)
5573 while {$todo ne {}} {
5574 set do [lindex $todo 0]
5575 set todo [lrange $todo 1 end]
5576 if {![info exists desc_tags($do)]} continue
5577 if {$desc_tags($do) ne $lastold} {
5578 set lastold $desc_tags($do)
5579 set lastnew [combine_dtags $lastold [list $id]]
5580 incr nch
5581 }
5582 if {$lastold eq $lastnew} continue
5583 set desc_tags($do) $lastnew
5584 incr nup
5585 if {![info exists idtags($do)]} {
5586 set todo [concat $todo $allparents($do)]
5587 }
5588 }
5589
5590 if {![info exists anc_tags($id)]} return
5591 set lastold $anc_tags($id)
5592 set lastnew [list $id]
5593 set nup 0
5594 set nch 0
5595 set todo $allchildren($id)
5596 while {$todo ne {}} {
5597 set do [lindex $todo 0]
5598 set todo [lrange $todo 1 end]
5599 if {![info exists anc_tags($do)]} continue
5600 if {$anc_tags($do) ne $lastold} {
5601 set lastold $anc_tags($do)
5602 set lastnew [combine_atags $lastold [list $id]]
5603 incr nch
5604 }
5605 if {$lastold eq $lastnew} continue
5606 set anc_tags($do) $lastnew
5607 incr nup
5608 if {![info exists idtags($do)]} {
5609 set todo [concat $todo $allchildren($do)]
5610 }
5611 }
5612}
5613
5614# update the desc_heads array for a new head just added
5615proc addedhead {hid head} {
5616 global desc_heads allparents headids idheads
5617
5618 set headids($head) $hid
5619 lappend idheads($hid) $head
5620
5621 set todo [list $hid]
5622 while {$todo ne {}} {
5623 set do [lindex $todo 0]
5624 set todo [lrange $todo 1 end]
5625 if {![info exists desc_heads($do)] ||
5626 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5627 set oldheads $desc_heads($do)
5628 lappend desc_heads($do) $head
5629 set heads $desc_heads($do)
5630 while {1} {
5631 set p $allparents($do)
5632 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5633 $desc_heads($p) ne $oldheads} break
5634 set do $p
5635 set desc_heads($do) $heads
5636 }
5637 set todo [concat $todo $p]
5638 }
5639}
5640
5641# update the desc_heads array for a head just removed
5642proc removedhead {hid head} {
5643 global desc_heads allparents headids idheads
5644
5645 unset headids($head)
5646 if {$idheads($hid) eq $head} {
5647 unset idheads($hid)
5648 } else {
5649 set i [lsearch -exact $idheads($hid) $head]
5650 if {$i >= 0} {
5651 set idheads($hid) [lreplace $idheads($hid) $i $i]
5652 }
5653 }
5654
5655 set todo [list $hid]
5656 while {$todo ne {}} {
5657 set do [lindex $todo 0]
5658 set todo [lrange $todo 1 end]
5659 if {![info exists desc_heads($do)]} continue
5660 set i [lsearch -exact $desc_heads($do) $head]
5661 if {$i < 0} continue
5662 set oldheads $desc_heads($do)
5663 set heads [lreplace $desc_heads($do) $i $i]
5664 while {1} {
5665 set desc_heads($do) $heads
5666 set p $allparents($do)
5667 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5668 $desc_heads($p) ne $oldheads} break
5669 set do $p
5670 }
5671 set todo [concat $todo $p]
5672 }
5673}
5674
5675# update things for a head moved to a child of its previous location
5676proc movedhead {id name} {
5677 global headids idheads
5678
5679 set oldid $headids($name)
5680 set headids($name) $id
5681 if {$idheads($oldid) eq $name} {
5682 unset idheads($oldid)
5683 } else {
5684 set i [lsearch -exact $idheads($oldid) $name]
5685 if {$i >= 0} {
5686 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5687 }
5688 }
5689 lappend idheads($id) $name
5690}
5691
5692proc changedrefs {} {
5693 global desc_heads desc_tags anc_tags allcommits allids
5694 global allchildren allparents idtags travindex
5695
5696 if {![info exists allcommits]} return
5697 catch {unset desc_heads}
5698 catch {unset desc_tags}
5699 catch {unset anc_tags}
5700 catch {unset alldtags}
5701 catch {unset tagisdesc}
5702 foreach id $allids {
5703 forward_pass $id $allchildren($id)
5704 }
5705 if {$allcommits ne "reading"} {
5706 set travindex [llength $allids]
5707 if {$allcommits ne "traversing"} {
5708 set allcommits "traversing"
5709 after idle restartatags
5710 }
5711 }
5712}
5713
5714proc rereadrefs {} {
5715 global idtags idheads idotherrefs mainhead
5716
5717 set refids [concat [array names idtags] \
5718 [array names idheads] [array names idotherrefs]]
5719 foreach id $refids {
5720 if {![info exists ref($id)]} {
5721 set ref($id) [listrefs $id]
5722 }
5723 }
5724 set oldmainhead $mainhead
5725 readrefs
5726 changedrefs
5727 set refids [lsort -unique [concat $refids [array names idtags] \
5728 [array names idheads] [array names idotherrefs]]]
5729 foreach id $refids {
5730 set v [listrefs $id]
5731 if {![info exists ref($id)] || $ref($id) != $v ||
5732 ($id eq $oldmainhead && $id ne $mainhead) ||
5733 ($id eq $mainhead && $id ne $oldmainhead)} {
5734 redrawtags $id
5735 }
5736 }
5737}
5738
5739proc listrefs {id} {
5740 global idtags idheads idotherrefs
5741
5742 set x {}
5743 if {[info exists idtags($id)]} {
5744 set x $idtags($id)
5745 }
5746 set y {}
5747 if {[info exists idheads($id)]} {
5748 set y $idheads($id)
5749 }
5750 set z {}
5751 if {[info exists idotherrefs($id)]} {
5752 set z $idotherrefs($id)
5753 }
5754 return [list $x $y $z]
5755}
5756
5757proc showtag {tag isnew} {
5758 global ctext tagcontents tagids linknum
5759
5760 if {$isnew} {
5761 addtohistory [list showtag $tag 0]
5762 }
5763 $ctext conf -state normal
5764 clear_ctext
5765 set linknum 0
5766 if {[info exists tagcontents($tag)]} {
5767 set text $tagcontents($tag)
5768 } else {
5769 set text "Tag: $tag\nId: $tagids($tag)"
5770 }
5771 appendwithlinks $text {}
5772 $ctext conf -state disabled
5773 init_flist {}
5774}
5775
5776proc doquit {} {
5777 global stopped
5778 set stopped 100
5779 destroy .
5780}
5781
5782proc doprefs {} {
5783 global maxwidth maxgraphpct diffopts
5784 global oldprefs prefstop showneartags
5785 global bgcolor fgcolor ctext diffcolors
5786
5787 set top .gitkprefs
5788 set prefstop $top
5789 if {[winfo exists $top]} {
5790 raise $top
5791 return
5792 }
5793 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5794 set oldprefs($v) [set $v]
5795 }
5796 toplevel $top
5797 wm title $top "Gitk preferences"
5798 label $top.ldisp -text "Commit list display options"
5799 grid $top.ldisp - -sticky w -pady 10
5800 label $top.spacer -text " "
5801 label $top.maxwidthl -text "Maximum graph width (lines)" \
5802 -font optionfont
5803 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5804 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5805 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5806 -font optionfont
5807 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5808 grid x $top.maxpctl $top.maxpct -sticky w
5809
5810 label $top.ddisp -text "Diff display options"
5811 grid $top.ddisp - -sticky w -pady 10
5812 label $top.diffoptl -text "Options for diff program" \
5813 -font optionfont
5814 entry $top.diffopt -width 20 -textvariable diffopts
5815 grid x $top.diffoptl $top.diffopt -sticky w
5816 frame $top.ntag
5817 label $top.ntag.l -text "Display nearby tags" -font optionfont
5818 checkbutton $top.ntag.b -variable showneartags
5819 pack $top.ntag.b $top.ntag.l -side left
5820 grid x $top.ntag -sticky w
5821
5822 label $top.cdisp -text "Colors: press to choose"
5823 grid $top.cdisp - -sticky w -pady 10
5824 label $top.bg -padx 40 -relief sunk -background $bgcolor
5825 button $top.bgbut -text "Background" -font optionfont \
5826 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5827 grid x $top.bgbut $top.bg -sticky w
5828 label $top.fg -padx 40 -relief sunk -background $fgcolor
5829 button $top.fgbut -text "Foreground" -font optionfont \
5830 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5831 grid x $top.fgbut $top.fg -sticky w
5832 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5833 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5834 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5835 [list $ctext tag conf d0 -foreground]]
5836 grid x $top.diffoldbut $top.diffold -sticky w
5837 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5838 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5839 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5840 [list $ctext tag conf d1 -foreground]]
5841 grid x $top.diffnewbut $top.diffnew -sticky w
5842 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5843 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5844 -command [list choosecolor diffcolors 2 $top.hunksep \
5845 "diff hunk header" \
5846 [list $ctext tag conf hunksep -foreground]]
5847 grid x $top.hunksepbut $top.hunksep -sticky w
5848
5849 frame $top.buts
5850 button $top.buts.ok -text "OK" -command prefsok
5851 button $top.buts.can -text "Cancel" -command prefscan
5852 grid $top.buts.ok $top.buts.can
5853 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5854 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5855 grid $top.buts - - -pady 10 -sticky ew
5856}
5857
5858proc choosecolor {v vi w x cmd} {
5859 global $v
5860
5861 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5862 -title "Gitk: choose color for $x"]
5863 if {$c eq {}} return
5864 $w conf -background $c
5865 lset $v $vi $c
5866 eval $cmd $c
5867}
5868
5869proc setbg {c} {
5870 global bglist
5871
5872 foreach w $bglist {
5873 $w conf -background $c
5874 }
5875}
5876
5877proc setfg {c} {
5878 global fglist canv
5879
5880 foreach w $fglist {
5881 $w conf -foreground $c
5882 }
5883 allcanvs itemconf text -fill $c
5884 $canv itemconf circle -outline $c
5885}
5886
5887proc prefscan {} {
5888 global maxwidth maxgraphpct diffopts
5889 global oldprefs prefstop showneartags
5890
5891 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5892 set $v $oldprefs($v)
5893 }
5894 catch {destroy $prefstop}
5895 unset prefstop
5896}
5897
5898proc prefsok {} {
5899 global maxwidth maxgraphpct
5900 global oldprefs prefstop showneartags
5901
5902 catch {destroy $prefstop}
5903 unset prefstop
5904 if {$maxwidth != $oldprefs(maxwidth)
5905 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5906 redisplay
5907 } elseif {$showneartags != $oldprefs(showneartags)} {
5908 reselectline
5909 }
5910}
5911
5912proc formatdate {d} {
5913 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5914}
5915
5916# This list of encoding names and aliases is distilled from
5917# http://www.iana.org/assignments/character-sets.
5918# Not all of them are supported by Tcl.
5919set encoding_aliases {
5920 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5921 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5922 { ISO-10646-UTF-1 csISO10646UTF1 }
5923 { ISO_646.basic:1983 ref csISO646basic1983 }
5924 { INVARIANT csINVARIANT }
5925 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5926 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5927 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5928 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5929 { NATS-DANO iso-ir-9-1 csNATSDANO }
5930 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5931 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5932 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5933 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5934 { ISO-2022-KR csISO2022KR }
5935 { EUC-KR csEUCKR }
5936 { ISO-2022-JP csISO2022JP }
5937 { ISO-2022-JP-2 csISO2022JP2 }
5938 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5939 csISO13JISC6220jp }
5940 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5941 { IT iso-ir-15 ISO646-IT csISO15Italian }
5942 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5943 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5944 { greek7-old iso-ir-18 csISO18Greek7Old }
5945 { latin-greek iso-ir-19 csISO19LatinGreek }
5946 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5947 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5948 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5949 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5950 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5951 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5952 { INIS iso-ir-49 csISO49INIS }
5953 { INIS-8 iso-ir-50 csISO50INIS8 }
5954 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5955 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5956 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5957 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5958 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5959 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5960 csISO60Norwegian1 }
5961 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5962 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5963 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5964 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5965 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5966 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5967 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5968 { greek7 iso-ir-88 csISO88Greek7 }
5969 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5970 { iso-ir-90 csISO90 }
5971 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5972 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5973 csISO92JISC62991984b }
5974 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5975 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5976 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5977 csISO95JIS62291984handadd }
5978 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5979 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5980 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5981 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5982 CP819 csISOLatin1 }
5983 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5984 { T.61-7bit iso-ir-102 csISO102T617bit }
5985 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5986 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5987 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5988 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5989 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5990 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5991 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5992 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5993 arabic csISOLatinArabic }
5994 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5995 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5996 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5997 greek greek8 csISOLatinGreek }
5998 { T.101-G2 iso-ir-128 csISO128T101G2 }
5999 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6000 csISOLatinHebrew }
6001 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6002 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6003 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6004 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6005 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6006 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6007 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6008 csISOLatinCyrillic }
6009 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6010 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6011 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6012 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6013 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6014 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6015 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6016 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6017 { ISO_10367-box iso-ir-155 csISO10367Box }
6018 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6019 { latin-lap lap iso-ir-158 csISO158Lap }
6020 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6021 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6022 { us-dk csUSDK }
6023 { dk-us csDKUS }
6024 { JIS_X0201 X0201 csHalfWidthKatakana }
6025 { KSC5636 ISO646-KR csKSC5636 }
6026 { ISO-10646-UCS-2 csUnicode }
6027 { ISO-10646-UCS-4 csUCS4 }
6028 { DEC-MCS dec csDECMCS }
6029 { hp-roman8 roman8 r8 csHPRoman8 }
6030 { macintosh mac csMacintosh }
6031 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6032 csIBM037 }
6033 { IBM038 EBCDIC-INT cp038 csIBM038 }
6034 { IBM273 CP273 csIBM273 }
6035 { IBM274 EBCDIC-BE CP274 csIBM274 }
6036 { IBM275 EBCDIC-BR cp275 csIBM275 }
6037 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6038 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6039 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6040 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6041 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6042 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6043 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6044 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6045 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6046 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6047 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6048 { IBM437 cp437 437 csPC8CodePage437 }
6049 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6050 { IBM775 cp775 csPC775Baltic }
6051 { IBM850 cp850 850 csPC850Multilingual }
6052 { IBM851 cp851 851 csIBM851 }
6053 { IBM852 cp852 852 csPCp852 }
6054 { IBM855 cp855 855 csIBM855 }
6055 { IBM857 cp857 857 csIBM857 }
6056 { IBM860 cp860 860 csIBM860 }
6057 { IBM861 cp861 861 cp-is csIBM861 }
6058 { IBM862 cp862 862 csPC862LatinHebrew }
6059 { IBM863 cp863 863 csIBM863 }
6060 { IBM864 cp864 csIBM864 }
6061 { IBM865 cp865 865 csIBM865 }
6062 { IBM866 cp866 866 csIBM866 }
6063 { IBM868 CP868 cp-ar csIBM868 }
6064 { IBM869 cp869 869 cp-gr csIBM869 }
6065 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6066 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6067 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6068 { IBM891 cp891 csIBM891 }
6069 { IBM903 cp903 csIBM903 }
6070 { IBM904 cp904 904 csIBBM904 }
6071 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6072 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6073 { IBM1026 CP1026 csIBM1026 }
6074 { EBCDIC-AT-DE csIBMEBCDICATDE }
6075 { EBCDIC-AT-DE-A csEBCDICATDEA }
6076 { EBCDIC-CA-FR csEBCDICCAFR }
6077 { EBCDIC-DK-NO csEBCDICDKNO }
6078 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6079 { EBCDIC-FI-SE csEBCDICFISE }
6080 { EBCDIC-FI-SE-A csEBCDICFISEA }
6081 { EBCDIC-FR csEBCDICFR }
6082 { EBCDIC-IT csEBCDICIT }
6083 { EBCDIC-PT csEBCDICPT }
6084 { EBCDIC-ES csEBCDICES }
6085 { EBCDIC-ES-A csEBCDICESA }
6086 { EBCDIC-ES-S csEBCDICESS }
6087 { EBCDIC-UK csEBCDICUK }
6088 { EBCDIC-US csEBCDICUS }
6089 { UNKNOWN-8BIT csUnknown8BiT }
6090 { MNEMONIC csMnemonic }
6091 { MNEM csMnem }
6092 { VISCII csVISCII }
6093 { VIQR csVIQR }
6094 { KOI8-R csKOI8R }
6095 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6096 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6097 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6098 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6099 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6100 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6101 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6102 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6103 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6104 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6105 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6106 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6107 { IBM1047 IBM-1047 }
6108 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6109 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6110 { UNICODE-1-1 csUnicode11 }
6111 { CESU-8 csCESU-8 }
6112 { BOCU-1 csBOCU-1 }
6113 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6114 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6115 l8 }
6116 { ISO-8859-15 ISO_8859-15 Latin-9 }
6117 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6118 { GBK CP936 MS936 windows-936 }
6119 { JIS_Encoding csJISEncoding }
6120 { Shift_JIS MS_Kanji csShiftJIS }
6121 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6122 EUC-JP }
6123 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6124 { ISO-10646-UCS-Basic csUnicodeASCII }
6125 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6126 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6127 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6128 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6129 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6130 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6131 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6132 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6133 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6134 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6135 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6136 { Ventura-US csVenturaUS }
6137 { Ventura-International csVenturaInternational }
6138 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6139 { PC8-Turkish csPC8Turkish }
6140 { IBM-Symbols csIBMSymbols }
6141 { IBM-Thai csIBMThai }
6142 { HP-Legal csHPLegal }
6143 { HP-Pi-font csHPPiFont }
6144 { HP-Math8 csHPMath8 }
6145 { Adobe-Symbol-Encoding csHPPSMath }
6146 { HP-DeskTop csHPDesktop }
6147 { Ventura-Math csVenturaMath }
6148 { Microsoft-Publishing csMicrosoftPublishing }
6149 { Windows-31J csWindows31J }
6150 { GB2312 csGB2312 }
6151 { Big5 csBig5 }
6152}
6153
6154proc tcl_encoding {enc} {
6155 global encoding_aliases
6156 set names [encoding names]
6157 set lcnames [string tolower $names]
6158 set enc [string tolower $enc]
6159 set i [lsearch -exact $lcnames $enc]
6160 if {$i < 0} {
6161 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6162 if {[regsub {^iso[-_]} $enc iso encx]} {
6163 set i [lsearch -exact $lcnames $encx]
6164 }
6165 }
6166 if {$i < 0} {
6167 foreach l $encoding_aliases {
6168 set ll [string tolower $l]
6169 if {[lsearch -exact $ll $enc] < 0} continue
6170 # look through the aliases for one that tcl knows about
6171 foreach e $ll {
6172 set i [lsearch -exact $lcnames $e]
6173 if {$i < 0} {
6174 if {[regsub {^iso[-_]} $e iso ex]} {
6175 set i [lsearch -exact $lcnames $ex]
6176 }
6177 }
6178 if {$i >= 0} break
6179 }
6180 break
6181 }
6182 }
6183 if {$i >= 0} {
6184 return [lindex $names $i]
6185 }
6186 return {}
6187}
6188
6189# defaults...
6190set datemode 0
6191set diffopts "-U 5 -p"
6192set wrcomcmd "git diff-tree --stdin -p --pretty"
6193
6194set gitencoding {}
6195catch {
6196 set gitencoding [exec git repo-config --get i18n.commitencoding]
6197}
6198if {$gitencoding == ""} {
6199 set gitencoding "utf-8"
6200}
6201set tclencoding [tcl_encoding $gitencoding]
6202if {$tclencoding == {}} {
6203 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6204}
6205
6206set mainfont {Helvetica 9}
6207set textfont {Courier 9}
6208set uifont {Helvetica 9 bold}
6209set findmergefiles 0
6210set maxgraphpct 50
6211set maxwidth 16
6212set revlistorder 0
6213set fastdate 0
6214set uparrowlen 7
6215set downarrowlen 7
6216set mingaplen 30
6217set cmitmode "patch"
6218set wrapcomment "none"
6219set showneartags 1
6220
6221set colors {green red blue magenta darkgrey brown orange}
6222set bgcolor white
6223set fgcolor black
6224set diffcolors {red "#00a000" blue}
6225
6226catch {source ~/.gitk}
6227
6228font create optionfont -family sans-serif -size -12
6229
6230set revtreeargs {}
6231foreach arg $argv {
6232 switch -regexp -- $arg {
6233 "^$" { }
6234 "^-d" { set datemode 1 }
6235 default {
6236 lappend revtreeargs $arg
6237 }
6238 }
6239}
6240
6241# check that we can find a .git directory somewhere...
6242set gitdir [gitdir]
6243if {![file isdirectory $gitdir]} {
6244 show_error {} . "Cannot find the git directory \"$gitdir\"."
6245 exit 1
6246}
6247
6248set cmdline_files {}
6249set i [lsearch -exact $revtreeargs "--"]
6250if {$i >= 0} {
6251 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6252 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6253} elseif {$revtreeargs ne {}} {
6254 if {[catch {
6255 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6256 set cmdline_files [split $f "\n"]
6257 set n [llength $cmdline_files]
6258 set revtreeargs [lrange $revtreeargs 0 end-$n]
6259 } err]} {
6260 # unfortunately we get both stdout and stderr in $err,
6261 # so look for "fatal:".
6262 set i [string first "fatal:" $err]
6263 if {$i > 0} {
6264 set err [string range $err [expr {$i + 6}] end]
6265 }
6266 show_error {} . "Bad arguments to gitk:\n$err"
6267 exit 1
6268 }
6269}
6270
6271set history {}
6272set historyindex 0
6273set fh_serial 0
6274set nhl_names {}
6275set highlight_paths {}
6276set searchdirn -forwards
6277set boldrows {}
6278set boldnamerows {}
6279
6280set optim_delay 16
6281
6282set nextviewnum 1
6283set curview 0
6284set selectedview 0
6285set selectedhlview None
6286set viewfiles(0) {}
6287set viewperm(0) 0
6288set viewargs(0) {}
6289
6290set cmdlineok 0
6291set stopped 0
6292set stuffsaved 0
6293set patchnum 0
6294setcoords
6295makewindow
6296readrefs
6297
6298if {$cmdline_files ne {} || $revtreeargs ne {}} {
6299 # create a view for the files/dirs specified on the command line
6300 set curview 1
6301 set selectedview 1
6302 set nextviewnum 2
6303 set viewname(1) "Command line"
6304 set viewfiles(1) $cmdline_files
6305 set viewargs(1) $revtreeargs
6306 set viewperm(1) 0
6307 addviewmenu 1
6308 .bar.view entryconf Edit* -state normal
6309 .bar.view entryconf Delete* -state normal
6310}
6311
6312if {[info exists permviews]} {
6313 foreach v $permviews {
6314 set n $nextviewnum
6315 incr nextviewnum
6316 set viewname($n) [lindex $v 0]
6317 set viewfiles($n) [lindex $v 1]
6318 set viewargs($n) [lindex $v 2]
6319 set viewperm($n) 1
6320 addviewmenu $n
6321 }
6322}
6323getcommits