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