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