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