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