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