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