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