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