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