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