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