|
267
|
1 #!/bin/sh
|
|
|
2 # Tcl ignores the next line -*- tcl -*- \
|
|
|
3 exec wish "$0" -- "${1+$@}"
|
|
|
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
|
|
|
10 # CVS $Revision: 1.20 $
|
|
|
11
|
|
|
12 proc readfullcommits {rargs} {
|
|
|
13 global commits commfd phase canv mainfont curcommit allcommitstate
|
|
|
14 if {$rargs == {}} {
|
|
|
15 set rargs HEAD
|
|
|
16 }
|
|
|
17 set commits {}
|
|
|
18 set curcommit {}
|
|
|
19 set allcommitstate none
|
|
|
20 set phase getcommits
|
|
|
21 if [catch {set commfd [open "|hgit rev-list -c $rargs" r]} err] {
|
|
|
22 puts stderr "Error executing hgit rev-list: $err"
|
|
|
23 exit 1
|
|
|
24 }
|
|
|
25 fconfigure $commfd -blocking 0
|
|
|
26 fileevent $commfd readable "getallcommitline $commfd"
|
|
|
27 $canv delete all
|
|
|
28 $canv create text 3 3 -anchor nw -text "Reading all commits..." \
|
|
|
29 -font $mainfont -tags textitems
|
|
|
30 }
|
|
|
31
|
|
|
32 proc getcommitline {commfd} {
|
|
|
33 global commits parents cdate nparents children nchildren
|
|
|
34 set n [gets $commfd line]
|
|
|
35 if {$n < 0} {
|
|
|
36 if {![eof $commfd]} return
|
|
|
37 # this works around what is apparently a bug in Tcl...
|
|
|
38 fconfigure $commfd -blocking 1
|
|
|
39 if {![catch {close $commfd} err]} {
|
|
|
40 after idle readallcommits
|
|
|
41 return
|
|
|
42 }
|
|
|
43 if {[string range $err 0 4] == "usage"} {
|
|
|
44 set err "\
|
|
|
45 Gitk: error reading commits: bad arguments to hgit rev-list.\n\
|
|
|
46 (Note: arguments to gitk are passed to hgit rev-list\
|
|
|
47 to allow selection of commits to be displayed.)"
|
|
|
48 } else {
|
|
|
49 set err "Error reading commits: $err"
|
|
|
50 }
|
|
|
51 error_popup $err
|
|
|
52 exit 1
|
|
|
53 }
|
|
|
54 if {![regexp {^[0-9a-f]{40}$} $line]} {
|
|
|
55 error_popup "Can't parse hgit rev-tree output: {$line}"
|
|
|
56 exit 1
|
|
|
57 }
|
|
|
58 lappend commits $line
|
|
|
59 }
|
|
|
60
|
|
|
61 proc readallcommits {} {
|
|
|
62 global commits
|
|
|
63 foreach id $commits {
|
|
|
64 readcommit $id
|
|
|
65 update
|
|
|
66 }
|
|
|
67 drawgraph
|
|
|
68 }
|
|
|
69
|
|
|
70 proc readonecommit {id contents} {
|
|
|
71 global commitinfo children nchildren parents nparents cdate
|
|
|
72 set inhdr 1
|
|
|
73 set comment {}
|
|
|
74 set headline {}
|
|
|
75 set auname {}
|
|
|
76 set audate {}
|
|
|
77 set comname {}
|
|
|
78 set comdate {}
|
|
|
79 if {![info exists nchildren($id)]} {
|
|
|
80 set children($id) {}
|
|
|
81 set nchildren($id) 0
|
|
|
82 }
|
|
|
83 set parents($id) {}
|
|
|
84 set nparents($id) 0
|
|
|
85 foreach line [split $contents "\n"] {
|
|
|
86 if {$inhdr} {
|
|
|
87 if {$line == {}} {
|
|
|
88 set inhdr 0
|
|
|
89 } else {
|
|
|
90 set tag [lindex $line 0]
|
|
|
91 if {$tag == "parent"} {
|
|
|
92 set p [lindex $line 1]
|
|
|
93 if {![info exists nchildren($p)]} {
|
|
|
94 set children($p) {}
|
|
|
95 set nchildren($p) 0
|
|
|
96 }
|
|
|
97 lappend parents($id) $p
|
|
|
98 incr nparents($id)
|
|
|
99 if {[lsearch -exact $children($p) $id] < 0} {
|
|
|
100 lappend children($p) $id
|
|
|
101 incr nchildren($p)
|
|
|
102 }
|
|
|
103 } elseif {$tag == "author"} {
|
|
|
104 set x [expr {[llength $line] - 2}]
|
|
|
105 set audate [lindex $line $x]
|
|
|
106 set auname [lrange $line 1 [expr {$x - 1}]]
|
|
|
107 } elseif {$tag == "committer"} {
|
|
|
108 set x [expr {[llength $line] - 2}]
|
|
|
109 set comdate [lindex $line $x]
|
|
|
110 set comname [lrange $line 1 [expr {$x - 1}]]
|
|
|
111 }
|
|
|
112 }
|
|
|
113 } else {
|
|
|
114 if {$comment == {}} {
|
|
|
115 set headline $line
|
|
|
116 } else {
|
|
|
117 append comment "\n"
|
|
|
118 }
|
|
|
119 append comment $line
|
|
|
120 }
|
|
|
121 }
|
|
|
122 if {$audate != {}} {
|
|
|
123 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
|
|
|
124 }
|
|
|
125 if {$comdate != {}} {
|
|
|
126 set cdate($id) $comdate
|
|
|
127 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
|
|
|
128 }
|
|
|
129 set commitinfo($id) [list $headline $auname $audate \
|
|
|
130 $comname $comdate $comment]
|
|
|
131 }
|
|
|
132
|
|
|
133 proc getallcommitline {commfd} {
|
|
|
134 global commits allcommitstate curcommit curcommitid
|
|
|
135 set n [gets $commfd line]
|
|
|
136 set s "\n"
|
|
|
137 if {$n < 0} {
|
|
|
138 if {![eof $commfd]} return
|
|
|
139 # this works around what is apparently a bug in Tcl...
|
|
|
140 fconfigure $commfd -blocking 1
|
|
|
141 if {![catch {close $commfd} err]} {
|
|
|
142 after idle drawgraph
|
|
|
143 return
|
|
|
144 }
|
|
|
145 if {[string range $err 0 4] == "usage"} {
|
|
|
146 set err "\
|
|
|
147 Gitk: error reading commits: bad arguments to hgit rev-list.\n\
|
|
|
148 (Note: arguments to gitk are passed to hgit rev-list\
|
|
|
149 to allow selection of commits to be displayed.)"
|
|
|
150 } else {
|
|
|
151 set err "Error reading commits: $err"
|
|
|
152 }
|
|
|
153 error_popup $err
|
|
|
154 exit 1
|
|
|
155 }
|
|
|
156 if {[string range $line 0 1] != " "} {
|
|
|
157 if {$allcommitstate == "indent"} {
|
|
|
158 readonecommit $curcommitid $curcommit
|
|
|
159 }
|
|
|
160 if {$allcommitstate == "start"} {
|
|
|
161 set curcommit $curcommit$line$s
|
|
|
162 set allcommitstate "indent"
|
|
|
163 } else {
|
|
|
164 set curcommitid $line
|
|
|
165 set curcommit {}
|
|
|
166 set allcommitstate "start"
|
|
|
167 lappend commits $line
|
|
|
168 }
|
|
|
169 } else {
|
|
|
170 set d [string range $line 2 end]
|
|
|
171 set curcommit $curcommit$d$s
|
|
|
172 }
|
|
|
173 }
|
|
|
174
|
|
|
175 proc getcommits {rargs} {
|
|
|
176 global commits commfd phase canv mainfont
|
|
|
177 if {$rargs == {}} {
|
|
|
178 set rargs HEAD
|
|
|
179 }
|
|
|
180 set commits {}
|
|
|
181 set phase getcommits
|
|
|
182 if [catch {set commfd [open "|hgit rev-list $rargs" r]} err] {
|
|
|
183 puts stderr "Error executing hgit rev-list: $err"
|
|
|
184 exit 1
|
|
|
185 }
|
|
|
186 fconfigure $commfd -blocking 0
|
|
|
187 fileevent $commfd readable "getcommitline $commfd"
|
|
|
188 $canv delete all
|
|
|
189 $canv create text 3 3 -anchor nw -text "Reading commits..." \
|
|
|
190 -font $mainfont -tags textitems
|
|
|
191 }
|
|
|
192
|
|
|
193 proc readcommit {id} {
|
|
|
194 global commitinfo children nchildren parents nparents cdate
|
|
|
195 set inhdr 1
|
|
|
196 set comment {}
|
|
|
197 set headline {}
|
|
|
198 set auname {}
|
|
|
199 set audate {}
|
|
|
200 set comname {}
|
|
|
201 set comdate {}
|
|
|
202 if {![info exists nchildren($id)]} {
|
|
|
203 set children($id) {}
|
|
|
204 set nchildren($id) 0
|
|
|
205 }
|
|
|
206 set parents($id) {}
|
|
|
207 set nparents($id) 0
|
|
|
208 if [catch {set contents [exec hgit cat-file commit $id]}] return
|
|
|
209 readonecommit $id $contents
|
|
|
210 }
|
|
|
211
|
|
|
212 proc readrefs {} {
|
|
|
213 global tagids idtags
|
|
|
214 set tags [glob -nocomplain -types f .git/refs/tags/*]
|
|
|
215 foreach f $tags {
|
|
|
216 catch {
|
|
|
217 set fd [open $f r]
|
|
|
218 set line [read $fd]
|
|
|
219 if {[regexp {^[0-9a-f]{40}} $line id]} {
|
|
|
220 set contents [split [exec hgit cat-file tag $id] "\n"]
|
|
|
221 set obj {}
|
|
|
222 set type {}
|
|
|
223 set tag {}
|
|
|
224 foreach l $contents {
|
|
|
225 if {$l == {}} break
|
|
|
226 switch -- [lindex $l 0] {
|
|
|
227 "object" {set obj [lindex $l 1]}
|
|
|
228 "type" {set type [lindex $l 1]}
|
|
|
229 "tag" {set tag [string range $l 4 end]}
|
|
|
230 }
|
|
|
231 }
|
|
|
232 if {$obj != {} && $type == "commit" && $tag != {}} {
|
|
|
233 set tagids($tag) $obj
|
|
|
234 lappend idtags($obj) $tag
|
|
|
235 }
|
|
|
236 }
|
|
|
237 }
|
|
|
238 }
|
|
|
239 }
|
|
|
240
|
|
|
241 proc error_popup msg {
|
|
|
242 set w .error
|
|
|
243 toplevel $w
|
|
|
244 wm transient $w .
|
|
|
245 message $w.m -text $msg -justify center -aspect 400
|
|
|
246 pack $w.m -side top -fill x -padx 20 -pady 20
|
|
|
247 button $w.ok -text OK -command "destroy $w"
|
|
|
248 pack $w.ok -side bottom -fill x
|
|
|
249 bind $w <Visibility> "grab $w; focus $w"
|
|
|
250 tkwait window $w
|
|
|
251 }
|
|
|
252
|
|
|
253 proc makewindow {} {
|
|
|
254 global canv canv2 canv3 linespc charspc ctext cflist textfont
|
|
|
255 global findtype findloc findstring fstring geometry
|
|
|
256 global entries sha1entry sha1string sha1but
|
|
|
257
|
|
|
258 menu .bar
|
|
|
259 .bar add cascade -label "File" -menu .bar.file
|
|
|
260 menu .bar.file
|
|
|
261 .bar.file add command -label "Quit" -command doquit
|
|
|
262 menu .bar.help
|
|
|
263 .bar add cascade -label "Help" -menu .bar.help
|
|
|
264 .bar.help add command -label "About gitk" -command about
|
|
|
265 . configure -menu .bar
|
|
|
266
|
|
|
267 if {![info exists geometry(canv1)]} {
|
|
|
268 set geometry(canv1) [expr 45 * $charspc]
|
|
|
269 set geometry(canv2) [expr 30 * $charspc]
|
|
|
270 set geometry(canv3) [expr 15 * $charspc]
|
|
|
271 set geometry(canvh) [expr 25 * $linespc + 4]
|
|
|
272 set geometry(ctextw) 80
|
|
|
273 set geometry(ctexth) 30
|
|
|
274 set geometry(cflistw) 30
|
|
|
275 }
|
|
|
276 panedwindow .ctop -orient vertical
|
|
|
277 if {[info exists geometry(width)]} {
|
|
|
278 .ctop conf -width $geometry(width) -height $geometry(height)
|
|
|
279 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
|
|
|
280 set geometry(ctexth) [expr {($texth - 8) /
|
|
|
281 [font metrics $textfont -linespace]}]
|
|
|
282 }
|
|
|
283 frame .ctop.top
|
|
|
284 frame .ctop.top.bar
|
|
|
285 pack .ctop.top.bar -side bottom -fill x
|
|
|
286 set cscroll .ctop.top.csb
|
|
|
287 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
|
|
|
288 pack $cscroll -side right -fill y
|
|
|
289 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
|
|
|
290 pack .ctop.top.clist -side top -fill both -expand 1
|
|
|
291 .ctop add .ctop.top
|
|
|
292 set canv .ctop.top.clist.canv
|
|
|
293 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
|
|
|
294 -bg white -bd 0 \
|
|
|
295 -yscrollincr $linespc -yscrollcommand "$cscroll set"
|
|
|
296 .ctop.top.clist add $canv
|
|
|
297 set canv2 .ctop.top.clist.canv2
|
|
|
298 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
|
|
|
299 -bg white -bd 0 -yscrollincr $linespc
|
|
|
300 .ctop.top.clist add $canv2
|
|
|
301 set canv3 .ctop.top.clist.canv3
|
|
|
302 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
|
|
|
303 -bg white -bd 0 -yscrollincr $linespc
|
|
|
304 .ctop.top.clist add $canv3
|
|
|
305 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
|
|
|
306
|
|
|
307 set sha1entry .ctop.top.bar.sha1
|
|
|
308 set entries $sha1entry
|
|
|
309 set sha1but .ctop.top.bar.sha1label
|
|
|
310 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
|
|
|
311 -command gotocommit -width 8
|
|
|
312 $sha1but conf -disabledforeground [$sha1but cget -foreground]
|
|
|
313 pack .ctop.top.bar.sha1label -side left
|
|
|
314 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
|
|
|
315 trace add variable sha1string write sha1change
|
|
|
316 pack $sha1entry -side left -pady 2
|
|
|
317 button .ctop.top.bar.findbut -text "Find" -command dofind
|
|
|
318 pack .ctop.top.bar.findbut -side left
|
|
|
319 set findstring {}
|
|
|
320 set fstring .ctop.top.bar.findstring
|
|
|
321 lappend entries $fstring
|
|
|
322 entry $fstring -width 30 -font $textfont -textvariable findstring
|
|
|
323 pack $fstring -side left -expand 1 -fill x
|
|
|
324 set findtype Exact
|
|
|
325 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
|
|
|
326 set findloc "All fields"
|
|
|
327 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
|
|
|
328 Comments Author Committer
|
|
|
329 pack .ctop.top.bar.findloc -side right
|
|
|
330 pack .ctop.top.bar.findtype -side right
|
|
|
331
|
|
|
332 panedwindow .ctop.cdet -orient horizontal
|
|
|
333 .ctop add .ctop.cdet
|
|
|
334 frame .ctop.cdet.left
|
|
|
335 set ctext .ctop.cdet.left.ctext
|
|
|
336 text $ctext -bg white -state disabled -font $textfont \
|
|
|
337 -width $geometry(ctextw) -height $geometry(ctexth) \
|
|
|
338 -yscrollcommand ".ctop.cdet.left.sb set"
|
|
|
339 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
|
|
|
340 pack .ctop.cdet.left.sb -side right -fill y
|
|
|
341 pack $ctext -side left -fill both -expand 1
|
|
|
342 .ctop.cdet add .ctop.cdet.left
|
|
|
343
|
|
|
344 $ctext tag conf filesep -font [concat $textfont bold]
|
|
|
345 $ctext tag conf hunksep -back blue -fore white
|
|
|
346 $ctext tag conf d0 -back "#ff8080"
|
|
|
347 $ctext tag conf d1 -back green
|
|
|
348 $ctext tag conf found -back yellow
|
|
|
349
|
|
|
350 frame .ctop.cdet.right
|
|
|
351 set cflist .ctop.cdet.right.cfiles
|
|
|
352 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
|
|
|
353 -yscrollcommand ".ctop.cdet.right.sb set"
|
|
|
354 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
|
|
|
355 pack .ctop.cdet.right.sb -side right -fill y
|
|
|
356 pack $cflist -side left -fill both -expand 1
|
|
|
357 .ctop.cdet add .ctop.cdet.right
|
|
|
358 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
|
|
|
359
|
|
|
360 pack .ctop -side top -fill both -expand 1
|
|
|
361
|
|
|
362 bindall <1> {selcanvline %x %y}
|
|
|
363 bindall <B1-Motion> {selcanvline %x %y}
|
|
|
364 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
|
|
|
365 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
|
|
|
366 bindall <2> "allcanvs scan mark 0 %y"
|
|
|
367 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
|
|
|
368 bind . <Key-Up> "selnextline -1"
|
|
|
369 bind . <Key-Down> "selnextline 1"
|
|
|
370 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
|
|
|
371 bind . <Key-Next> "allcanvs yview scroll 1 pages"
|
|
|
372 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
|
|
|
373 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
|
|
|
374 bindkey <Key-space> "$ctext yview scroll 1 pages"
|
|
|
375 bindkey p "selnextline -1"
|
|
|
376 bindkey n "selnextline 1"
|
|
|
377 bindkey b "$ctext yview scroll -1 pages"
|
|
|
378 bindkey d "$ctext yview scroll 18 units"
|
|
|
379 bindkey u "$ctext yview scroll -18 units"
|
|
|
380 bindkey / findnext
|
|
|
381 bindkey ? findprev
|
|
|
382 bindkey f nextfile
|
|
|
383 bind . <Control-q> doquit
|
|
|
384 bind . <Control-f> dofind
|
|
|
385 bind . <Control-g> findnext
|
|
|
386 bind . <Control-r> findprev
|
|
|
387 bind . <Control-equal> {incrfont 1}
|
|
|
388 bind . <Control-KP_Add> {incrfont 1}
|
|
|
389 bind . <Control-minus> {incrfont -1}
|
|
|
390 bind . <Control-KP_Subtract> {incrfont -1}
|
|
|
391 bind $cflist <<ListboxSelect>> listboxsel
|
|
|
392 bind . <Destroy> {savestuff %W}
|
|
|
393 bind . <Button-1> "click %W"
|
|
|
394 bind $fstring <Key-Return> dofind
|
|
|
395 bind $sha1entry <Key-Return> gotocommit
|
|
|
396 }
|
|
|
397
|
|
|
398 # when we make a key binding for the toplevel, make sure
|
|
|
399 # it doesn't get triggered when that key is pressed in the
|
|
|
400 # find string entry widget.
|
|
|
401 proc bindkey {ev script} {
|
|
|
402 global entries
|
|
|
403 bind . $ev $script
|
|
|
404 set escript [bind Entry $ev]
|
|
|
405 if {$escript == {}} {
|
|
|
406 set escript [bind Entry <Key>]
|
|
|
407 }
|
|
|
408 foreach e $entries {
|
|
|
409 bind $e $ev "$escript; break"
|
|
|
410 }
|
|
|
411 }
|
|
|
412
|
|
|
413 # set the focus back to the toplevel for any click outside
|
|
|
414 # the entry widgets
|
|
|
415 proc click {w} {
|
|
|
416 global entries
|
|
|
417 foreach e $entries {
|
|
|
418 if {$w == $e} return
|
|
|
419 }
|
|
|
420 focus .
|
|
|
421 }
|
|
|
422
|
|
|
423 proc savestuff {w} {
|
|
|
424 global canv canv2 canv3 ctext cflist mainfont textfont
|
|
|
425 global stuffsaved
|
|
|
426 if {$stuffsaved} return
|
|
|
427 if {![winfo viewable .]} return
|
|
|
428 catch {
|
|
|
429 set f [open "~/.gitk-new" w]
|
|
|
430 puts $f "set mainfont {$mainfont}"
|
|
|
431 puts $f "set textfont {$textfont}"
|
|
|
432 puts $f "set geometry(width) [winfo width .ctop]"
|
|
|
433 puts $f "set geometry(height) [winfo height .ctop]"
|
|
|
434 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
|
|
|
435 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
|
|
|
436 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
|
|
|
437 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
|
|
|
438 set wid [expr {([winfo width $ctext] - 8) \
|
|
|
439 / [font measure $textfont "0"]}]
|
|
|
440 puts $f "set geometry(ctextw) $wid"
|
|
|
441 set wid [expr {([winfo width $cflist] - 11) \
|
|
|
442 / [font measure [$cflist cget -font] "0"]}]
|
|
|
443 puts $f "set geometry(cflistw) $wid"
|
|
|
444 close $f
|
|
|
445 file rename -force "~/.gitk-new" "~/.gitk"
|
|
|
446 }
|
|
|
447 set stuffsaved 1
|
|
|
448 }
|
|
|
449
|
|
|
450 proc resizeclistpanes {win w} {
|
|
|
451 global oldwidth
|
|
|
452 if [info exists oldwidth($win)] {
|
|
|
453 set s0 [$win sash coord 0]
|
|
|
454 set s1 [$win sash coord 1]
|
|
|
455 if {$w < 60} {
|
|
|
456 set sash0 [expr {int($w/2 - 2)}]
|
|
|
457 set sash1 [expr {int($w*5/6 - 2)}]
|
|
|
458 } else {
|
|
|
459 set factor [expr {1.0 * $w / $oldwidth($win)}]
|
|
|
460 set sash0 [expr {int($factor * [lindex $s0 0])}]
|
|
|
461 set sash1 [expr {int($factor * [lindex $s1 0])}]
|
|
|
462 if {$sash0 < 30} {
|
|
|
463 set sash0 30
|
|
|
464 }
|
|
|
465 if {$sash1 < $sash0 + 20} {
|
|
|
466 set sash1 [expr $sash0 + 20]
|
|
|
467 }
|
|
|
468 if {$sash1 > $w - 10} {
|
|
|
469 set sash1 [expr $w - 10]
|
|
|
470 if {$sash0 > $sash1 - 20} {
|
|
|
471 set sash0 [expr $sash1 - 20]
|
|
|
472 }
|
|
|
473 }
|
|
|
474 }
|
|
|
475 $win sash place 0 $sash0 [lindex $s0 1]
|
|
|
476 $win sash place 1 $sash1 [lindex $s1 1]
|
|
|
477 }
|
|
|
478 set oldwidth($win) $w
|
|
|
479 }
|
|
|
480
|
|
|
481 proc resizecdetpanes {win w} {
|
|
|
482 global oldwidth
|
|
|
483 if [info exists oldwidth($win)] {
|
|
|
484 set s0 [$win sash coord 0]
|
|
|
485 if {$w < 60} {
|
|
|
486 set sash0 [expr {int($w*3/4 - 2)}]
|
|
|
487 } else {
|
|
|
488 set factor [expr {1.0 * $w / $oldwidth($win)}]
|
|
|
489 set sash0 [expr {int($factor * [lindex $s0 0])}]
|
|
|
490 if {$sash0 < 45} {
|
|
|
491 set sash0 45
|
|
|
492 }
|
|
|
493 if {$sash0 > $w - 15} {
|
|
|
494 set sash0 [expr $w - 15]
|
|
|
495 }
|
|
|
496 }
|
|
|
497 $win sash place 0 $sash0 [lindex $s0 1]
|
|
|
498 }
|
|
|
499 set oldwidth($win) $w
|
|
|
500 }
|
|
|
501
|
|
|
502 proc allcanvs args {
|
|
|
503 global canv canv2 canv3
|
|
|
504 eval $canv $args
|
|
|
505 eval $canv2 $args
|
|
|
506 eval $canv3 $args
|
|
|
507 }
|
|
|
508
|
|
|
509 proc bindall {event action} {
|
|
|
510 global canv canv2 canv3
|
|
|
511 bind $canv $event $action
|
|
|
512 bind $canv2 $event $action
|
|
|
513 bind $canv3 $event $action
|
|
|
514 }
|
|
|
515
|
|
|
516 proc about {} {
|
|
|
517 set w .about
|
|
|
518 if {[winfo exists $w]} {
|
|
|
519 raise $w
|
|
|
520 return
|
|
|
521 }
|
|
|
522 toplevel $w
|
|
|
523 wm title $w "About gitk"
|
|
|
524 message $w.m -text {
|
|
|
525 Gitk version 1.1
|
|
|
526
|
|
|
527 Copyright © 2005 Paul Mackerras
|
|
|
528
|
|
|
529 Use and redistribute under the terms of the GNU General Public License
|
|
|
530
|
|
|
531 (CVS $Revision: 1.20 $)} \
|
|
|
532 -justify center -aspect 400
|
|
|
533 pack $w.m -side top -fill x -padx 20 -pady 20
|
|
|
534 button $w.ok -text Close -command "destroy $w"
|
|
|
535 pack $w.ok -side bottom
|
|
|
536 }
|
|
|
537
|
|
|
538 proc truncatetofit {str width font} {
|
|
|
539 if {[font measure $font $str] <= $width} {
|
|
|
540 return $str
|
|
|
541 }
|
|
|
542 set best 0
|
|
|
543 set bad [string length $str]
|
|
|
544 set tmp $str
|
|
|
545 while {$best < $bad - 1} {
|
|
|
546 set try [expr {int(($best + $bad) / 2)}]
|
|
|
547 set tmp "[string range $str 0 [expr $try-1]]..."
|
|
|
548 if {[font measure $font $tmp] <= $width} {
|
|
|
549 set best $try
|
|
|
550 } else {
|
|
|
551 set bad $try
|
|
|
552 }
|
|
|
553 }
|
|
|
554 return $tmp
|
|
|
555 }
|
|
|
556
|
|
|
557 proc assigncolor {id} {
|
|
|
558 global commitinfo colormap commcolors colors nextcolor
|
|
|
559 global colorbycommitter
|
|
|
560 global parents nparents children nchildren
|
|
|
561 if [info exists colormap($id)] return
|
|
|
562 set ncolors [llength $colors]
|
|
|
563 if {$colorbycommitter} {
|
|
|
564 if {![info exists commitinfo($id)]} {
|
|
|
565 readcommit $id
|
|
|
566 }
|
|
|
567 set comm [lindex $commitinfo($id) 3]
|
|
|
568 if {![info exists commcolors($comm)]} {
|
|
|
569 set commcolors($comm) [lindex $colors $nextcolor]
|
|
|
570 if {[incr nextcolor] >= $ncolors} {
|
|
|
571 set nextcolor 0
|
|
|
572 }
|
|
|
573 }
|
|
|
574 set colormap($id) $commcolors($comm)
|
|
|
575 } else {
|
|
|
576 if {$nparents($id) == 1 && $nchildren($id) == 1} {
|
|
|
577 set child [lindex $children($id) 0]
|
|
|
578 if {[info exists colormap($child)]
|
|
|
579 && $nparents($child) == 1} {
|
|
|
580 set colormap($id) $colormap($child)
|
|
|
581 return
|
|
|
582 }
|
|
|
583 }
|
|
|
584 set badcolors {}
|
|
|
585 foreach child $children($id) {
|
|
|
586 if {[info exists colormap($child)]
|
|
|
587 && [lsearch -exact $badcolors $colormap($child)] < 0} {
|
|
|
588 lappend badcolors $colormap($child)
|
|
|
589 }
|
|
|
590 if {[info exists parents($child)]} {
|
|
|
591 foreach p $parents($child) {
|
|
|
592 if {[info exists colormap($p)]
|
|
|
593 && [lsearch -exact $badcolors $colormap($p)] < 0} {
|
|
|
594 lappend badcolors $colormap($p)
|
|
|
595 }
|
|
|
596 }
|
|
|
597 }
|
|
|
598 }
|
|
|
599 if {[llength $badcolors] >= $ncolors} {
|
|
|
600 set badcolors {}
|
|
|
601 }
|
|
|
602 for {set i 0} {$i <= $ncolors} {incr i} {
|
|
|
603 set c [lindex $colors $nextcolor]
|
|
|
604 if {[incr nextcolor] >= $ncolors} {
|
|
|
605 set nextcolor 0
|
|
|
606 }
|
|
|
607 if {[lsearch -exact $badcolors $c]} break
|
|
|
608 }
|
|
|
609 set colormap($id) $c
|
|
|
610 }
|
|
|
611 }
|
|
|
612
|
|
|
613 proc drawgraph {} {
|
|
|
614 global parents children nparents nchildren commits
|
|
|
615 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
|
|
|
616 global datemode cdate
|
|
|
617 global lineid linehtag linentag linedtag commitinfo
|
|
|
618 global nextcolor colormap numcommits
|
|
|
619 global stopped phase redisplaying selectedline idtags idline
|
|
|
620
|
|
|
621 allcanvs delete all
|
|
|
622 set start {}
|
|
|
623 foreach id [array names nchildren] {
|
|
|
624 if {$nchildren($id) == 0} {
|
|
|
625 lappend start $id
|
|
|
626 }
|
|
|
627 set ncleft($id) $nchildren($id)
|
|
|
628 if {![info exists nparents($id)]} {
|
|
|
629 set nparents($id) 0
|
|
|
630 }
|
|
|
631 }
|
|
|
632 if {$start == {}} {
|
|
|
633 error_popup "Gitk: ERROR: No starting commits found"
|
|
|
634 exit 1
|
|
|
635 }
|
|
|
636
|
|
|
637 set nextcolor 0
|
|
|
638 foreach id $start {
|
|
|
639 assigncolor $id
|
|
|
640 }
|
|
|
641 set todo $start
|
|
|
642 set level [expr [llength $todo] - 1]
|
|
|
643 set y2 $canvy0
|
|
|
644 set nullentry -1
|
|
|
645 set lineno -1
|
|
|
646 set numcommits 0
|
|
|
647 set phase drawgraph
|
|
|
648 set lthickness [expr {($linespc / 9) + 1}]
|
|
|
649 while 1 {
|
|
|
650 set canvy $y2
|
|
|
651 allcanvs conf -scrollregion \
|
|
|
652 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
|
|
|
653 update
|
|
|
654 if {$stopped} break
|
|
|
655 incr numcommits
|
|
|
656 incr lineno
|
|
|
657 set nlines [llength $todo]
|
|
|
658 set id [lindex $todo $level]
|
|
|
659 set lineid($lineno) $id
|
|
|
660 set idline($id) $lineno
|
|
|
661 set actualparents {}
|
|
|
662 set ofill white
|
|
|
663 if {[info exists parents($id)]} {
|
|
|
664 foreach p $parents($id) {
|
|
|
665 if {[info exists ncleft($p)]} {
|
|
|
666 incr ncleft($p) -1
|
|
|
667 if {![info exists commitinfo($p)]} {
|
|
|
668 readcommit $p
|
|
|
669 if {![info exists commitinfo($p)]} continue
|
|
|
670 }
|
|
|
671 lappend actualparents $p
|
|
|
672 set ofill blue
|
|
|
673 }
|
|
|
674 }
|
|
|
675 }
|
|
|
676 if {![info exists commitinfo($id)]} {
|
|
|
677 readcommit $id
|
|
|
678 if {![info exists commitinfo($id)]} {
|
|
|
679 set commitinfo($id) {"No commit information available"}
|
|
|
680 }
|
|
|
681 }
|
|
|
682 set x [expr $canvx0 + $level * $linespc]
|
|
|
683 set y2 [expr $canvy + $linespc]
|
|
|
684 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
|
|
|
685 set t [$canv create line $x $linestarty($level) $x $canvy \
|
|
|
686 -width $lthickness -fill $colormap($id)]
|
|
|
687 $canv lower $t
|
|
|
688 }
|
|
|
689 set linestarty($level) $canvy
|
|
|
690 set orad [expr {$linespc / 3}]
|
|
|
691 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
|
|
|
692 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
|
|
|
693 -fill $ofill -outline black -width 1]
|
|
|
694 $canv raise $t
|
|
|
695 set xt [expr $canvx0 + $nlines * $linespc]
|
|
|
696 if {$nparents($id) > 2} {
|
|
|
697 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
|
|
|
698 }
|
|
|
699 if {[info exists idtags($id)] && $idtags($id) != {}} {
|
|
|
700 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
|
|
|
701 set yt [expr $canvy - 0.5 * $linespc]
|
|
|
702 set yb [expr $yt + $linespc - 1]
|
|
|
703 set xvals {}
|
|
|
704 set wvals {}
|
|
|
705 foreach tag $idtags($id) {
|
|
|
706 set wid [font measure $mainfont $tag]
|
|
|
707 lappend xvals $xt
|
|
|
708 lappend wvals $wid
|
|
|
709 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
|
|
|
710 }
|
|
|
711 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \
|
|
|
712 -width $lthickness -fill black]
|
|
|
713 $canv lower $t
|
|
|
714 foreach tag $idtags($id) x $xvals wid $wvals {
|
|
|
715 set xl [expr $x + $delta]
|
|
|
716 set xr [expr $x + $delta + $wid + $lthickness]
|
|
|
717 $canv create polygon $x [expr $yt + $delta] $xl $yt\
|
|
|
718 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
|
|
|
719 -width 1 -outline black -fill yellow
|
|
|
720 $canv create text $xl $canvy -anchor w -text $tag \
|
|
|
721 -font $mainfont
|
|
|
722 }
|
|
|
723 }
|
|
|
724 set headline [lindex $commitinfo($id) 0]
|
|
|
725 set name [lindex $commitinfo($id) 1]
|
|
|
726 set date [lindex $commitinfo($id) 2]
|
|
|
727 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
|
|
|
728 -text $headline -font $mainfont ]
|
|
|
729 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
|
|
|
730 -text $name -font $namefont]
|
|
|
731 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
|
|
|
732 -text $date -font $mainfont]
|
|
|
733 if {!$datemode && [llength $actualparents] == 1} {
|
|
|
734 set p [lindex $actualparents 0]
|
|
|
735 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
|
|
|
736 assigncolor $p
|
|
|
737 set todo [lreplace $todo $level $level $p]
|
|
|
738 continue
|
|
|
739 }
|
|
|
740 }
|
|
|
741
|
|
|
742 set oldtodo $todo
|
|
|
743 set oldlevel $level
|
|
|
744 set lines {}
|
|
|
745 for {set i 0} {$i < $nlines} {incr i} {
|
|
|
746 if {[lindex $todo $i] == {}} continue
|
|
|
747 if {[info exists linestarty($i)]} {
|
|
|
748 set oldstarty($i) $linestarty($i)
|
|
|
749 unset linestarty($i)
|
|
|
750 }
|
|
|
751 if {$i != $level} {
|
|
|
752 lappend lines [list $i [lindex $todo $i]]
|
|
|
753 }
|
|
|
754 }
|
|
|
755 if {$nullentry >= 0} {
|
|
|
756 set todo [lreplace $todo $nullentry $nullentry]
|
|
|
757 if {$nullentry < $level} {
|
|
|
758 incr level -1
|
|
|
759 }
|
|
|
760 }
|
|
|
761
|
|
|
762 set todo [lreplace $todo $level $level]
|
|
|
763 if {$nullentry > $level} {
|
|
|
764 incr nullentry -1
|
|
|
765 }
|
|
|
766 set i $level
|
|
|
767 foreach p $actualparents {
|
|
|
768 set k [lsearch -exact $todo $p]
|
|
|
769 if {$k < 0} {
|
|
|
770 assigncolor $p
|
|
|
771 set todo [linsert $todo $i $p]
|
|
|
772 if {$nullentry >= $i} {
|
|
|
773 incr nullentry
|
|
|
774 }
|
|
|
775 incr i
|
|
|
776 }
|
|
|
777 lappend lines [list $oldlevel $p]
|
|
|
778 }
|
|
|
779
|
|
|
780 # choose which one to do next time around
|
|
|
781 set todol [llength $todo]
|
|
|
782 set level -1
|
|
|
783 set latest {}
|
|
|
784 for {set k $todol} {[incr k -1] >= 0} {} {
|
|
|
785 set p [lindex $todo $k]
|
|
|
786 if {$p == {}} continue
|
|
|
787 if {$ncleft($p) == 0} {
|
|
|
788 if {$datemode} {
|
|
|
789 if {$latest == {} || $cdate($p) > $latest} {
|
|
|
790 set level $k
|
|
|
791 set latest $cdate($p)
|
|
|
792 }
|
|
|
793 } else {
|
|
|
794 set level $k
|
|
|
795 break
|
|
|
796 }
|
|
|
797 }
|
|
|
798 }
|
|
|
799 if {$level < 0} {
|
|
|
800 if {$todo != {}} {
|
|
|
801 puts "ERROR: none of the pending commits can be done yet:"
|
|
|
802 foreach p $todo {
|
|
|
803 puts " $p"
|
|
|
804 }
|
|
|
805 }
|
|
|
806 break
|
|
|
807 }
|
|
|
808
|
|
|
809 # If we are reducing, put in a null entry
|
|
|
810 if {$todol < $nlines} {
|
|
|
811 if {$nullentry >= 0} {
|
|
|
812 set i $nullentry
|
|
|
813 while {$i < $todol
|
|
|
814 && [lindex $oldtodo $i] == [lindex $todo $i]} {
|
|
|
815 incr i
|
|
|
816 }
|
|
|
817 } else {
|
|
|
818 set i $oldlevel
|
|
|
819 if {$level >= $i} {
|
|
|
820 incr i
|
|
|
821 }
|
|
|
822 }
|
|
|
823 if {$i >= $todol} {
|
|
|
824 set nullentry -1
|
|
|
825 } else {
|
|
|
826 set nullentry $i
|
|
|
827 set todo [linsert $todo $nullentry {}]
|
|
|
828 if {$level >= $i} {
|
|
|
829 incr level
|
|
|
830 }
|
|
|
831 }
|
|
|
832 } else {
|
|
|
833 set nullentry -1
|
|
|
834 }
|
|
|
835
|
|
|
836 foreach l $lines {
|
|
|
837 set i [lindex $l 0]
|
|
|
838 set dst [lindex $l 1]
|
|
|
839 set j [lsearch -exact $todo $dst]
|
|
|
840 if {$i == $j} {
|
|
|
841 if {[info exists oldstarty($i)]} {
|
|
|
842 set linestarty($i) $oldstarty($i)
|
|
|
843 }
|
|
|
844 continue
|
|
|
845 }
|
|
|
846 set xi [expr {$canvx0 + $i * $linespc}]
|
|
|
847 set xj [expr {$canvx0 + $j * $linespc}]
|
|
|
848 set coords {}
|
|
|
849 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
|
|
|
850 lappend coords $xi $oldstarty($i)
|
|
|
851 }
|
|
|
852 lappend coords $xi $canvy
|
|
|
853 if {$j < $i - 1} {
|
|
|
854 lappend coords [expr $xj + $linespc] $canvy
|
|
|
855 } elseif {$j > $i + 1} {
|
|
|
856 lappend coords [expr $xj - $linespc] $canvy
|
|
|
857 }
|
|
|
858 lappend coords $xj $y2
|
|
|
859 set t [$canv create line $coords -width $lthickness \
|
|
|
860 -fill $colormap($dst)]
|
|
|
861 $canv lower $t
|
|
|
862 if {![info exists linestarty($j)]} {
|
|
|
863 set linestarty($j) $y2
|
|
|
864 }
|
|
|
865 }
|
|
|
866 }
|
|
|
867 set phase {}
|
|
|
868 if {$redisplaying} {
|
|
|
869 if {$stopped == 0 && [info exists selectedline]} {
|
|
|
870 selectline $selectedline
|
|
|
871 }
|
|
|
872 if {$stopped == 1} {
|
|
|
873 set stopped 0
|
|
|
874 after idle drawgraph
|
|
|
875 } else {
|
|
|
876 set redisplaying 0
|
|
|
877 }
|
|
|
878 }
|
|
|
879 }
|
|
|
880
|
|
|
881 proc findmatches {f} {
|
|
|
882 global findtype foundstring foundstrlen
|
|
|
883 if {$findtype == "Regexp"} {
|
|
|
884 set matches [regexp -indices -all -inline $foundstring $f]
|
|
|
885 } else {
|
|
|
886 if {$findtype == "IgnCase"} {
|
|
|
887 set str [string tolower $f]
|
|
|
888 } else {
|
|
|
889 set str $f
|
|
|
890 }
|
|
|
891 set matches {}
|
|
|
892 set i 0
|
|
|
893 while {[set j [string first $foundstring $str $i]] >= 0} {
|
|
|
894 lappend matches [list $j [expr $j+$foundstrlen-1]]
|
|
|
895 set i [expr $j + $foundstrlen]
|
|
|
896 }
|
|
|
897 }
|
|
|
898 return $matches
|
|
|
899 }
|
|
|
900
|
|
|
901 proc dofind {} {
|
|
|
902 global findtype findloc findstring markedmatches commitinfo
|
|
|
903 global numcommits lineid linehtag linentag linedtag
|
|
|
904 global mainfont namefont canv canv2 canv3 selectedline
|
|
|
905 global matchinglines foundstring foundstrlen idtags
|
|
|
906 unmarkmatches
|
|
|
907 focus .
|
|
|
908 set matchinglines {}
|
|
|
909 set fldtypes {Headline Author Date Committer CDate Comment}
|
|
|
910 if {$findtype == "IgnCase"} {
|
|
|
911 set foundstring [string tolower $findstring]
|
|
|
912 } else {
|
|
|
913 set foundstring $findstring
|
|
|
914 }
|
|
|
915 set foundstrlen [string length $findstring]
|
|
|
916 if {$foundstrlen == 0} return
|
|
|
917 if {![info exists selectedline]} {
|
|
|
918 set oldsel -1
|
|
|
919 } else {
|
|
|
920 set oldsel $selectedline
|
|
|
921 }
|
|
|
922 set didsel 0
|
|
|
923 for {set l 0} {$l < $numcommits} {incr l} {
|
|
|
924 set id $lineid($l)
|
|
|
925 set info $commitinfo($id)
|
|
|
926 set doesmatch 0
|
|
|
927 foreach f $info ty $fldtypes {
|
|
|
928 if {$findloc != "All fields" && $findloc != $ty} {
|
|
|
929 continue
|
|
|
930 }
|
|
|
931 set matches [findmatches $f]
|
|
|
932 if {$matches == {}} continue
|
|
|
933 set doesmatch 1
|
|
|
934 if {$ty == "Headline"} {
|
|
|
935 markmatches $canv $l $f $linehtag($l) $matches $mainfont
|
|
|
936 } elseif {$ty == "Author"} {
|
|
|
937 markmatches $canv2 $l $f $linentag($l) $matches $namefont
|
|
|
938 } elseif {$ty == "Date"} {
|
|
|
939 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
|
|
|
940 }
|
|
|
941 }
|
|
|
942 if {$doesmatch} {
|
|
|
943 lappend matchinglines $l
|
|
|
944 if {!$didsel && $l > $oldsel} {
|
|
|
945 findselectline $l
|
|
|
946 set didsel 1
|
|
|
947 }
|
|
|
948 }
|
|
|
949 }
|
|
|
950 if {$matchinglines == {}} {
|
|
|
951 bell
|
|
|
952 } elseif {!$didsel} {
|
|
|
953 findselectline [lindex $matchinglines 0]
|
|
|
954 }
|
|
|
955 }
|
|
|
956
|
|
|
957 proc findselectline {l} {
|
|
|
958 global findloc commentend ctext
|
|
|
959 selectline $l
|
|
|
960 if {$findloc == "All fields" || $findloc == "Comments"} {
|
|
|
961 # highlight the matches in the comments
|
|
|
962 set f [$ctext get 1.0 $commentend]
|
|
|
963 set matches [findmatches $f]
|
|
|
964 foreach match $matches {
|
|
|
965 set start [lindex $match 0]
|
|
|
966 set end [expr [lindex $match 1] + 1]
|
|
|
967 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
|
|
|
968 }
|
|
|
969 }
|
|
|
970 }
|
|
|
971
|
|
|
972 proc findnext {} {
|
|
|
973 global matchinglines selectedline
|
|
|
974 if {![info exists matchinglines]} {
|
|
|
975 dofind
|
|
|
976 return
|
|
|
977 }
|
|
|
978 if {![info exists selectedline]} return
|
|
|
979 foreach l $matchinglines {
|
|
|
980 if {$l > $selectedline} {
|
|
|
981 findselectline $l
|
|
|
982 return
|
|
|
983 }
|
|
|
984 }
|
|
|
985 bell
|
|
|
986 }
|
|
|
987
|
|
|
988 proc findprev {} {
|
|
|
989 global matchinglines selectedline
|
|
|
990 if {![info exists matchinglines]} {
|
|
|
991 dofind
|
|
|
992 return
|
|
|
993 }
|
|
|
994 if {![info exists selectedline]} return
|
|
|
995 set prev {}
|
|
|
996 foreach l $matchinglines {
|
|
|
997 if {$l >= $selectedline} break
|
|
|
998 set prev $l
|
|
|
999 }
|
|
|
1000 if {$prev != {}} {
|
|
|
1001 findselectline $prev
|
|
|
1002 } else {
|
|
|
1003 bell
|
|
|
1004 }
|
|
|
1005 }
|
|
|
1006
|
|
|
1007 proc markmatches {canv l str tag matches font} {
|
|
|
1008 set bbox [$canv bbox $tag]
|
|
|
1009 set x0 [lindex $bbox 0]
|
|
|
1010 set y0 [lindex $bbox 1]
|
|
|
1011 set y1 [lindex $bbox 3]
|
|
|
1012 foreach match $matches {
|
|
|
1013 set start [lindex $match 0]
|
|
|
1014 set end [lindex $match 1]
|
|
|
1015 if {$start > $end} continue
|
|
|
1016 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
|
|
|
1017 set xlen [font measure $font [string range $str 0 [expr $end]]]
|
|
|
1018 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
|
|
|
1019 -outline {} -tags matches -fill yellow]
|
|
|
1020 $canv lower $t
|
|
|
1021 }
|
|
|
1022 }
|
|
|
1023
|
|
|
1024 proc unmarkmatches {} {
|
|
|
1025 global matchinglines
|
|
|
1026 allcanvs delete matches
|
|
|
1027 catch {unset matchinglines}
|
|
|
1028 }
|
|
|
1029
|
|
|
1030 proc selcanvline {x y} {
|
|
|
1031 global canv canvy0 ctext linespc selectedline
|
|
|
1032 global lineid linehtag linentag linedtag
|
|
|
1033 set ymax [lindex [$canv cget -scrollregion] 3]
|
|
|
1034 if {$ymax == {}} return
|
|
|
1035 set yfrac [lindex [$canv yview] 0]
|
|
|
1036 set y [expr {$y + $yfrac * $ymax}]
|
|
|
1037 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
|
|
|
1038 if {$l < 0} {
|
|
|
1039 set l 0
|
|
|
1040 }
|
|
|
1041 if {[info exists selectedline] && $selectedline == $l} return
|
|
|
1042 unmarkmatches
|
|
|
1043 selectline $l
|
|
|
1044 }
|
|
|
1045
|
|
|
1046 proc selectline {l} {
|
|
|
1047 global canv canv2 canv3 ctext commitinfo selectedline
|
|
|
1048 global lineid linehtag linentag linedtag
|
|
|
1049 global canvy0 linespc nparents treepending
|
|
|
1050 global cflist treediffs currentid sha1entry
|
|
|
1051 global commentend seenfile numcommits idtags
|
|
|
1052 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
|
|
|
1053 $canv delete secsel
|
|
|
1054 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
|
|
|
1055 -tags secsel -fill [$canv cget -selectbackground]]
|
|
|
1056 $canv lower $t
|
|
|
1057 $canv2 delete secsel
|
|
|
1058 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
|
|
|
1059 -tags secsel -fill [$canv2 cget -selectbackground]]
|
|
|
1060 $canv2 lower $t
|
|
|
1061 $canv3 delete secsel
|
|
|
1062 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
|
|
|
1063 -tags secsel -fill [$canv3 cget -selectbackground]]
|
|
|
1064 $canv3 lower $t
|
|
|
1065 set y [expr {$canvy0 + $l * $linespc}]
|
|
|
1066 set ymax [lindex [$canv cget -scrollregion] 3]
|
|
|
1067 set ytop [expr {$y - $linespc - 1}]
|
|
|
1068 set ybot [expr {$y + $linespc + 1}]
|
|
|
1069 set wnow [$canv yview]
|
|
|
1070 set wtop [expr [lindex $wnow 0] * $ymax]
|
|
|
1071 set wbot [expr [lindex $wnow 1] * $ymax]
|
|
|
1072 set wh [expr {$wbot - $wtop}]
|
|
|
1073 set newtop $wtop
|
|
|
1074 if {$ytop < $wtop} {
|
|
|
1075 if {$ybot < $wtop} {
|
|
|
1076 set newtop [expr {$y - $wh / 2.0}]
|
|
|
1077 } else {
|
|
|
1078 set newtop $ytop
|
|
|
1079 if {$newtop > $wtop - $linespc} {
|
|
|
1080 set newtop [expr {$wtop - $linespc}]
|
|
|
1081 }
|
|
|
1082 }
|
|
|
1083 } elseif {$ybot > $wbot} {
|
|
|
1084 if {$ytop > $wbot} {
|
|
|
1085 set newtop [expr {$y - $wh / 2.0}]
|
|
|
1086 } else {
|
|
|
1087 set newtop [expr {$ybot - $wh}]
|
|
|
1088 if {$newtop < $wtop + $linespc} {
|
|
|
1089 set newtop [expr {$wtop + $linespc}]
|
|
|
1090 }
|
|
|
1091 }
|
|
|
1092 }
|
|
|
1093 if {$newtop != $wtop} {
|
|
|
1094 if {$newtop < 0} {
|
|
|
1095 set newtop 0
|
|
|
1096 }
|
|
|
1097 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
|
|
|
1098 }
|
|
|
1099 set selectedline $l
|
|
|
1100
|
|
|
1101 set id $lineid($l)
|
|
|
1102 set currentid $id
|
|
|
1103 $sha1entry delete 0 end
|
|
|
1104 $sha1entry insert 0 $id
|
|
|
1105 $sha1entry selection from 0
|
|
|
1106 $sha1entry selection to end
|
|
|
1107
|
|
|
1108 $ctext conf -state normal
|
|
|
1109 $ctext delete 0.0 end
|
|
|
1110 set info $commitinfo($id)
|
|
|
1111 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
|
|
|
1112 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
|
|
|
1113 if {[info exists idtags($id)]} {
|
|
|
1114 $ctext insert end "Tags:"
|
|
|
1115 foreach tag $idtags($id) {
|
|
|
1116 $ctext insert end " $tag"
|
|
|
1117 }
|
|
|
1118 $ctext insert end "\n"
|
|
|
1119 }
|
|
|
1120 $ctext insert end "\n"
|
|
|
1121 $ctext insert end [lindex $info 5]
|
|
|
1122 $ctext insert end "\n"
|
|
|
1123 $ctext tag delete Comments
|
|
|
1124 $ctext tag remove found 1.0 end
|
|
|
1125 $ctext conf -state disabled
|
|
|
1126 set commentend [$ctext index "end - 1c"]
|
|
|
1127
|
|
|
1128 $cflist delete 0 end
|
|
|
1129 if {$nparents($id) == 1} {
|
|
|
1130 if {![info exists treediffs($id)]} {
|
|
|
1131 if {![info exists treepending]} {
|
|
|
1132 gettreediffs $id
|
|
|
1133 }
|
|
|
1134 } else {
|
|
|
1135 addtocflist $id
|
|
|
1136 }
|
|
|
1137 }
|
|
|
1138 catch {unset seenfile}
|
|
|
1139 }
|
|
|
1140
|
|
|
1141 proc selnextline {dir} {
|
|
|
1142 global selectedline
|
|
|
1143 if {![info exists selectedline]} return
|
|
|
1144 set l [expr $selectedline + $dir]
|
|
|
1145 unmarkmatches
|
|
|
1146 selectline $l
|
|
|
1147 }
|
|
|
1148
|
|
|
1149 proc addtocflist {id} {
|
|
|
1150 global currentid treediffs cflist treepending
|
|
|
1151 if {$id != $currentid} {
|
|
|
1152 gettreediffs $currentid
|
|
|
1153 return
|
|
|
1154 }
|
|
|
1155 $cflist insert end "All files"
|
|
|
1156 foreach f $treediffs($currentid) {
|
|
|
1157 $cflist insert end $f
|
|
|
1158 }
|
|
|
1159 getblobdiffs $id
|
|
|
1160 }
|
|
|
1161
|
|
|
1162 proc gettreediffs {id} {
|
|
|
1163 global treediffs parents treepending
|
|
|
1164 set treepending $id
|
|
|
1165 set treediffs($id) {}
|
|
|
1166 set p [lindex $parents($id) 0]
|
|
|
1167 puts stderr "hgit diff-tree -r $p $id"
|
|
|
1168 if [catch {set gdtf [open "|hgit diff-tree -r $p $id" r]}] return
|
|
|
1169 fconfigure $gdtf -blocking 0
|
|
|
1170 fileevent $gdtf readable "gettreediffline $gdtf $id"
|
|
|
1171 }
|
|
|
1172
|
|
|
1173 proc gettreediffline {gdtf id} {
|
|
|
1174 global treediffs treepending
|
|
|
1175 set n [gets $gdtf line]
|
|
|
1176 if {$n < 0} {
|
|
|
1177 if {![eof $gdtf]} return
|
|
|
1178 close $gdtf
|
|
|
1179 unset treepending
|
|
|
1180 addtocflist $id
|
|
|
1181 return
|
|
|
1182 }
|
|
|
1183 set file [lindex $line 5]
|
|
|
1184 puts stderr "line $file\n"
|
|
|
1185 lappend treediffs($id) $file
|
|
|
1186 }
|
|
|
1187
|
|
|
1188 proc getblobdiffs {id} {
|
|
|
1189 global parents diffopts blobdifffd env curdifftag curtagstart
|
|
|
1190 global diffindex difffilestart
|
|
|
1191 set p [lindex $parents($id) 0]
|
|
|
1192 set env(GIT_DIFF_OPTS) $diffopts
|
|
|
1193 if [catch {set bdf [open "|hgit diff-tree -r -p $p $id" r]} err] {
|
|
|
1194 puts "error getting diffs: $err"
|
|
|
1195 return
|
|
|
1196 }
|
|
|
1197 fconfigure $bdf -blocking 0
|
|
|
1198 set blobdifffd($id) $bdf
|
|
|
1199 set curdifftag Comments
|
|
|
1200 set curtagstart 0.0
|
|
|
1201 set diffindex 0
|
|
|
1202 catch {unset difffilestart}
|
|
|
1203 fileevent $bdf readable "getblobdiffline $bdf $id"
|
|
|
1204 }
|
|
|
1205
|
|
|
1206 proc getblobdiffline {bdf id} {
|
|
|
1207 global currentid blobdifffd ctext curdifftag curtagstart seenfile
|
|
|
1208 global diffnexthead diffnextnote diffindex difffilestart
|
|
|
1209 set n [gets $bdf line]
|
|
|
1210 if {$n < 0} {
|
|
|
1211 if {[eof $bdf]} {
|
|
|
1212 close $bdf
|
|
|
1213 if {$id == $currentid && $bdf == $blobdifffd($id)} {
|
|
|
1214 $ctext tag add $curdifftag $curtagstart end
|
|
|
1215 set seenfile($curdifftag) 1
|
|
|
1216 }
|
|
|
1217 }
|
|
|
1218 return
|
|
|
1219 }
|
|
|
1220 if {$id != $currentid || $bdf != $blobdifffd($id)} {
|
|
|
1221 return
|
|
|
1222 }
|
|
|
1223 $ctext conf -state normal
|
|
|
1224 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
|
|
|
1225 # start of a new file
|
|
|
1226 $ctext insert end "\n"
|
|
|
1227 $ctext tag add $curdifftag $curtagstart end
|
|
|
1228 set seenfile($curdifftag) 1
|
|
|
1229 set curtagstart [$ctext index "end - 1c"]
|
|
|
1230 set header $fname
|
|
|
1231 if {[info exists diffnexthead]} {
|
|
|
1232 set fname $diffnexthead
|
|
|
1233 set header "$diffnexthead ($diffnextnote)"
|
|
|
1234 unset diffnexthead
|
|
|
1235 }
|
|
|
1236 set difffilestart($diffindex) [$ctext index "end - 1c"]
|
|
|
1237 incr diffindex
|
|
|
1238 set curdifftag "f:$fname"
|
|
|
1239 $ctext tag delete $curdifftag
|
|
|
1240 set l [expr {(78 - [string length $header]) / 2}]
|
|
|
1241 set pad [string range "----------------------------------------" 1 $l]
|
|
|
1242 $ctext insert end "$pad $header $pad\n" filesep
|
|
|
1243 } elseif {[string range $line 0 2] == "+++"} {
|
|
|
1244 # no need to do anything with this
|
|
|
1245 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
|
|
|
1246 set diffnexthead $fn
|
|
|
1247 set diffnextnote "created, mode $m"
|
|
|
1248 } elseif {[string range $line 0 8] == "Deleted: "} {
|
|
|
1249 set diffnexthead [string range $line 9 end]
|
|
|
1250 set diffnextnote "deleted"
|
|
|
1251 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
|
|
|
1252 # save the filename in case the next thing is "new file mode ..."
|
|
|
1253 set diffnexthead $fn
|
|
|
1254 set diffnextnote "modified"
|
|
|
1255 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
|
|
|
1256 set diffnextnote "new file, mode $m"
|
|
|
1257 } elseif {[string range $line 0 11] == "deleted file"} {
|
|
|
1258 set diffnextnote "deleted"
|
|
|
1259 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
|
|
|
1260 $line match f1l f1c f2l f2c rest]} {
|
|
|
1261 $ctext insert end "\t" hunksep
|
|
|
1262 $ctext insert end " $f1l " d0 " $f2l " d1
|
|
|
1263 $ctext insert end " $rest \n" hunksep
|
|
|
1264 } else {
|
|
|
1265 set x [string range $line 0 0]
|
|
|
1266 if {$x == "-" || $x == "+"} {
|
|
|
1267 set tag [expr {$x == "+"}]
|
|
|
1268 set line [string range $line 1 end]
|
|
|
1269 $ctext insert end "$line\n" d$tag
|
|
|
1270 } elseif {$x == " "} {
|
|
|
1271 set line [string range $line 1 end]
|
|
|
1272 $ctext insert end "$line\n"
|
|
|
1273 } elseif {$x == "\\"} {
|
|
|
1274 # e.g. "\ No newline at end of file"
|
|
|
1275 $ctext insert end "$line\n" filesep
|
|
|
1276 } else {
|
|
|
1277 # Something else we don't recognize
|
|
|
1278 if {$curdifftag != "Comments"} {
|
|
|
1279 $ctext insert end "\n"
|
|
|
1280 $ctext tag add $curdifftag $curtagstart end
|
|
|
1281 set seenfile($curdifftag) 1
|
|
|
1282 set curtagstart [$ctext index "end - 1c"]
|
|
|
1283 set curdifftag Comments
|
|
|
1284 }
|
|
|
1285 $ctext insert end "$line\n" filesep
|
|
|
1286 }
|
|
|
1287 }
|
|
|
1288 $ctext conf -state disabled
|
|
|
1289 }
|
|
|
1290
|
|
|
1291 proc nextfile {} {
|
|
|
1292 global difffilestart ctext
|
|
|
1293 set here [$ctext index @0,0]
|
|
|
1294 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
|
|
|
1295 if {[$ctext compare $difffilestart($i) > $here]} {
|
|
|
1296 $ctext yview $difffilestart($i)
|
|
|
1297 break
|
|
|
1298 }
|
|
|
1299 }
|
|
|
1300 }
|
|
|
1301
|
|
|
1302 proc listboxsel {} {
|
|
|
1303 global ctext cflist currentid treediffs seenfile
|
|
|
1304 if {![info exists currentid]} return
|
|
|
1305 set sel [$cflist curselection]
|
|
|
1306 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
|
|
|
1307 # show everything
|
|
|
1308 $ctext tag conf Comments -elide 0
|
|
|
1309 foreach f $treediffs($currentid) {
|
|
|
1310 if [info exists seenfile(f:$f)] {
|
|
|
1311 $ctext tag conf "f:$f" -elide 0
|
|
|
1312 }
|
|
|
1313 }
|
|
|
1314 } else {
|
|
|
1315 # just show selected files
|
|
|
1316 $ctext tag conf Comments -elide 1
|
|
|
1317 set i 1
|
|
|
1318 foreach f $treediffs($currentid) {
|
|
|
1319 set elide [expr {[lsearch -exact $sel $i] < 0}]
|
|
|
1320 if [info exists seenfile(f:$f)] {
|
|
|
1321 $ctext tag conf "f:$f" -elide $elide
|
|
|
1322 }
|
|
|
1323 incr i
|
|
|
1324 }
|
|
|
1325 }
|
|
|
1326 }
|
|
|
1327
|
|
|
1328 proc setcoords {} {
|
|
|
1329 global linespc charspc canvx0 canvy0 mainfont
|
|
|
1330 set linespc [font metrics $mainfont -linespace]
|
|
|
1331 set charspc [font measure $mainfont "m"]
|
|
|
1332 set canvy0 [expr 3 + 0.5 * $linespc]
|
|
|
1333 set canvx0 [expr 3 + 0.5 * $linespc]
|
|
|
1334 }
|
|
|
1335
|
|
|
1336 proc redisplay {} {
|
|
|
1337 global selectedline stopped redisplaying phase
|
|
|
1338 if {$stopped > 1} return
|
|
|
1339 if {$phase == "getcommits"} return
|
|
|
1340 set redisplaying 1
|
|
|
1341 if {$phase == "drawgraph"} {
|
|
|
1342 set stopped 1
|
|
|
1343 } else {
|
|
|
1344 drawgraph
|
|
|
1345 }
|
|
|
1346 }
|
|
|
1347
|
|
|
1348 proc incrfont {inc} {
|
|
|
1349 global mainfont namefont textfont selectedline ctext canv phase
|
|
|
1350 global stopped entries
|
|
|
1351 unmarkmatches
|
|
|
1352 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
|
|
|
1353 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
|
|
|
1354 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
|
|
|
1355 setcoords
|
|
|
1356 $ctext conf -font $textfont
|
|
|
1357 $ctext tag conf filesep -font [concat $textfont bold]
|
|
|
1358 foreach e $entries {
|
|
|
1359 $e conf -font $mainfont
|
|
|
1360 }
|
|
|
1361 if {$phase == "getcommits"} {
|
|
|
1362 $canv itemconf textitems -font $mainfont
|
|
|
1363 }
|
|
|
1364 redisplay
|
|
|
1365 }
|
|
|
1366
|
|
|
1367 proc sha1change {n1 n2 op} {
|
|
|
1368 global sha1string currentid sha1but
|
|
|
1369 if {$sha1string == {}
|
|
|
1370 || ([info exists currentid] && $sha1string == $currentid)} {
|
|
|
1371 set state disabled
|
|
|
1372 } else {
|
|
|
1373 set state normal
|
|
|
1374 }
|
|
|
1375 if {[$sha1but cget -state] == $state} return
|
|
|
1376 if {$state == "normal"} {
|
|
|
1377 $sha1but conf -state normal -relief raised -text "Goto: "
|
|
|
1378 } else {
|
|
|
1379 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
|
|
|
1380 }
|
|
|
1381 }
|
|
|
1382
|
|
|
1383 proc gotocommit {} {
|
|
|
1384 global sha1string currentid idline tagids
|
|
|
1385 if {$sha1string == {}
|
|
|
1386 || ([info exists currentid] && $sha1string == $currentid)} return
|
|
|
1387 if {[info exists tagids($sha1string)]} {
|
|
|
1388 set id $tagids($sha1string)
|
|
|
1389 } else {
|
|
|
1390 set id [string tolower $sha1string]
|
|
|
1391 }
|
|
|
1392 if {[info exists idline($id)]} {
|
|
|
1393 selectline $idline($id)
|
|
|
1394 return
|
|
|
1395 }
|
|
|
1396 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
|
|
|
1397 set type "SHA1 id"
|
|
|
1398 } else {
|
|
|
1399 set type "Tag"
|
|
|
1400 }
|
|
|
1401 error_popup "$type $sha1string is not known"
|
|
|
1402 }
|
|
|
1403
|
|
|
1404 proc doquit {} {
|
|
|
1405 global stopped
|
|
|
1406 set stopped 100
|
|
|
1407 destroy .
|
|
|
1408 }
|
|
|
1409
|
|
|
1410 # defaults...
|
|
|
1411 set datemode 0
|
|
|
1412 set boldnames 0
|
|
|
1413 set diffopts "-U 5 -p"
|
|
|
1414
|
|
|
1415 set mainfont {Helvetica 9}
|
|
|
1416 set textfont {Courier 9}
|
|
|
1417
|
|
|
1418 set colors {green red blue magenta darkgrey brown orange}
|
|
|
1419 set colorbycommitter false
|
|
|
1420
|
|
|
1421 catch {source ~/.gitk}
|
|
|
1422
|
|
|
1423 set namefont $mainfont
|
|
|
1424 if {$boldnames} {
|
|
|
1425 lappend namefont bold
|
|
|
1426 }
|
|
|
1427
|
|
|
1428 set revtreeargs {}
|
|
|
1429 foreach arg $argv {
|
|
|
1430 switch -regexp -- $arg {
|
|
|
1431 "^$" { }
|
|
|
1432 "^-b" { set boldnames 1 }
|
|
|
1433 "^-c" { set colorbycommitter 1 }
|
|
|
1434 "^-d" { set datemode 1 }
|
|
|
1435 default {
|
|
|
1436 lappend revtreeargs $arg
|
|
|
1437 }
|
|
|
1438 }
|
|
|
1439 }
|
|
|
1440
|
|
|
1441 set stopped 0
|
|
|
1442 set redisplaying 0
|
|
|
1443 set stuffsaved 0
|
|
|
1444 setcoords
|
|
|
1445 makewindow
|
|
|
1446 readrefs
|
|
|
1447 readfullcommits $revtreeargs
|
