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