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