##// END OF EJS Templates
hgit -> hgk.py...
mpm@selenic.com -
r1278:6a0d373d default
parent child Browse files
Show More
@@ -1,3651 +1,3651 b''
1 #!/bin/sh
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "${1+$@}"
3 exec wish "$0" -- "${1+$@}"
4
4
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
8 # either version 2, or (at your option) any later version.
9
9
10 proc gitdir {} {
10 proc gitdir {} {
11 global env
11 global env
12 if {[info exists env(GIT_DIR)]} {
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
13 return $env(GIT_DIR)
14 } else {
14 } else {
15 return ".hg"
15 return ".hg"
16 }
16 }
17 }
17 }
18
18
19 proc getcommits {rargs} {
19 proc getcommits {rargs} {
20 global commits commfd phase canv mainfont env
20 global commits commfd phase canv mainfont env
21 global startmsecs nextupdate ncmupdate
21 global startmsecs nextupdate ncmupdate
22 global ctext maincursor textcursor leftover
22 global ctext maincursor textcursor leftover
23
23
24 # check that we can find a .git directory somewhere...
24 # check that we can find a .git directory somewhere...
25 set gitdir [gitdir]
25 set gitdir [gitdir]
26 if {![file isdirectory $gitdir]} {
26 if {![file isdirectory $gitdir]} {
27 error_popup "Cannot find the git directory \"$gitdir\"."
27 error_popup "Cannot find the git directory \"$gitdir\"."
28 exit 1
28 exit 1
29 }
29 }
30 set commits {}
30 set commits {}
31 set phase getcommits
31 set phase getcommits
32 set startmsecs [clock clicks -milliseconds]
32 set startmsecs [clock clicks -milliseconds]
33 set nextupdate [expr $startmsecs + 100]
33 set nextupdate [expr $startmsecs + 100]
34 set ncmupdate 1
34 set ncmupdate 1
35 if [catch {
35 if [catch {
36 set parse_args [concat --default HEAD $rargs]
36 set parse_args [concat --default HEAD $rargs]
37 set parsed_args [split [eval exec hg git-rev-parse $parse_args] "\n"]
37 set parsed_args [split [eval exec hg debug-rev-parse $parse_args] "\n"]
38 }] {
38 }] {
39 # if git-rev-parse failed for some reason...
39 # if git-rev-parse failed for some reason...
40 if {$rargs == {}} {
40 if {$rargs == {}} {
41 set rargs HEAD
41 set rargs HEAD
42 }
42 }
43 set parsed_args $rargs
43 set parsed_args $rargs
44 }
44 }
45 if [catch {
45 if [catch {
46 set commfd [open "|hg git-rev-list --header --topo-order --parents $parsed_args" r]
46 set commfd [open "|hg debug-rev-list --header --topo-order --parents $parsed_args" r]
47 } err] {
47 } err] {
48 puts stderr "Error executing hg git-rev-list: $err"
48 puts stderr "Error executing hg debug-rev-list: $err"
49 exit 1
49 exit 1
50 }
50 }
51 set leftover {}
51 set leftover {}
52 fconfigure $commfd -blocking 0 -translation lf
52 fconfigure $commfd -blocking 0 -translation lf
53 fileevent $commfd readable [list getcommitlines $commfd]
53 fileevent $commfd readable [list getcommitlines $commfd]
54 $canv delete all
54 $canv delete all
55 $canv create text 3 3 -anchor nw -text "Reading commits..." \
55 $canv create text 3 3 -anchor nw -text "Reading commits..." \
56 -font $mainfont -tags textitems
56 -font $mainfont -tags textitems
57 . config -cursor watch
57 . config -cursor watch
58 settextcursor watch
58 settextcursor watch
59 }
59 }
60
60
61 proc getcommitlines {commfd} {
61 proc getcommitlines {commfd} {
62 global commits parents cdate children
62 global commits parents cdate children
63 global commitlisted phase commitinfo nextupdate
63 global commitlisted phase commitinfo nextupdate
64 global stopped redisplaying leftover
64 global stopped redisplaying leftover
65
65
66 set stuff [read $commfd]
66 set stuff [read $commfd]
67 if {$stuff == {}} {
67 if {$stuff == {}} {
68 if {![eof $commfd]} return
68 if {![eof $commfd]} return
69 # set it blocking so we wait for the process to terminate
69 # set it blocking so we wait for the process to terminate
70 fconfigure $commfd -blocking 1
70 fconfigure $commfd -blocking 1
71 if {![catch {close $commfd} err]} {
71 if {![catch {close $commfd} err]} {
72 after idle finishcommits
72 after idle finishcommits
73 return
73 return
74 }
74 }
75 if {[string range $err 0 4] == "usage"} {
75 if {[string range $err 0 4] == "usage"} {
76 set err \
76 set err \
77 {Gitk: error reading commits: bad arguments to git-rev-list.
77 {Gitk: error reading commits: bad arguments to git-rev-list.
78 (Note: arguments to gitk are passed to git-rev-list
78 (Note: arguments to gitk are passed to git-rev-list
79 to allow selection of commits to be displayed.)}
79 to allow selection of commits to be displayed.)}
80 } else {
80 } else {
81 set err "Error reading commits: $err"
81 set err "Error reading commits: $err"
82 }
82 }
83 error_popup $err
83 error_popup $err
84 exit 1
84 exit 1
85 }
85 }
86 set start 0
86 set start 0
87 while 1 {
87 while 1 {
88 set i [string first "\0" $stuff $start]
88 set i [string first "\0" $stuff $start]
89 if {$i < 0} {
89 if {$i < 0} {
90 append leftover [string range $stuff $start end]
90 append leftover [string range $stuff $start end]
91 return
91 return
92 }
92 }
93 set cmit [string range $stuff $start [expr {$i - 1}]]
93 set cmit [string range $stuff $start [expr {$i - 1}]]
94 if {$start == 0} {
94 if {$start == 0} {
95 set cmit "$leftover$cmit"
95 set cmit "$leftover$cmit"
96 set leftover {}
96 set leftover {}
97 }
97 }
98 set start [expr {$i + 1}]
98 set start [expr {$i + 1}]
99 set j [string first "\n" $cmit]
99 set j [string first "\n" $cmit]
100 set ok 0
100 set ok 0
101 if {$j >= 0} {
101 if {$j >= 0} {
102 set ids [string range $cmit 0 [expr {$j - 1}]]
102 set ids [string range $cmit 0 [expr {$j - 1}]]
103 set ok 1
103 set ok 1
104 foreach id $ids {
104 foreach id $ids {
105 if {![regexp {^[0-9a-f]{40}$} $id]} {
105 if {![regexp {^[0-9a-f]{40}$} $id]} {
106 set ok 0
106 set ok 0
107 break
107 break
108 }
108 }
109 }
109 }
110 }
110 }
111 if {!$ok} {
111 if {!$ok} {
112 set shortcmit $cmit
112 set shortcmit $cmit
113 if {[string length $shortcmit] > 80} {
113 if {[string length $shortcmit] > 80} {
114 set shortcmit "[string range $shortcmit 0 80]..."
114 set shortcmit "[string range $shortcmit 0 80]..."
115 }
115 }
116 error_popup "Can't parse hg git-rev-list output: {$shortcmit}"
116 error_popup "Can't parse hg debug-rev-list output: {$shortcmit}"
117 exit 1
117 exit 1
118 }
118 }
119 set id [lindex $ids 0]
119 set id [lindex $ids 0]
120 set olds [lrange $ids 1 end]
120 set olds [lrange $ids 1 end]
121 set cmit [string range $cmit [expr {$j + 1}] end]
121 set cmit [string range $cmit [expr {$j + 1}] end]
122 lappend commits $id
122 lappend commits $id
123 set commitlisted($id) 1
123 set commitlisted($id) 1
124 parsecommit $id $cmit 1 [lrange $ids 1 end]
124 parsecommit $id $cmit 1 [lrange $ids 1 end]
125 drawcommit $id
125 drawcommit $id
126 if {[clock clicks -milliseconds] >= $nextupdate} {
126 if {[clock clicks -milliseconds] >= $nextupdate} {
127 doupdate 1
127 doupdate 1
128 }
128 }
129 while {$redisplaying} {
129 while {$redisplaying} {
130 set redisplaying 0
130 set redisplaying 0
131 if {$stopped == 1} {
131 if {$stopped == 1} {
132 set stopped 0
132 set stopped 0
133 set phase "getcommits"
133 set phase "getcommits"
134 foreach id $commits {
134 foreach id $commits {
135 drawcommit $id
135 drawcommit $id
136 if {$stopped} break
136 if {$stopped} break
137 if {[clock clicks -milliseconds] >= $nextupdate} {
137 if {[clock clicks -milliseconds] >= $nextupdate} {
138 doupdate 1
138 doupdate 1
139 }
139 }
140 }
140 }
141 }
141 }
142 }
142 }
143 }
143 }
144 }
144 }
145
145
146 proc doupdate {reading} {
146 proc doupdate {reading} {
147 global commfd nextupdate numcommits ncmupdate
147 global commfd nextupdate numcommits ncmupdate
148
148
149 if {$reading} {
149 if {$reading} {
150 fileevent $commfd readable {}
150 fileevent $commfd readable {}
151 }
151 }
152 update
152 update
153 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
153 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
154 if {$numcommits < 100} {
154 if {$numcommits < 100} {
155 set ncmupdate [expr {$numcommits + 1}]
155 set ncmupdate [expr {$numcommits + 1}]
156 } elseif {$numcommits < 10000} {
156 } elseif {$numcommits < 10000} {
157 set ncmupdate [expr {$numcommits + 10}]
157 set ncmupdate [expr {$numcommits + 10}]
158 } else {
158 } else {
159 set ncmupdate [expr {$numcommits + 100}]
159 set ncmupdate [expr {$numcommits + 100}]
160 }
160 }
161 if {$reading} {
161 if {$reading} {
162 fileevent $commfd readable [list getcommitlines $commfd]
162 fileevent $commfd readable [list getcommitlines $commfd]
163 }
163 }
164 }
164 }
165
165
166 proc readcommit {id} {
166 proc readcommit {id} {
167 if [catch {set contents [exec hg git-cat-file commit $id]}] return
167 if [catch {set contents [exec hg debug-cat-file commit $id]}] return
168 parsecommit $id $contents 0 {}
168 parsecommit $id $contents 0 {}
169 }
169 }
170
170
171 proc parsecommit {id contents listed olds} {
171 proc parsecommit {id contents listed olds} {
172 global commitinfo children nchildren parents nparents cdate ncleft
172 global commitinfo children nchildren parents nparents cdate ncleft
173
173
174 set inhdr 1
174 set inhdr 1
175 set comment {}
175 set comment {}
176 set headline {}
176 set headline {}
177 set auname {}
177 set auname {}
178 set audate {}
178 set audate {}
179 set comname {}
179 set comname {}
180 set comdate {}
180 set comdate {}
181 if {![info exists nchildren($id)]} {
181 if {![info exists nchildren($id)]} {
182 set children($id) {}
182 set children($id) {}
183 set nchildren($id) 0
183 set nchildren($id) 0
184 set ncleft($id) 0
184 set ncleft($id) 0
185 }
185 }
186 set parents($id) $olds
186 set parents($id) $olds
187 set nparents($id) [llength $olds]
187 set nparents($id) [llength $olds]
188 foreach p $olds {
188 foreach p $olds {
189 if {![info exists nchildren($p)]} {
189 if {![info exists nchildren($p)]} {
190 set children($p) [list $id]
190 set children($p) [list $id]
191 set nchildren($p) 1
191 set nchildren($p) 1
192 set ncleft($p) 1
192 set ncleft($p) 1
193 } elseif {[lsearch -exact $children($p) $id] < 0} {
193 } elseif {[lsearch -exact $children($p) $id] < 0} {
194 lappend children($p) $id
194 lappend children($p) $id
195 incr nchildren($p)
195 incr nchildren($p)
196 incr ncleft($p)
196 incr ncleft($p)
197 }
197 }
198 }
198 }
199 foreach line [split $contents "\n"] {
199 foreach line [split $contents "\n"] {
200 if {$inhdr} {
200 if {$inhdr} {
201 if {$line == {}} {
201 if {$line == {}} {
202 set inhdr 0
202 set inhdr 0
203 } else {
203 } else {
204 set tag [lindex $line 0]
204 set tag [lindex $line 0]
205 if {$tag == "author"} {
205 if {$tag == "author"} {
206 set x [expr {[llength $line] - 2}]
206 set x [expr {[llength $line] - 2}]
207 set audate [lindex $line $x]
207 set audate [lindex $line $x]
208 set auname [lrange $line 1 [expr {$x - 1}]]
208 set auname [lrange $line 1 [expr {$x - 1}]]
209 } elseif {$tag == "committer"} {
209 } elseif {$tag == "committer"} {
210 set x [expr {[llength $line] - 2}]
210 set x [expr {[llength $line] - 2}]
211 set comdate [lindex $line $x]
211 set comdate [lindex $line $x]
212 set comname [lrange $line 1 [expr {$x - 1}]]
212 set comname [lrange $line 1 [expr {$x - 1}]]
213 }
213 }
214 }
214 }
215 } else {
215 } else {
216 if {$comment == {}} {
216 if {$comment == {}} {
217 set headline [string trim $line]
217 set headline [string trim $line]
218 } else {
218 } else {
219 append comment "\n"
219 append comment "\n"
220 }
220 }
221 if {!$listed} {
221 if {!$listed} {
222 # git-rev-list indents the comment by 4 spaces;
222 # git-rev-list indents the comment by 4 spaces;
223 # if we got this via git-cat-file, add the indentation
223 # if we got this via git-cat-file, add the indentation
224 append comment " "
224 append comment " "
225 }
225 }
226 append comment $line
226 append comment $line
227 }
227 }
228 }
228 }
229 if {$audate != {}} {
229 if {$audate != {}} {
230 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
230 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
231 }
231 }
232 if {$comdate != {}} {
232 if {$comdate != {}} {
233 set cdate($id) $comdate
233 set cdate($id) $comdate
234 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
234 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
235 }
235 }
236 set commitinfo($id) [list $headline $auname $audate \
236 set commitinfo($id) [list $headline $auname $audate \
237 $comname $comdate $comment]
237 $comname $comdate $comment]
238 }
238 }
239
239
240 proc readrefs {} {
240 proc readrefs {} {
241 global tagids idtags headids idheads tagcontents
241 global tagids idtags headids idheads tagcontents
242
242
243 set tags [exec hg tags]
243 set tags [exec hg tags]
244 set lines [split $tags '\n']
244 set lines [split $tags '\n']
245 foreach f $lines {
245 foreach f $lines {
246 set f [regexp -all -inline {\S+} $f]
246 set f [regexp -all -inline {\S+} $f]
247 set direct [lindex $f 0]
247 set direct [lindex $f 0]
248 set full [lindex $f 1]
248 set full [lindex $f 1]
249 set sha [split $full ':']
249 set sha [split $full ':']
250 set tag [lindex $sha 1]
250 set tag [lindex $sha 1]
251 lappend tagids($direct) $tag
251 lappend tagids($direct) $tag
252 lappend idtags($tag) $direct
252 lappend idtags($tag) $direct
253 }
253 }
254 }
254 }
255
255
256 proc readotherrefs {base dname excl} {
256 proc readotherrefs {base dname excl} {
257 global otherrefids idotherrefs
257 global otherrefids idotherrefs
258
258
259 set git [gitdir]
259 set git [gitdir]
260 set files [glob -nocomplain -types f [file join $git $base *]]
260 set files [glob -nocomplain -types f [file join $git $base *]]
261 foreach f $files {
261 foreach f $files {
262 catch {
262 catch {
263 set fd [open $f r]
263 set fd [open $f r]
264 set line [read $fd 40]
264 set line [read $fd 40]
265 if {[regexp {^[0-9a-f]{40}} $line id]} {
265 if {[regexp {^[0-9a-f]{40}} $line id]} {
266 set name "$dname[file tail $f]"
266 set name "$dname[file tail $f]"
267 set otherrefids($name) $id
267 set otherrefids($name) $id
268 lappend idotherrefs($id) $name
268 lappend idotherrefs($id) $name
269 }
269 }
270 close $fd
270 close $fd
271 }
271 }
272 }
272 }
273 set dirs [glob -nocomplain -types d [file join $git $base *]]
273 set dirs [glob -nocomplain -types d [file join $git $base *]]
274 foreach d $dirs {
274 foreach d $dirs {
275 set dir [file tail $d]
275 set dir [file tail $d]
276 if {[lsearch -exact $excl $dir] >= 0} continue
276 if {[lsearch -exact $excl $dir] >= 0} continue
277 readotherrefs [file join $base $dir] "$dname$dir/" {}
277 readotherrefs [file join $base $dir] "$dname$dir/" {}
278 }
278 }
279 }
279 }
280
280
281 proc error_popup msg {
281 proc error_popup msg {
282 set w .error
282 set w .error
283 toplevel $w
283 toplevel $w
284 wm transient $w .
284 wm transient $w .
285 message $w.m -text $msg -justify center -aspect 400
285 message $w.m -text $msg -justify center -aspect 400
286 pack $w.m -side top -fill x -padx 20 -pady 20
286 pack $w.m -side top -fill x -padx 20 -pady 20
287 button $w.ok -text OK -command "destroy $w"
287 button $w.ok -text OK -command "destroy $w"
288 pack $w.ok -side bottom -fill x
288 pack $w.ok -side bottom -fill x
289 bind $w <Visibility> "grab $w; focus $w"
289 bind $w <Visibility> "grab $w; focus $w"
290 tkwait window $w
290 tkwait window $w
291 }
291 }
292
292
293 proc makewindow {} {
293 proc makewindow {} {
294 global canv canv2 canv3 linespc charspc ctext cflist textfont
294 global canv canv2 canv3 linespc charspc ctext cflist textfont
295 global findtype findtypemenu findloc findstring fstring geometry
295 global findtype findtypemenu findloc findstring fstring geometry
296 global entries sha1entry sha1string sha1but
296 global entries sha1entry sha1string sha1but
297 global maincursor textcursor curtextcursor
297 global maincursor textcursor curtextcursor
298 global rowctxmenu gaudydiff mergemax
298 global rowctxmenu gaudydiff mergemax
299
299
300 menu .bar
300 menu .bar
301 .bar add cascade -label "File" -menu .bar.file
301 .bar add cascade -label "File" -menu .bar.file
302 menu .bar.file
302 menu .bar.file
303 .bar.file add command -label "Reread references" -command rereadrefs
303 .bar.file add command -label "Reread references" -command rereadrefs
304 .bar.file add command -label "Quit" -command doquit
304 .bar.file add command -label "Quit" -command doquit
305 menu .bar.help
305 menu .bar.help
306 .bar add cascade -label "Help" -menu .bar.help
306 .bar add cascade -label "Help" -menu .bar.help
307 .bar.help add command -label "About gitk" -command about
307 .bar.help add command -label "About gitk" -command about
308 . configure -menu .bar
308 . configure -menu .bar
309
309
310 if {![info exists geometry(canv1)]} {
310 if {![info exists geometry(canv1)]} {
311 set geometry(canv1) [expr 45 * $charspc]
311 set geometry(canv1) [expr 45 * $charspc]
312 set geometry(canv2) [expr 30 * $charspc]
312 set geometry(canv2) [expr 30 * $charspc]
313 set geometry(canv3) [expr 15 * $charspc]
313 set geometry(canv3) [expr 15 * $charspc]
314 set geometry(canvh) [expr 25 * $linespc + 4]
314 set geometry(canvh) [expr 25 * $linespc + 4]
315 set geometry(ctextw) 80
315 set geometry(ctextw) 80
316 set geometry(ctexth) 30
316 set geometry(ctexth) 30
317 set geometry(cflistw) 30
317 set geometry(cflistw) 30
318 }
318 }
319 panedwindow .ctop -orient vertical
319 panedwindow .ctop -orient vertical
320 if {[info exists geometry(width)]} {
320 if {[info exists geometry(width)]} {
321 .ctop conf -width $geometry(width) -height $geometry(height)
321 .ctop conf -width $geometry(width) -height $geometry(height)
322 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
322 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
323 set geometry(ctexth) [expr {($texth - 8) /
323 set geometry(ctexth) [expr {($texth - 8) /
324 [font metrics $textfont -linespace]}]
324 [font metrics $textfont -linespace]}]
325 }
325 }
326 frame .ctop.top
326 frame .ctop.top
327 frame .ctop.top.bar
327 frame .ctop.top.bar
328 pack .ctop.top.bar -side bottom -fill x
328 pack .ctop.top.bar -side bottom -fill x
329 set cscroll .ctop.top.csb
329 set cscroll .ctop.top.csb
330 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
330 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
331 pack $cscroll -side right -fill y
331 pack $cscroll -side right -fill y
332 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
332 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
333 pack .ctop.top.clist -side top -fill both -expand 1
333 pack .ctop.top.clist -side top -fill both -expand 1
334 .ctop add .ctop.top
334 .ctop add .ctop.top
335 set canv .ctop.top.clist.canv
335 set canv .ctop.top.clist.canv
336 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
336 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
337 -bg white -bd 0 \
337 -bg white -bd 0 \
338 -yscrollincr $linespc -yscrollcommand "$cscroll set"
338 -yscrollincr $linespc -yscrollcommand "$cscroll set"
339 .ctop.top.clist add $canv
339 .ctop.top.clist add $canv
340 set canv2 .ctop.top.clist.canv2
340 set canv2 .ctop.top.clist.canv2
341 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
341 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
342 -bg white -bd 0 -yscrollincr $linespc
342 -bg white -bd 0 -yscrollincr $linespc
343 .ctop.top.clist add $canv2
343 .ctop.top.clist add $canv2
344 set canv3 .ctop.top.clist.canv3
344 set canv3 .ctop.top.clist.canv3
345 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
345 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
346 -bg white -bd 0 -yscrollincr $linespc
346 -bg white -bd 0 -yscrollincr $linespc
347 .ctop.top.clist add $canv3
347 .ctop.top.clist add $canv3
348 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
348 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
349
349
350 set sha1entry .ctop.top.bar.sha1
350 set sha1entry .ctop.top.bar.sha1
351 set entries $sha1entry
351 set entries $sha1entry
352 set sha1but .ctop.top.bar.sha1label
352 set sha1but .ctop.top.bar.sha1label
353 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
353 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
354 -command gotocommit -width 8
354 -command gotocommit -width 8
355 $sha1but conf -disabledforeground [$sha1but cget -foreground]
355 $sha1but conf -disabledforeground [$sha1but cget -foreground]
356 pack .ctop.top.bar.sha1label -side left
356 pack .ctop.top.bar.sha1label -side left
357 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
357 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
358 trace add variable sha1string write sha1change
358 trace add variable sha1string write sha1change
359 pack $sha1entry -side left -pady 2
359 pack $sha1entry -side left -pady 2
360
360
361 image create bitmap bm-left -data {
361 image create bitmap bm-left -data {
362 #define left_width 16
362 #define left_width 16
363 #define left_height 16
363 #define left_height 16
364 static unsigned char left_bits[] = {
364 static unsigned char left_bits[] = {
365 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
365 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
366 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
366 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
367 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
367 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
368 }
368 }
369 image create bitmap bm-right -data {
369 image create bitmap bm-right -data {
370 #define right_width 16
370 #define right_width 16
371 #define right_height 16
371 #define right_height 16
372 static unsigned char right_bits[] = {
372 static unsigned char right_bits[] = {
373 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
373 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
374 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
374 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
375 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
375 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
376 }
376 }
377 button .ctop.top.bar.leftbut -image bm-left -command goback \
377 button .ctop.top.bar.leftbut -image bm-left -command goback \
378 -state disabled -width 26
378 -state disabled -width 26
379 pack .ctop.top.bar.leftbut -side left -fill y
379 pack .ctop.top.bar.leftbut -side left -fill y
380 button .ctop.top.bar.rightbut -image bm-right -command goforw \
380 button .ctop.top.bar.rightbut -image bm-right -command goforw \
381 -state disabled -width 26
381 -state disabled -width 26
382 pack .ctop.top.bar.rightbut -side left -fill y
382 pack .ctop.top.bar.rightbut -side left -fill y
383
383
384 button .ctop.top.bar.findbut -text "Find" -command dofind
384 button .ctop.top.bar.findbut -text "Find" -command dofind
385 pack .ctop.top.bar.findbut -side left
385 pack .ctop.top.bar.findbut -side left
386 set findstring {}
386 set findstring {}
387 set fstring .ctop.top.bar.findstring
387 set fstring .ctop.top.bar.findstring
388 lappend entries $fstring
388 lappend entries $fstring
389 entry $fstring -width 30 -font $textfont -textvariable findstring
389 entry $fstring -width 30 -font $textfont -textvariable findstring
390 pack $fstring -side left -expand 1 -fill x
390 pack $fstring -side left -expand 1 -fill x
391 set findtype Exact
391 set findtype Exact
392 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
392 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
393 findtype Exact IgnCase Regexp]
393 findtype Exact IgnCase Regexp]
394 set findloc "All fields"
394 set findloc "All fields"
395 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
395 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
396 Comments Author Committer Files Pickaxe
396 Comments Author Committer Files Pickaxe
397 pack .ctop.top.bar.findloc -side right
397 pack .ctop.top.bar.findloc -side right
398 pack .ctop.top.bar.findtype -side right
398 pack .ctop.top.bar.findtype -side right
399 # for making sure type==Exact whenever loc==Pickaxe
399 # for making sure type==Exact whenever loc==Pickaxe
400 trace add variable findloc write findlocchange
400 trace add variable findloc write findlocchange
401
401
402 panedwindow .ctop.cdet -orient horizontal
402 panedwindow .ctop.cdet -orient horizontal
403 .ctop add .ctop.cdet
403 .ctop add .ctop.cdet
404 frame .ctop.cdet.left
404 frame .ctop.cdet.left
405 set ctext .ctop.cdet.left.ctext
405 set ctext .ctop.cdet.left.ctext
406 text $ctext -bg white -state disabled -font $textfont \
406 text $ctext -bg white -state disabled -font $textfont \
407 -width $geometry(ctextw) -height $geometry(ctexth) \
407 -width $geometry(ctextw) -height $geometry(ctexth) \
408 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
408 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
409 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
409 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
410 pack .ctop.cdet.left.sb -side right -fill y
410 pack .ctop.cdet.left.sb -side right -fill y
411 pack $ctext -side left -fill both -expand 1
411 pack $ctext -side left -fill both -expand 1
412 .ctop.cdet add .ctop.cdet.left
412 .ctop.cdet add .ctop.cdet.left
413
413
414 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
414 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
415 if {$gaudydiff} {
415 if {$gaudydiff} {
416 $ctext tag conf hunksep -back blue -fore white
416 $ctext tag conf hunksep -back blue -fore white
417 $ctext tag conf d0 -back "#ff8080"
417 $ctext tag conf d0 -back "#ff8080"
418 $ctext tag conf d1 -back green
418 $ctext tag conf d1 -back green
419 } else {
419 } else {
420 $ctext tag conf hunksep -fore blue
420 $ctext tag conf hunksep -fore blue
421 $ctext tag conf d0 -fore red
421 $ctext tag conf d0 -fore red
422 $ctext tag conf d1 -fore "#00a000"
422 $ctext tag conf d1 -fore "#00a000"
423 $ctext tag conf m0 -fore red
423 $ctext tag conf m0 -fore red
424 $ctext tag conf m1 -fore blue
424 $ctext tag conf m1 -fore blue
425 $ctext tag conf m2 -fore green
425 $ctext tag conf m2 -fore green
426 $ctext tag conf m3 -fore purple
426 $ctext tag conf m3 -fore purple
427 $ctext tag conf m4 -fore brown
427 $ctext tag conf m4 -fore brown
428 $ctext tag conf mmax -fore darkgrey
428 $ctext tag conf mmax -fore darkgrey
429 set mergemax 5
429 set mergemax 5
430 $ctext tag conf mresult -font [concat $textfont bold]
430 $ctext tag conf mresult -font [concat $textfont bold]
431 $ctext tag conf msep -font [concat $textfont bold]
431 $ctext tag conf msep -font [concat $textfont bold]
432 $ctext tag conf found -back yellow
432 $ctext tag conf found -back yellow
433 }
433 }
434
434
435 frame .ctop.cdet.right
435 frame .ctop.cdet.right
436 set cflist .ctop.cdet.right.cfiles
436 set cflist .ctop.cdet.right.cfiles
437 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
437 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
438 -yscrollcommand ".ctop.cdet.right.sb set"
438 -yscrollcommand ".ctop.cdet.right.sb set"
439 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
439 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
440 pack .ctop.cdet.right.sb -side right -fill y
440 pack .ctop.cdet.right.sb -side right -fill y
441 pack $cflist -side left -fill both -expand 1
441 pack $cflist -side left -fill both -expand 1
442 .ctop.cdet add .ctop.cdet.right
442 .ctop.cdet add .ctop.cdet.right
443 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
443 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
444
444
445 pack .ctop -side top -fill both -expand 1
445 pack .ctop -side top -fill both -expand 1
446
446
447 bindall <1> {selcanvline %W %x %y}
447 bindall <1> {selcanvline %W %x %y}
448 #bindall <B1-Motion> {selcanvline %W %x %y}
448 #bindall <B1-Motion> {selcanvline %W %x %y}
449 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
449 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
450 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
450 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
451 bindall <2> "allcanvs scan mark 0 %y"
451 bindall <2> "allcanvs scan mark 0 %y"
452 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
452 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
453 bind . <Key-Up> "selnextline -1"
453 bind . <Key-Up> "selnextline -1"
454 bind . <Key-Down> "selnextline 1"
454 bind . <Key-Down> "selnextline 1"
455 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
455 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
456 bind . <Key-Next> "allcanvs yview scroll 1 pages"
456 bind . <Key-Next> "allcanvs yview scroll 1 pages"
457 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
457 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
458 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
458 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
459 bindkey <Key-space> "$ctext yview scroll 1 pages"
459 bindkey <Key-space> "$ctext yview scroll 1 pages"
460 bindkey p "selnextline -1"
460 bindkey p "selnextline -1"
461 bindkey n "selnextline 1"
461 bindkey n "selnextline 1"
462 bindkey b "$ctext yview scroll -1 pages"
462 bindkey b "$ctext yview scroll -1 pages"
463 bindkey d "$ctext yview scroll 18 units"
463 bindkey d "$ctext yview scroll 18 units"
464 bindkey u "$ctext yview scroll -18 units"
464 bindkey u "$ctext yview scroll -18 units"
465 bindkey / {findnext 1}
465 bindkey / {findnext 1}
466 bindkey <Key-Return> {findnext 0}
466 bindkey <Key-Return> {findnext 0}
467 bindkey ? findprev
467 bindkey ? findprev
468 bindkey f nextfile
468 bindkey f nextfile
469 bind . <Control-q> doquit
469 bind . <Control-q> doquit
470 bind . <Control-f> dofind
470 bind . <Control-f> dofind
471 bind . <Control-g> {findnext 0}
471 bind . <Control-g> {findnext 0}
472 bind . <Control-r> findprev
472 bind . <Control-r> findprev
473 bind . <Control-equal> {incrfont 1}
473 bind . <Control-equal> {incrfont 1}
474 bind . <Control-KP_Add> {incrfont 1}
474 bind . <Control-KP_Add> {incrfont 1}
475 bind . <Control-minus> {incrfont -1}
475 bind . <Control-minus> {incrfont -1}
476 bind . <Control-KP_Subtract> {incrfont -1}
476 bind . <Control-KP_Subtract> {incrfont -1}
477 bind $cflist <<ListboxSelect>> listboxsel
477 bind $cflist <<ListboxSelect>> listboxsel
478 bind . <Destroy> {savestuff %W}
478 bind . <Destroy> {savestuff %W}
479 bind . <Button-1> "click %W"
479 bind . <Button-1> "click %W"
480 bind $fstring <Key-Return> dofind
480 bind $fstring <Key-Return> dofind
481 bind $sha1entry <Key-Return> gotocommit
481 bind $sha1entry <Key-Return> gotocommit
482 bind $sha1entry <<PasteSelection>> clearsha1
482 bind $sha1entry <<PasteSelection>> clearsha1
483
483
484 set maincursor [. cget -cursor]
484 set maincursor [. cget -cursor]
485 set textcursor [$ctext cget -cursor]
485 set textcursor [$ctext cget -cursor]
486 set curtextcursor $textcursor
486 set curtextcursor $textcursor
487
487
488 set rowctxmenu .rowctxmenu
488 set rowctxmenu .rowctxmenu
489 menu $rowctxmenu -tearoff 0
489 menu $rowctxmenu -tearoff 0
490 $rowctxmenu add command -label "Diff this -> selected" \
490 $rowctxmenu add command -label "Diff this -> selected" \
491 -command {diffvssel 0}
491 -command {diffvssel 0}
492 $rowctxmenu add command -label "Diff selected -> this" \
492 $rowctxmenu add command -label "Diff selected -> this" \
493 -command {diffvssel 1}
493 -command {diffvssel 1}
494 $rowctxmenu add command -label "Make patch" -command mkpatch
494 $rowctxmenu add command -label "Make patch" -command mkpatch
495 $rowctxmenu add command -label "Create tag" -command mktag
495 $rowctxmenu add command -label "Create tag" -command mktag
496 $rowctxmenu add command -label "Write commit to file" -command writecommit
496 $rowctxmenu add command -label "Write commit to file" -command writecommit
497 }
497 }
498
498
499 # when we make a key binding for the toplevel, make sure
499 # when we make a key binding for the toplevel, make sure
500 # it doesn't get triggered when that key is pressed in the
500 # it doesn't get triggered when that key is pressed in the
501 # find string entry widget.
501 # find string entry widget.
502 proc bindkey {ev script} {
502 proc bindkey {ev script} {
503 global entries
503 global entries
504 bind . $ev $script
504 bind . $ev $script
505 set escript [bind Entry $ev]
505 set escript [bind Entry $ev]
506 if {$escript == {}} {
506 if {$escript == {}} {
507 set escript [bind Entry <Key>]
507 set escript [bind Entry <Key>]
508 }
508 }
509 foreach e $entries {
509 foreach e $entries {
510 bind $e $ev "$escript; break"
510 bind $e $ev "$escript; break"
511 }
511 }
512 }
512 }
513
513
514 # set the focus back to the toplevel for any click outside
514 # set the focus back to the toplevel for any click outside
515 # the entry widgets
515 # the entry widgets
516 proc click {w} {
516 proc click {w} {
517 global entries
517 global entries
518 foreach e $entries {
518 foreach e $entries {
519 if {$w == $e} return
519 if {$w == $e} return
520 }
520 }
521 focus .
521 focus .
522 }
522 }
523
523
524 proc savestuff {w} {
524 proc savestuff {w} {
525 global canv canv2 canv3 ctext cflist mainfont textfont
525 global canv canv2 canv3 ctext cflist mainfont textfont
526 global stuffsaved findmergefiles gaudydiff maxgraphpct
526 global stuffsaved findmergefiles gaudydiff maxgraphpct
527 global maxwidth
527 global maxwidth
528
528
529 if {$stuffsaved} return
529 if {$stuffsaved} return
530 if {![winfo viewable .]} return
530 if {![winfo viewable .]} return
531 catch {
531 catch {
532 set f [open "~/.gitk-new" w]
532 set f [open "~/.gitk-new" w]
533 puts $f [list set mainfont $mainfont]
533 puts $f [list set mainfont $mainfont]
534 puts $f [list set textfont $textfont]
534 puts $f [list set textfont $textfont]
535 puts $f [list set findmergefiles $findmergefiles]
535 puts $f [list set findmergefiles $findmergefiles]
536 puts $f [list set gaudydiff $gaudydiff]
536 puts $f [list set gaudydiff $gaudydiff]
537 puts $f [list set maxgraphpct $maxgraphpct]
537 puts $f [list set maxgraphpct $maxgraphpct]
538 puts $f [list set maxwidth $maxwidth]
538 puts $f [list set maxwidth $maxwidth]
539 puts $f "set geometry(width) [winfo width .ctop]"
539 puts $f "set geometry(width) [winfo width .ctop]"
540 puts $f "set geometry(height) [winfo height .ctop]"
540 puts $f "set geometry(height) [winfo height .ctop]"
541 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
541 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
542 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
542 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
543 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
543 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
544 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
544 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
545 set wid [expr {([winfo width $ctext] - 8) \
545 set wid [expr {([winfo width $ctext] - 8) \
546 / [font measure $textfont "0"]}]
546 / [font measure $textfont "0"]}]
547 puts $f "set geometry(ctextw) $wid"
547 puts $f "set geometry(ctextw) $wid"
548 set wid [expr {([winfo width $cflist] - 11) \
548 set wid [expr {([winfo width $cflist] - 11) \
549 / [font measure [$cflist cget -font] "0"]}]
549 / [font measure [$cflist cget -font] "0"]}]
550 puts $f "set geometry(cflistw) $wid"
550 puts $f "set geometry(cflistw) $wid"
551 close $f
551 close $f
552 file rename -force "~/.gitk-new" "~/.gitk"
552 file rename -force "~/.gitk-new" "~/.gitk"
553 }
553 }
554 set stuffsaved 1
554 set stuffsaved 1
555 }
555 }
556
556
557 proc resizeclistpanes {win w} {
557 proc resizeclistpanes {win w} {
558 global oldwidth
558 global oldwidth
559 if [info exists oldwidth($win)] {
559 if [info exists oldwidth($win)] {
560 set s0 [$win sash coord 0]
560 set s0 [$win sash coord 0]
561 set s1 [$win sash coord 1]
561 set s1 [$win sash coord 1]
562 if {$w < 60} {
562 if {$w < 60} {
563 set sash0 [expr {int($w/2 - 2)}]
563 set sash0 [expr {int($w/2 - 2)}]
564 set sash1 [expr {int($w*5/6 - 2)}]
564 set sash1 [expr {int($w*5/6 - 2)}]
565 } else {
565 } else {
566 set factor [expr {1.0 * $w / $oldwidth($win)}]
566 set factor [expr {1.0 * $w / $oldwidth($win)}]
567 set sash0 [expr {int($factor * [lindex $s0 0])}]
567 set sash0 [expr {int($factor * [lindex $s0 0])}]
568 set sash1 [expr {int($factor * [lindex $s1 0])}]
568 set sash1 [expr {int($factor * [lindex $s1 0])}]
569 if {$sash0 < 30} {
569 if {$sash0 < 30} {
570 set sash0 30
570 set sash0 30
571 }
571 }
572 if {$sash1 < $sash0 + 20} {
572 if {$sash1 < $sash0 + 20} {
573 set sash1 [expr $sash0 + 20]
573 set sash1 [expr $sash0 + 20]
574 }
574 }
575 if {$sash1 > $w - 10} {
575 if {$sash1 > $w - 10} {
576 set sash1 [expr $w - 10]
576 set sash1 [expr $w - 10]
577 if {$sash0 > $sash1 - 20} {
577 if {$sash0 > $sash1 - 20} {
578 set sash0 [expr $sash1 - 20]
578 set sash0 [expr $sash1 - 20]
579 }
579 }
580 }
580 }
581 }
581 }
582 $win sash place 0 $sash0 [lindex $s0 1]
582 $win sash place 0 $sash0 [lindex $s0 1]
583 $win sash place 1 $sash1 [lindex $s1 1]
583 $win sash place 1 $sash1 [lindex $s1 1]
584 }
584 }
585 set oldwidth($win) $w
585 set oldwidth($win) $w
586 }
586 }
587
587
588 proc resizecdetpanes {win w} {
588 proc resizecdetpanes {win w} {
589 global oldwidth
589 global oldwidth
590 if [info exists oldwidth($win)] {
590 if [info exists oldwidth($win)] {
591 set s0 [$win sash coord 0]
591 set s0 [$win sash coord 0]
592 if {$w < 60} {
592 if {$w < 60} {
593 set sash0 [expr {int($w*3/4 - 2)}]
593 set sash0 [expr {int($w*3/4 - 2)}]
594 } else {
594 } else {
595 set factor [expr {1.0 * $w / $oldwidth($win)}]
595 set factor [expr {1.0 * $w / $oldwidth($win)}]
596 set sash0 [expr {int($factor * [lindex $s0 0])}]
596 set sash0 [expr {int($factor * [lindex $s0 0])}]
597 if {$sash0 < 45} {
597 if {$sash0 < 45} {
598 set sash0 45
598 set sash0 45
599 }
599 }
600 if {$sash0 > $w - 15} {
600 if {$sash0 > $w - 15} {
601 set sash0 [expr $w - 15]
601 set sash0 [expr $w - 15]
602 }
602 }
603 }
603 }
604 $win sash place 0 $sash0 [lindex $s0 1]
604 $win sash place 0 $sash0 [lindex $s0 1]
605 }
605 }
606 set oldwidth($win) $w
606 set oldwidth($win) $w
607 }
607 }
608
608
609 proc allcanvs args {
609 proc allcanvs args {
610 global canv canv2 canv3
610 global canv canv2 canv3
611 eval $canv $args
611 eval $canv $args
612 eval $canv2 $args
612 eval $canv2 $args
613 eval $canv3 $args
613 eval $canv3 $args
614 }
614 }
615
615
616 proc bindall {event action} {
616 proc bindall {event action} {
617 global canv canv2 canv3
617 global canv canv2 canv3
618 bind $canv $event $action
618 bind $canv $event $action
619 bind $canv2 $event $action
619 bind $canv2 $event $action
620 bind $canv3 $event $action
620 bind $canv3 $event $action
621 }
621 }
622
622
623 proc about {} {
623 proc about {} {
624 set w .about
624 set w .about
625 if {[winfo exists $w]} {
625 if {[winfo exists $w]} {
626 raise $w
626 raise $w
627 return
627 return
628 }
628 }
629 toplevel $w
629 toplevel $w
630 wm title $w "About gitk"
630 wm title $w "About gitk"
631 message $w.m -text {
631 message $w.m -text {
632 Gitk version 1.2
632 Gitk version 1.2
633
633
634 Copyright οΏ½ 2005 Paul Mackerras
634 Copyright οΏ½ 2005 Paul Mackerras
635
635
636 Use and redistribute under the terms of the GNU General Public License} \
636 Use and redistribute under the terms of the GNU General Public License} \
637 -justify center -aspect 400
637 -justify center -aspect 400
638 pack $w.m -side top -fill x -padx 20 -pady 20
638 pack $w.m -side top -fill x -padx 20 -pady 20
639 button $w.ok -text Close -command "destroy $w"
639 button $w.ok -text Close -command "destroy $w"
640 pack $w.ok -side bottom
640 pack $w.ok -side bottom
641 }
641 }
642
642
643 proc assigncolor {id} {
643 proc assigncolor {id} {
644 global commitinfo colormap commcolors colors nextcolor
644 global commitinfo colormap commcolors colors nextcolor
645 global parents nparents children nchildren
645 global parents nparents children nchildren
646 global cornercrossings crossings
646 global cornercrossings crossings
647
647
648 if [info exists colormap($id)] return
648 if [info exists colormap($id)] return
649 set ncolors [llength $colors]
649 set ncolors [llength $colors]
650 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
650 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
651 set child [lindex $children($id) 0]
651 set child [lindex $children($id) 0]
652 if {[info exists colormap($child)]
652 if {[info exists colormap($child)]
653 && $nparents($child) == 1} {
653 && $nparents($child) == 1} {
654 set colormap($id) $colormap($child)
654 set colormap($id) $colormap($child)
655 return
655 return
656 }
656 }
657 }
657 }
658 set badcolors {}
658 set badcolors {}
659 if {[info exists cornercrossings($id)]} {
659 if {[info exists cornercrossings($id)]} {
660 foreach x $cornercrossings($id) {
660 foreach x $cornercrossings($id) {
661 if {[info exists colormap($x)]
661 if {[info exists colormap($x)]
662 && [lsearch -exact $badcolors $colormap($x)] < 0} {
662 && [lsearch -exact $badcolors $colormap($x)] < 0} {
663 lappend badcolors $colormap($x)
663 lappend badcolors $colormap($x)
664 }
664 }
665 }
665 }
666 if {[llength $badcolors] >= $ncolors} {
666 if {[llength $badcolors] >= $ncolors} {
667 set badcolors {}
667 set badcolors {}
668 }
668 }
669 }
669 }
670 set origbad $badcolors
670 set origbad $badcolors
671 if {[llength $badcolors] < $ncolors - 1} {
671 if {[llength $badcolors] < $ncolors - 1} {
672 if {[info exists crossings($id)]} {
672 if {[info exists crossings($id)]} {
673 foreach x $crossings($id) {
673 foreach x $crossings($id) {
674 if {[info exists colormap($x)]
674 if {[info exists colormap($x)]
675 && [lsearch -exact $badcolors $colormap($x)] < 0} {
675 && [lsearch -exact $badcolors $colormap($x)] < 0} {
676 lappend badcolors $colormap($x)
676 lappend badcolors $colormap($x)
677 }
677 }
678 }
678 }
679 if {[llength $badcolors] >= $ncolors} {
679 if {[llength $badcolors] >= $ncolors} {
680 set badcolors $origbad
680 set badcolors $origbad
681 }
681 }
682 }
682 }
683 set origbad $badcolors
683 set origbad $badcolors
684 }
684 }
685 if {[llength $badcolors] < $ncolors - 1} {
685 if {[llength $badcolors] < $ncolors - 1} {
686 foreach child $children($id) {
686 foreach child $children($id) {
687 if {[info exists colormap($child)]
687 if {[info exists colormap($child)]
688 && [lsearch -exact $badcolors $colormap($child)] < 0} {
688 && [lsearch -exact $badcolors $colormap($child)] < 0} {
689 lappend badcolors $colormap($child)
689 lappend badcolors $colormap($child)
690 }
690 }
691 if {[info exists parents($child)]} {
691 if {[info exists parents($child)]} {
692 foreach p $parents($child) {
692 foreach p $parents($child) {
693 if {[info exists colormap($p)]
693 if {[info exists colormap($p)]
694 && [lsearch -exact $badcolors $colormap($p)] < 0} {
694 && [lsearch -exact $badcolors $colormap($p)] < 0} {
695 lappend badcolors $colormap($p)
695 lappend badcolors $colormap($p)
696 }
696 }
697 }
697 }
698 }
698 }
699 }
699 }
700 if {[llength $badcolors] >= $ncolors} {
700 if {[llength $badcolors] >= $ncolors} {
701 set badcolors $origbad
701 set badcolors $origbad
702 }
702 }
703 }
703 }
704 for {set i 0} {$i <= $ncolors} {incr i} {
704 for {set i 0} {$i <= $ncolors} {incr i} {
705 set c [lindex $colors $nextcolor]
705 set c [lindex $colors $nextcolor]
706 if {[incr nextcolor] >= $ncolors} {
706 if {[incr nextcolor] >= $ncolors} {
707 set nextcolor 0
707 set nextcolor 0
708 }
708 }
709 if {[lsearch -exact $badcolors $c]} break
709 if {[lsearch -exact $badcolors $c]} break
710 }
710 }
711 set colormap($id) $c
711 set colormap($id) $c
712 }
712 }
713
713
714 proc initgraph {} {
714 proc initgraph {} {
715 global canvy canvy0 lineno numcommits nextcolor linespc
715 global canvy canvy0 lineno numcommits nextcolor linespc
716 global mainline mainlinearrow sidelines
716 global mainline mainlinearrow sidelines
717 global nchildren ncleft
717 global nchildren ncleft
718 global displist nhyperspace
718 global displist nhyperspace
719
719
720 allcanvs delete all
720 allcanvs delete all
721 set nextcolor 0
721 set nextcolor 0
722 set canvy $canvy0
722 set canvy $canvy0
723 set lineno -1
723 set lineno -1
724 set numcommits 0
724 set numcommits 0
725 catch {unset mainline}
725 catch {unset mainline}
726 catch {unset mainlinearrow}
726 catch {unset mainlinearrow}
727 catch {unset sidelines}
727 catch {unset sidelines}
728 foreach id [array names nchildren] {
728 foreach id [array names nchildren] {
729 set ncleft($id) $nchildren($id)
729 set ncleft($id) $nchildren($id)
730 }
730 }
731 set displist {}
731 set displist {}
732 set nhyperspace 0
732 set nhyperspace 0
733 }
733 }
734
734
735 proc bindline {t id} {
735 proc bindline {t id} {
736 global canv
736 global canv
737
737
738 $canv bind $t <Enter> "lineenter %x %y $id"
738 $canv bind $t <Enter> "lineenter %x %y $id"
739 $canv bind $t <Motion> "linemotion %x %y $id"
739 $canv bind $t <Motion> "linemotion %x %y $id"
740 $canv bind $t <Leave> "lineleave $id"
740 $canv bind $t <Leave> "lineleave $id"
741 $canv bind $t <Button-1> "lineclick %x %y $id 1"
741 $canv bind $t <Button-1> "lineclick %x %y $id 1"
742 }
742 }
743
743
744 proc drawlines {id xtra} {
744 proc drawlines {id xtra} {
745 global mainline mainlinearrow sidelines lthickness colormap canv
745 global mainline mainlinearrow sidelines lthickness colormap canv
746
746
747 $canv delete lines.$id
747 $canv delete lines.$id
748 if {[info exists mainline($id)]} {
748 if {[info exists mainline($id)]} {
749 set t [$canv create line $mainline($id) \
749 set t [$canv create line $mainline($id) \
750 -width [expr {($xtra + 1) * $lthickness}] \
750 -width [expr {($xtra + 1) * $lthickness}] \
751 -fill $colormap($id) -tags lines.$id \
751 -fill $colormap($id) -tags lines.$id \
752 -arrow $mainlinearrow($id)]
752 -arrow $mainlinearrow($id)]
753 $canv lower $t
753 $canv lower $t
754 bindline $t $id
754 bindline $t $id
755 }
755 }
756 if {[info exists sidelines($id)]} {
756 if {[info exists sidelines($id)]} {
757 foreach ls $sidelines($id) {
757 foreach ls $sidelines($id) {
758 set coords [lindex $ls 0]
758 set coords [lindex $ls 0]
759 set thick [lindex $ls 1]
759 set thick [lindex $ls 1]
760 set arrow [lindex $ls 2]
760 set arrow [lindex $ls 2]
761 set t [$canv create line $coords -fill $colormap($id) \
761 set t [$canv create line $coords -fill $colormap($id) \
762 -width [expr {($thick + $xtra) * $lthickness}] \
762 -width [expr {($thick + $xtra) * $lthickness}] \
763 -arrow $arrow -tags lines.$id]
763 -arrow $arrow -tags lines.$id]
764 $canv lower $t
764 $canv lower $t
765 bindline $t $id
765 bindline $t $id
766 }
766 }
767 }
767 }
768 }
768 }
769
769
770 # level here is an index in displist
770 # level here is an index in displist
771 proc drawcommitline {level} {
771 proc drawcommitline {level} {
772 global parents children nparents displist
772 global parents children nparents displist
773 global canv canv2 canv3 mainfont namefont canvy linespc
773 global canv canv2 canv3 mainfont namefont canvy linespc
774 global lineid linehtag linentag linedtag commitinfo
774 global lineid linehtag linentag linedtag commitinfo
775 global colormap numcommits currentparents dupparents
775 global colormap numcommits currentparents dupparents
776 global idtags idline idheads idotherrefs
776 global idtags idline idheads idotherrefs
777 global lineno lthickness mainline mainlinearrow sidelines
777 global lineno lthickness mainline mainlinearrow sidelines
778 global commitlisted rowtextx idpos lastuse displist
778 global commitlisted rowtextx idpos lastuse displist
779 global oldnlines olddlevel olddisplist
779 global oldnlines olddlevel olddisplist
780
780
781 incr numcommits
781 incr numcommits
782 incr lineno
782 incr lineno
783 set id [lindex $displist $level]
783 set id [lindex $displist $level]
784 set lastuse($id) $lineno
784 set lastuse($id) $lineno
785 set lineid($lineno) $id
785 set lineid($lineno) $id
786 set idline($id) $lineno
786 set idline($id) $lineno
787 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
787 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
788 if {![info exists commitinfo($id)]} {
788 if {![info exists commitinfo($id)]} {
789 readcommit $id
789 readcommit $id
790 if {![info exists commitinfo($id)]} {
790 if {![info exists commitinfo($id)]} {
791 set commitinfo($id) {"No commit information available"}
791 set commitinfo($id) {"No commit information available"}
792 set nparents($id) 0
792 set nparents($id) 0
793 }
793 }
794 }
794 }
795 assigncolor $id
795 assigncolor $id
796 set currentparents {}
796 set currentparents {}
797 set dupparents {}
797 set dupparents {}
798 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
798 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
799 foreach p $parents($id) {
799 foreach p $parents($id) {
800 if {[lsearch -exact $currentparents $p] < 0} {
800 if {[lsearch -exact $currentparents $p] < 0} {
801 lappend currentparents $p
801 lappend currentparents $p
802 } else {
802 } else {
803 # remember that this parent was listed twice
803 # remember that this parent was listed twice
804 lappend dupparents $p
804 lappend dupparents $p
805 }
805 }
806 }
806 }
807 }
807 }
808 set x [xcoord $level $level $lineno]
808 set x [xcoord $level $level $lineno]
809 set y1 $canvy
809 set y1 $canvy
810 set canvy [expr $canvy + $linespc]
810 set canvy [expr $canvy + $linespc]
811 allcanvs conf -scrollregion \
811 allcanvs conf -scrollregion \
812 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
812 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
813 if {[info exists mainline($id)]} {
813 if {[info exists mainline($id)]} {
814 lappend mainline($id) $x $y1
814 lappend mainline($id) $x $y1
815 if {$mainlinearrow($id) ne "none"} {
815 if {$mainlinearrow($id) ne "none"} {
816 set mainline($id) [trimdiagstart $mainline($id)]
816 set mainline($id) [trimdiagstart $mainline($id)]
817 }
817 }
818 }
818 }
819 drawlines $id 0
819 drawlines $id 0
820 set orad [expr {$linespc / 3}]
820 set orad [expr {$linespc / 3}]
821 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
821 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
822 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
822 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
823 -fill $ofill -outline black -width 1]
823 -fill $ofill -outline black -width 1]
824 $canv raise $t
824 $canv raise $t
825 $canv bind $t <1> {selcanvline {} %x %y}
825 $canv bind $t <1> {selcanvline {} %x %y}
826 set xt [xcoord [llength $displist] $level $lineno]
826 set xt [xcoord [llength $displist] $level $lineno]
827 if {[llength $currentparents] > 2} {
827 if {[llength $currentparents] > 2} {
828 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
828 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
829 }
829 }
830 set rowtextx($lineno) $xt
830 set rowtextx($lineno) $xt
831 set idpos($id) [list $x $xt $y1]
831 set idpos($id) [list $x $xt $y1]
832 if {[info exists idtags($id)] || [info exists idheads($id)]
832 if {[info exists idtags($id)] || [info exists idheads($id)]
833 || [info exists idotherrefs($id)]} {
833 || [info exists idotherrefs($id)]} {
834 set xt [drawtags $id $x $xt $y1]
834 set xt [drawtags $id $x $xt $y1]
835 }
835 }
836 set headline [lindex $commitinfo($id) 0]
836 set headline [lindex $commitinfo($id) 0]
837 set name [lindex $commitinfo($id) 1]
837 set name [lindex $commitinfo($id) 1]
838 set date [lindex $commitinfo($id) 2]
838 set date [lindex $commitinfo($id) 2]
839 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
839 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
840 -text $headline -font $mainfont ]
840 -text $headline -font $mainfont ]
841 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
841 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
842 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
842 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
843 -text $name -font $namefont]
843 -text $name -font $namefont]
844 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
844 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
845 -text $date -font $mainfont]
845 -text $date -font $mainfont]
846
846
847 set olddlevel $level
847 set olddlevel $level
848 set olddisplist $displist
848 set olddisplist $displist
849 set oldnlines [llength $displist]
849 set oldnlines [llength $displist]
850 }
850 }
851
851
852 proc drawtags {id x xt y1} {
852 proc drawtags {id x xt y1} {
853 global idtags idheads idotherrefs
853 global idtags idheads idotherrefs
854 global linespc lthickness
854 global linespc lthickness
855 global canv mainfont idline rowtextx
855 global canv mainfont idline rowtextx
856
856
857 set marks {}
857 set marks {}
858 set ntags 0
858 set ntags 0
859 set nheads 0
859 set nheads 0
860 if {[info exists idtags($id)]} {
860 if {[info exists idtags($id)]} {
861 set marks $idtags($id)
861 set marks $idtags($id)
862 set ntags [llength $marks]
862 set ntags [llength $marks]
863 }
863 }
864 if {[info exists idheads($id)]} {
864 if {[info exists idheads($id)]} {
865 set marks [concat $marks $idheads($id)]
865 set marks [concat $marks $idheads($id)]
866 set nheads [llength $idheads($id)]
866 set nheads [llength $idheads($id)]
867 }
867 }
868 if {[info exists idotherrefs($id)]} {
868 if {[info exists idotherrefs($id)]} {
869 set marks [concat $marks $idotherrefs($id)]
869 set marks [concat $marks $idotherrefs($id)]
870 }
870 }
871 if {$marks eq {}} {
871 if {$marks eq {}} {
872 return $xt
872 return $xt
873 }
873 }
874
874
875 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
875 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
876 set yt [expr $y1 - 0.5 * $linespc]
876 set yt [expr $y1 - 0.5 * $linespc]
877 set yb [expr $yt + $linespc - 1]
877 set yb [expr $yt + $linespc - 1]
878 set xvals {}
878 set xvals {}
879 set wvals {}
879 set wvals {}
880 foreach tag $marks {
880 foreach tag $marks {
881 set wid [font measure $mainfont $tag]
881 set wid [font measure $mainfont $tag]
882 lappend xvals $xt
882 lappend xvals $xt
883 lappend wvals $wid
883 lappend wvals $wid
884 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
884 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
885 }
885 }
886 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
886 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
887 -width $lthickness -fill black -tags tag.$id]
887 -width $lthickness -fill black -tags tag.$id]
888 $canv lower $t
888 $canv lower $t
889 foreach tag $marks x $xvals wid $wvals {
889 foreach tag $marks x $xvals wid $wvals {
890 set xl [expr $x + $delta]
890 set xl [expr $x + $delta]
891 set xr [expr $x + $delta + $wid + $lthickness]
891 set xr [expr $x + $delta + $wid + $lthickness]
892 if {[incr ntags -1] >= 0} {
892 if {[incr ntags -1] >= 0} {
893 # draw a tag
893 # draw a tag
894 set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
894 set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
895 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
895 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
896 -width 1 -outline black -fill yellow -tags tag.$id]
896 -width 1 -outline black -fill yellow -tags tag.$id]
897 $canv bind $t <1> [list showtag $tag 1]
897 $canv bind $t <1> [list showtag $tag 1]
898 set rowtextx($idline($id)) [expr {$xr + $linespc}]
898 set rowtextx($idline($id)) [expr {$xr + $linespc}]
899 } else {
899 } else {
900 # draw a head or other ref
900 # draw a head or other ref
901 if {[incr nheads -1] >= 0} {
901 if {[incr nheads -1] >= 0} {
902 set col green
902 set col green
903 } else {
903 } else {
904 set col "#ddddff"
904 set col "#ddddff"
905 }
905 }
906 set xl [expr $xl - $delta/2]
906 set xl [expr $xl - $delta/2]
907 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
907 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
908 -width 1 -outline black -fill $col -tags tag.$id
908 -width 1 -outline black -fill $col -tags tag.$id
909 }
909 }
910 set t [$canv create text $xl $y1 -anchor w -text $tag \
910 set t [$canv create text $xl $y1 -anchor w -text $tag \
911 -font $mainfont -tags tag.$id]
911 -font $mainfont -tags tag.$id]
912 if {$ntags >= 0} {
912 if {$ntags >= 0} {
913 $canv bind $t <1> [list showtag $tag 1]
913 $canv bind $t <1> [list showtag $tag 1]
914 }
914 }
915 }
915 }
916 return $xt
916 return $xt
917 }
917 }
918
918
919 proc notecrossings {id lo hi corner} {
919 proc notecrossings {id lo hi corner} {
920 global olddisplist crossings cornercrossings
920 global olddisplist crossings cornercrossings
921
921
922 for {set i $lo} {[incr i] < $hi} {} {
922 for {set i $lo} {[incr i] < $hi} {} {
923 set p [lindex $olddisplist $i]
923 set p [lindex $olddisplist $i]
924 if {$p == {}} continue
924 if {$p == {}} continue
925 if {$i == $corner} {
925 if {$i == $corner} {
926 if {![info exists cornercrossings($id)]
926 if {![info exists cornercrossings($id)]
927 || [lsearch -exact $cornercrossings($id) $p] < 0} {
927 || [lsearch -exact $cornercrossings($id) $p] < 0} {
928 lappend cornercrossings($id) $p
928 lappend cornercrossings($id) $p
929 }
929 }
930 if {![info exists cornercrossings($p)]
930 if {![info exists cornercrossings($p)]
931 || [lsearch -exact $cornercrossings($p) $id] < 0} {
931 || [lsearch -exact $cornercrossings($p) $id] < 0} {
932 lappend cornercrossings($p) $id
932 lappend cornercrossings($p) $id
933 }
933 }
934 } else {
934 } else {
935 if {![info exists crossings($id)]
935 if {![info exists crossings($id)]
936 || [lsearch -exact $crossings($id) $p] < 0} {
936 || [lsearch -exact $crossings($id) $p] < 0} {
937 lappend crossings($id) $p
937 lappend crossings($id) $p
938 }
938 }
939 if {![info exists crossings($p)]
939 if {![info exists crossings($p)]
940 || [lsearch -exact $crossings($p) $id] < 0} {
940 || [lsearch -exact $crossings($p) $id] < 0} {
941 lappend crossings($p) $id
941 lappend crossings($p) $id
942 }
942 }
943 }
943 }
944 }
944 }
945 }
945 }
946
946
947 proc xcoord {i level ln} {
947 proc xcoord {i level ln} {
948 global canvx0 xspc1 xspc2
948 global canvx0 xspc1 xspc2
949
949
950 set x [expr {$canvx0 + $i * $xspc1($ln)}]
950 set x [expr {$canvx0 + $i * $xspc1($ln)}]
951 if {$i > 0 && $i == $level} {
951 if {$i > 0 && $i == $level} {
952 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
952 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
953 } elseif {$i > $level} {
953 } elseif {$i > $level} {
954 set x [expr {$x + $xspc2 - $xspc1($ln)}]
954 set x [expr {$x + $xspc2 - $xspc1($ln)}]
955 }
955 }
956 return $x
956 return $x
957 }
957 }
958
958
959 # it seems Tk can't draw arrows on the end of diagonal line segments...
959 # it seems Tk can't draw arrows on the end of diagonal line segments...
960 proc trimdiagend {line} {
960 proc trimdiagend {line} {
961 while {[llength $line] > 4} {
961 while {[llength $line] > 4} {
962 set x1 [lindex $line end-3]
962 set x1 [lindex $line end-3]
963 set y1 [lindex $line end-2]
963 set y1 [lindex $line end-2]
964 set x2 [lindex $line end-1]
964 set x2 [lindex $line end-1]
965 set y2 [lindex $line end]
965 set y2 [lindex $line end]
966 if {($x1 == $x2) != ($y1 == $y2)} break
966 if {($x1 == $x2) != ($y1 == $y2)} break
967 set line [lreplace $line end-1 end]
967 set line [lreplace $line end-1 end]
968 }
968 }
969 return $line
969 return $line
970 }
970 }
971
971
972 proc trimdiagstart {line} {
972 proc trimdiagstart {line} {
973 while {[llength $line] > 4} {
973 while {[llength $line] > 4} {
974 set x1 [lindex $line 0]
974 set x1 [lindex $line 0]
975 set y1 [lindex $line 1]
975 set y1 [lindex $line 1]
976 set x2 [lindex $line 2]
976 set x2 [lindex $line 2]
977 set y2 [lindex $line 3]
977 set y2 [lindex $line 3]
978 if {($x1 == $x2) != ($y1 == $y2)} break
978 if {($x1 == $x2) != ($y1 == $y2)} break
979 set line [lreplace $line 0 1]
979 set line [lreplace $line 0 1]
980 }
980 }
981 return $line
981 return $line
982 }
982 }
983
983
984 proc drawslants {id needonscreen nohs} {
984 proc drawslants {id needonscreen nohs} {
985 global canv mainline mainlinearrow sidelines
985 global canv mainline mainlinearrow sidelines
986 global canvx0 canvy xspc1 xspc2 lthickness
986 global canvx0 canvy xspc1 xspc2 lthickness
987 global currentparents dupparents
987 global currentparents dupparents
988 global lthickness linespc canvy colormap lineno geometry
988 global lthickness linespc canvy colormap lineno geometry
989 global maxgraphpct maxwidth
989 global maxgraphpct maxwidth
990 global displist onscreen lastuse
990 global displist onscreen lastuse
991 global parents commitlisted
991 global parents commitlisted
992 global oldnlines olddlevel olddisplist
992 global oldnlines olddlevel olddisplist
993 global nhyperspace numcommits nnewparents
993 global nhyperspace numcommits nnewparents
994
994
995 if {$lineno < 0} {
995 if {$lineno < 0} {
996 lappend displist $id
996 lappend displist $id
997 set onscreen($id) 1
997 set onscreen($id) 1
998 return 0
998 return 0
999 }
999 }
1000
1000
1001 set y1 [expr {$canvy - $linespc}]
1001 set y1 [expr {$canvy - $linespc}]
1002 set y2 $canvy
1002 set y2 $canvy
1003
1003
1004 # work out what we need to get back on screen
1004 # work out what we need to get back on screen
1005 set reins {}
1005 set reins {}
1006 if {$onscreen($id) < 0} {
1006 if {$onscreen($id) < 0} {
1007 # next to do isn't displayed, better get it on screen...
1007 # next to do isn't displayed, better get it on screen...
1008 lappend reins [list $id 0]
1008 lappend reins [list $id 0]
1009 }
1009 }
1010 # make sure all the previous commits's parents are on the screen
1010 # make sure all the previous commits's parents are on the screen
1011 foreach p $currentparents {
1011 foreach p $currentparents {
1012 if {$onscreen($p) < 0} {
1012 if {$onscreen($p) < 0} {
1013 lappend reins [list $p 0]
1013 lappend reins [list $p 0]
1014 }
1014 }
1015 }
1015 }
1016 # bring back anything requested by caller
1016 # bring back anything requested by caller
1017 if {$needonscreen ne {}} {
1017 if {$needonscreen ne {}} {
1018 lappend reins $needonscreen
1018 lappend reins $needonscreen
1019 }
1019 }
1020
1020
1021 # try the shortcut
1021 # try the shortcut
1022 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1022 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1023 set dlevel $olddlevel
1023 set dlevel $olddlevel
1024 set x [xcoord $dlevel $dlevel $lineno]
1024 set x [xcoord $dlevel $dlevel $lineno]
1025 set mainline($id) [list $x $y1]
1025 set mainline($id) [list $x $y1]
1026 set mainlinearrow($id) none
1026 set mainlinearrow($id) none
1027 set lastuse($id) $lineno
1027 set lastuse($id) $lineno
1028 set displist [lreplace $displist $dlevel $dlevel $id]
1028 set displist [lreplace $displist $dlevel $dlevel $id]
1029 set onscreen($id) 1
1029 set onscreen($id) 1
1030 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1030 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1031 return $dlevel
1031 return $dlevel
1032 }
1032 }
1033
1033
1034 # update displist
1034 # update displist
1035 set displist [lreplace $displist $olddlevel $olddlevel]
1035 set displist [lreplace $displist $olddlevel $olddlevel]
1036 set j $olddlevel
1036 set j $olddlevel
1037 foreach p $currentparents {
1037 foreach p $currentparents {
1038 set lastuse($p) $lineno
1038 set lastuse($p) $lineno
1039 if {$onscreen($p) == 0} {
1039 if {$onscreen($p) == 0} {
1040 set displist [linsert $displist $j $p]
1040 set displist [linsert $displist $j $p]
1041 set onscreen($p) 1
1041 set onscreen($p) 1
1042 incr j
1042 incr j
1043 }
1043 }
1044 }
1044 }
1045 if {$onscreen($id) == 0} {
1045 if {$onscreen($id) == 0} {
1046 lappend displist $id
1046 lappend displist $id
1047 set onscreen($id) 1
1047 set onscreen($id) 1
1048 }
1048 }
1049
1049
1050 # remove the null entry if present
1050 # remove the null entry if present
1051 set nullentry [lsearch -exact $displist {}]
1051 set nullentry [lsearch -exact $displist {}]
1052 if {$nullentry >= 0} {
1052 if {$nullentry >= 0} {
1053 set displist [lreplace $displist $nullentry $nullentry]
1053 set displist [lreplace $displist $nullentry $nullentry]
1054 }
1054 }
1055
1055
1056 # bring back the ones we need now (if we did it earlier
1056 # bring back the ones we need now (if we did it earlier
1057 # it would change displist and invalidate olddlevel)
1057 # it would change displist and invalidate olddlevel)
1058 foreach pi $reins {
1058 foreach pi $reins {
1059 # test again in case of duplicates in reins
1059 # test again in case of duplicates in reins
1060 set p [lindex $pi 0]
1060 set p [lindex $pi 0]
1061 if {$onscreen($p) < 0} {
1061 if {$onscreen($p) < 0} {
1062 set onscreen($p) 1
1062 set onscreen($p) 1
1063 set lastuse($p) $lineno
1063 set lastuse($p) $lineno
1064 set displist [linsert $displist [lindex $pi 1] $p]
1064 set displist [linsert $displist [lindex $pi 1] $p]
1065 incr nhyperspace -1
1065 incr nhyperspace -1
1066 }
1066 }
1067 }
1067 }
1068
1068
1069 set lastuse($id) $lineno
1069 set lastuse($id) $lineno
1070
1070
1071 # see if we need to make any lines jump off into hyperspace
1071 # see if we need to make any lines jump off into hyperspace
1072 set displ [llength $displist]
1072 set displ [llength $displist]
1073 if {$displ > $maxwidth} {
1073 if {$displ > $maxwidth} {
1074 set ages {}
1074 set ages {}
1075 foreach x $displist {
1075 foreach x $displist {
1076 lappend ages [list $lastuse($x) $x]
1076 lappend ages [list $lastuse($x) $x]
1077 }
1077 }
1078 set ages [lsort -integer -index 0 $ages]
1078 set ages [lsort -integer -index 0 $ages]
1079 set k 0
1079 set k 0
1080 while {$displ > $maxwidth} {
1080 while {$displ > $maxwidth} {
1081 set use [lindex $ages $k 0]
1081 set use [lindex $ages $k 0]
1082 set victim [lindex $ages $k 1]
1082 set victim [lindex $ages $k 1]
1083 if {$use >= $lineno - 5} break
1083 if {$use >= $lineno - 5} break
1084 incr k
1084 incr k
1085 if {[lsearch -exact $nohs $victim] >= 0} continue
1085 if {[lsearch -exact $nohs $victim] >= 0} continue
1086 set i [lsearch -exact $displist $victim]
1086 set i [lsearch -exact $displist $victim]
1087 set displist [lreplace $displist $i $i]
1087 set displist [lreplace $displist $i $i]
1088 set onscreen($victim) -1
1088 set onscreen($victim) -1
1089 incr nhyperspace
1089 incr nhyperspace
1090 incr displ -1
1090 incr displ -1
1091 if {$i < $nullentry} {
1091 if {$i < $nullentry} {
1092 incr nullentry -1
1092 incr nullentry -1
1093 }
1093 }
1094 set x [lindex $mainline($victim) end-1]
1094 set x [lindex $mainline($victim) end-1]
1095 lappend mainline($victim) $x $y1
1095 lappend mainline($victim) $x $y1
1096 set line [trimdiagend $mainline($victim)]
1096 set line [trimdiagend $mainline($victim)]
1097 set arrow "last"
1097 set arrow "last"
1098 if {$mainlinearrow($victim) ne "none"} {
1098 if {$mainlinearrow($victim) ne "none"} {
1099 set line [trimdiagstart $line]
1099 set line [trimdiagstart $line]
1100 set arrow "both"
1100 set arrow "both"
1101 }
1101 }
1102 lappend sidelines($victim) [list $line 1 $arrow]
1102 lappend sidelines($victim) [list $line 1 $arrow]
1103 unset mainline($victim)
1103 unset mainline($victim)
1104 }
1104 }
1105 }
1105 }
1106
1106
1107 set dlevel [lsearch -exact $displist $id]
1107 set dlevel [lsearch -exact $displist $id]
1108
1108
1109 # If we are reducing, put in a null entry
1109 # If we are reducing, put in a null entry
1110 if {$displ < $oldnlines} {
1110 if {$displ < $oldnlines} {
1111 # does the next line look like a merge?
1111 # does the next line look like a merge?
1112 # i.e. does it have > 1 new parent?
1112 # i.e. does it have > 1 new parent?
1113 if {$nnewparents($id) > 1} {
1113 if {$nnewparents($id) > 1} {
1114 set i [expr {$dlevel + 1}]
1114 set i [expr {$dlevel + 1}]
1115 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1115 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1116 set i $olddlevel
1116 set i $olddlevel
1117 if {$nullentry >= 0 && $nullentry < $i} {
1117 if {$nullentry >= 0 && $nullentry < $i} {
1118 incr i -1
1118 incr i -1
1119 }
1119 }
1120 } elseif {$nullentry >= 0} {
1120 } elseif {$nullentry >= 0} {
1121 set i $nullentry
1121 set i $nullentry
1122 while {$i < $displ
1122 while {$i < $displ
1123 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1123 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1124 incr i
1124 incr i
1125 }
1125 }
1126 } else {
1126 } else {
1127 set i $olddlevel
1127 set i $olddlevel
1128 if {$dlevel >= $i} {
1128 if {$dlevel >= $i} {
1129 incr i
1129 incr i
1130 }
1130 }
1131 }
1131 }
1132 if {$i < $displ} {
1132 if {$i < $displ} {
1133 set displist [linsert $displist $i {}]
1133 set displist [linsert $displist $i {}]
1134 incr displ
1134 incr displ
1135 if {$dlevel >= $i} {
1135 if {$dlevel >= $i} {
1136 incr dlevel
1136 incr dlevel
1137 }
1137 }
1138 }
1138 }
1139 }
1139 }
1140
1140
1141 # decide on the line spacing for the next line
1141 # decide on the line spacing for the next line
1142 set lj [expr {$lineno + 1}]
1142 set lj [expr {$lineno + 1}]
1143 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1143 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1144 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1144 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1145 set xspc1($lj) $xspc2
1145 set xspc1($lj) $xspc2
1146 } else {
1146 } else {
1147 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1147 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1148 if {$xspc1($lj) < $lthickness} {
1148 if {$xspc1($lj) < $lthickness} {
1149 set xspc1($lj) $lthickness
1149 set xspc1($lj) $lthickness
1150 }
1150 }
1151 }
1151 }
1152
1152
1153 foreach idi $reins {
1153 foreach idi $reins {
1154 set id [lindex $idi 0]
1154 set id [lindex $idi 0]
1155 set j [lsearch -exact $displist $id]
1155 set j [lsearch -exact $displist $id]
1156 set xj [xcoord $j $dlevel $lj]
1156 set xj [xcoord $j $dlevel $lj]
1157 set mainline($id) [list $xj $y2]
1157 set mainline($id) [list $xj $y2]
1158 set mainlinearrow($id) first
1158 set mainlinearrow($id) first
1159 }
1159 }
1160
1160
1161 set i -1
1161 set i -1
1162 foreach id $olddisplist {
1162 foreach id $olddisplist {
1163 incr i
1163 incr i
1164 if {$id == {}} continue
1164 if {$id == {}} continue
1165 if {$onscreen($id) <= 0} continue
1165 if {$onscreen($id) <= 0} continue
1166 set xi [xcoord $i $olddlevel $lineno]
1166 set xi [xcoord $i $olddlevel $lineno]
1167 if {$i == $olddlevel} {
1167 if {$i == $olddlevel} {
1168 foreach p $currentparents {
1168 foreach p $currentparents {
1169 set j [lsearch -exact $displist $p]
1169 set j [lsearch -exact $displist $p]
1170 set coords [list $xi $y1]
1170 set coords [list $xi $y1]
1171 set xj [xcoord $j $dlevel $lj]
1171 set xj [xcoord $j $dlevel $lj]
1172 if {$xj < $xi - $linespc} {
1172 if {$xj < $xi - $linespc} {
1173 lappend coords [expr {$xj + $linespc}] $y1
1173 lappend coords [expr {$xj + $linespc}] $y1
1174 notecrossings $p $j $i [expr {$j + 1}]
1174 notecrossings $p $j $i [expr {$j + 1}]
1175 } elseif {$xj > $xi + $linespc} {
1175 } elseif {$xj > $xi + $linespc} {
1176 lappend coords [expr {$xj - $linespc}] $y1
1176 lappend coords [expr {$xj - $linespc}] $y1
1177 notecrossings $p $i $j [expr {$j - 1}]
1177 notecrossings $p $i $j [expr {$j - 1}]
1178 }
1178 }
1179 if {[lsearch -exact $dupparents $p] >= 0} {
1179 if {[lsearch -exact $dupparents $p] >= 0} {
1180 # draw a double-width line to indicate the doubled parent
1180 # draw a double-width line to indicate the doubled parent
1181 lappend coords $xj $y2
1181 lappend coords $xj $y2
1182 lappend sidelines($p) [list $coords 2 none]
1182 lappend sidelines($p) [list $coords 2 none]
1183 if {![info exists mainline($p)]} {
1183 if {![info exists mainline($p)]} {
1184 set mainline($p) [list $xj $y2]
1184 set mainline($p) [list $xj $y2]
1185 set mainlinearrow($p) none
1185 set mainlinearrow($p) none
1186 }
1186 }
1187 } else {
1187 } else {
1188 # normal case, no parent duplicated
1188 # normal case, no parent duplicated
1189 set yb $y2
1189 set yb $y2
1190 set dx [expr {abs($xi - $xj)}]
1190 set dx [expr {abs($xi - $xj)}]
1191 if {0 && $dx < $linespc} {
1191 if {0 && $dx < $linespc} {
1192 set yb [expr {$y1 + $dx}]
1192 set yb [expr {$y1 + $dx}]
1193 }
1193 }
1194 if {![info exists mainline($p)]} {
1194 if {![info exists mainline($p)]} {
1195 if {$xi != $xj} {
1195 if {$xi != $xj} {
1196 lappend coords $xj $yb
1196 lappend coords $xj $yb
1197 }
1197 }
1198 set mainline($p) $coords
1198 set mainline($p) $coords
1199 set mainlinearrow($p) none
1199 set mainlinearrow($p) none
1200 } else {
1200 } else {
1201 lappend coords $xj $yb
1201 lappend coords $xj $yb
1202 if {$yb < $y2} {
1202 if {$yb < $y2} {
1203 lappend coords $xj $y2
1203 lappend coords $xj $y2
1204 }
1204 }
1205 lappend sidelines($p) [list $coords 1 none]
1205 lappend sidelines($p) [list $coords 1 none]
1206 }
1206 }
1207 }
1207 }
1208 }
1208 }
1209 } else {
1209 } else {
1210 set j $i
1210 set j $i
1211 if {[lindex $displist $i] != $id} {
1211 if {[lindex $displist $i] != $id} {
1212 set j [lsearch -exact $displist $id]
1212 set j [lsearch -exact $displist $id]
1213 }
1213 }
1214 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1214 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1215 || ($olddlevel < $i && $i < $dlevel)
1215 || ($olddlevel < $i && $i < $dlevel)
1216 || ($dlevel < $i && $i < $olddlevel)} {
1216 || ($dlevel < $i && $i < $olddlevel)} {
1217 set xj [xcoord $j $dlevel $lj]
1217 set xj [xcoord $j $dlevel $lj]
1218 lappend mainline($id) $xi $y1 $xj $y2
1218 lappend mainline($id) $xi $y1 $xj $y2
1219 }
1219 }
1220 }
1220 }
1221 }
1221 }
1222 return $dlevel
1222 return $dlevel
1223 }
1223 }
1224
1224
1225 # search for x in a list of lists
1225 # search for x in a list of lists
1226 proc llsearch {llist x} {
1226 proc llsearch {llist x} {
1227 set i 0
1227 set i 0
1228 foreach l $llist {
1228 foreach l $llist {
1229 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1229 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1230 return $i
1230 return $i
1231 }
1231 }
1232 incr i
1232 incr i
1233 }
1233 }
1234 return -1
1234 return -1
1235 }
1235 }
1236
1236
1237 proc drawmore {reading} {
1237 proc drawmore {reading} {
1238 global displayorder numcommits ncmupdate nextupdate
1238 global displayorder numcommits ncmupdate nextupdate
1239 global stopped nhyperspace parents commitlisted
1239 global stopped nhyperspace parents commitlisted
1240 global maxwidth onscreen displist currentparents olddlevel
1240 global maxwidth onscreen displist currentparents olddlevel
1241
1241
1242 set n [llength $displayorder]
1242 set n [llength $displayorder]
1243 while {$numcommits < $n} {
1243 while {$numcommits < $n} {
1244 set id [lindex $displayorder $numcommits]
1244 set id [lindex $displayorder $numcommits]
1245 set ctxend [expr {$numcommits + 10}]
1245 set ctxend [expr {$numcommits + 10}]
1246 if {!$reading && $ctxend > $n} {
1246 if {!$reading && $ctxend > $n} {
1247 set ctxend $n
1247 set ctxend $n
1248 }
1248 }
1249 set dlist {}
1249 set dlist {}
1250 if {$numcommits > 0} {
1250 if {$numcommits > 0} {
1251 set dlist [lreplace $displist $olddlevel $olddlevel]
1251 set dlist [lreplace $displist $olddlevel $olddlevel]
1252 set i $olddlevel
1252 set i $olddlevel
1253 foreach p $currentparents {
1253 foreach p $currentparents {
1254 if {$onscreen($p) == 0} {
1254 if {$onscreen($p) == 0} {
1255 set dlist [linsert $dlist $i $p]
1255 set dlist [linsert $dlist $i $p]
1256 incr i
1256 incr i
1257 }
1257 }
1258 }
1258 }
1259 }
1259 }
1260 set nohs {}
1260 set nohs {}
1261 set reins {}
1261 set reins {}
1262 set isfat [expr {[llength $dlist] > $maxwidth}]
1262 set isfat [expr {[llength $dlist] > $maxwidth}]
1263 if {$nhyperspace > 0 || $isfat} {
1263 if {$nhyperspace > 0 || $isfat} {
1264 if {$ctxend > $n} break
1264 if {$ctxend > $n} break
1265 # work out what to bring back and
1265 # work out what to bring back and
1266 # what we want to don't want to send into hyperspace
1266 # what we want to don't want to send into hyperspace
1267 set room 1
1267 set room 1
1268 for {set k $numcommits} {$k < $ctxend} {incr k} {
1268 for {set k $numcommits} {$k < $ctxend} {incr k} {
1269 set x [lindex $displayorder $k]
1269 set x [lindex $displayorder $k]
1270 set i [llsearch $dlist $x]
1270 set i [llsearch $dlist $x]
1271 if {$i < 0} {
1271 if {$i < 0} {
1272 set i [llength $dlist]
1272 set i [llength $dlist]
1273 lappend dlist $x
1273 lappend dlist $x
1274 }
1274 }
1275 if {[lsearch -exact $nohs $x] < 0} {
1275 if {[lsearch -exact $nohs $x] < 0} {
1276 lappend nohs $x
1276 lappend nohs $x
1277 }
1277 }
1278 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1278 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1279 set reins [list $x $i]
1279 set reins [list $x $i]
1280 }
1280 }
1281 set newp {}
1281 set newp {}
1282 if {[info exists commitlisted($x)]} {
1282 if {[info exists commitlisted($x)]} {
1283 set right 0
1283 set right 0
1284 foreach p $parents($x) {
1284 foreach p $parents($x) {
1285 if {[llsearch $dlist $p] < 0} {
1285 if {[llsearch $dlist $p] < 0} {
1286 lappend newp $p
1286 lappend newp $p
1287 if {[lsearch -exact $nohs $p] < 0} {
1287 if {[lsearch -exact $nohs $p] < 0} {
1288 lappend nohs $p
1288 lappend nohs $p
1289 }
1289 }
1290 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1290 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1291 set reins [list $p [expr {$i + $right}]]
1291 set reins [list $p [expr {$i + $right}]]
1292 }
1292 }
1293 }
1293 }
1294 set right 1
1294 set right 1
1295 }
1295 }
1296 }
1296 }
1297 set l [lindex $dlist $i]
1297 set l [lindex $dlist $i]
1298 if {[llength $l] == 1} {
1298 if {[llength $l] == 1} {
1299 set l $newp
1299 set l $newp
1300 } else {
1300 } else {
1301 set j [lsearch -exact $l $x]
1301 set j [lsearch -exact $l $x]
1302 set l [concat [lreplace $l $j $j] $newp]
1302 set l [concat [lreplace $l $j $j] $newp]
1303 }
1303 }
1304 set dlist [lreplace $dlist $i $i $l]
1304 set dlist [lreplace $dlist $i $i $l]
1305 if {$room && $isfat && [llength $newp] <= 1} {
1305 if {$room && $isfat && [llength $newp] <= 1} {
1306 set room 0
1306 set room 0
1307 }
1307 }
1308 }
1308 }
1309 }
1309 }
1310
1310
1311 set dlevel [drawslants $id $reins $nohs]
1311 set dlevel [drawslants $id $reins $nohs]
1312 drawcommitline $dlevel
1312 drawcommitline $dlevel
1313 if {[clock clicks -milliseconds] >= $nextupdate
1313 if {[clock clicks -milliseconds] >= $nextupdate
1314 && $numcommits >= $ncmupdate} {
1314 && $numcommits >= $ncmupdate} {
1315 doupdate $reading
1315 doupdate $reading
1316 if {$stopped} break
1316 if {$stopped} break
1317 }
1317 }
1318 }
1318 }
1319 }
1319 }
1320
1320
1321 # level here is an index in todo
1321 # level here is an index in todo
1322 proc updatetodo {level noshortcut} {
1322 proc updatetodo {level noshortcut} {
1323 global ncleft todo nnewparents
1323 global ncleft todo nnewparents
1324 global commitlisted parents onscreen
1324 global commitlisted parents onscreen
1325
1325
1326 set id [lindex $todo $level]
1326 set id [lindex $todo $level]
1327 set olds {}
1327 set olds {}
1328 if {[info exists commitlisted($id)]} {
1328 if {[info exists commitlisted($id)]} {
1329 foreach p $parents($id) {
1329 foreach p $parents($id) {
1330 if {[lsearch -exact $olds $p] < 0} {
1330 if {[lsearch -exact $olds $p] < 0} {
1331 lappend olds $p
1331 lappend olds $p
1332 }
1332 }
1333 }
1333 }
1334 }
1334 }
1335 if {!$noshortcut && [llength $olds] == 1} {
1335 if {!$noshortcut && [llength $olds] == 1} {
1336 set p [lindex $olds 0]
1336 set p [lindex $olds 0]
1337 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1337 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1338 set ncleft($p) 0
1338 set ncleft($p) 0
1339 set todo [lreplace $todo $level $level $p]
1339 set todo [lreplace $todo $level $level $p]
1340 set onscreen($p) 0
1340 set onscreen($p) 0
1341 set nnewparents($id) 1
1341 set nnewparents($id) 1
1342 return 0
1342 return 0
1343 }
1343 }
1344 }
1344 }
1345
1345
1346 set todo [lreplace $todo $level $level]
1346 set todo [lreplace $todo $level $level]
1347 set i $level
1347 set i $level
1348 set n 0
1348 set n 0
1349 foreach p $olds {
1349 foreach p $olds {
1350 incr ncleft($p) -1
1350 incr ncleft($p) -1
1351 set k [lsearch -exact $todo $p]
1351 set k [lsearch -exact $todo $p]
1352 if {$k < 0} {
1352 if {$k < 0} {
1353 set todo [linsert $todo $i $p]
1353 set todo [linsert $todo $i $p]
1354 set onscreen($p) 0
1354 set onscreen($p) 0
1355 incr i
1355 incr i
1356 incr n
1356 incr n
1357 }
1357 }
1358 }
1358 }
1359 set nnewparents($id) $n
1359 set nnewparents($id) $n
1360
1360
1361 return 1
1361 return 1
1362 }
1362 }
1363
1363
1364 proc decidenext {{noread 0}} {
1364 proc decidenext {{noread 0}} {
1365 global ncleft todo
1365 global ncleft todo
1366 global datemode cdate
1366 global datemode cdate
1367 global commitinfo
1367 global commitinfo
1368
1368
1369 # choose which one to do next time around
1369 # choose which one to do next time around
1370 set todol [llength $todo]
1370 set todol [llength $todo]
1371 set level -1
1371 set level -1
1372 set latest {}
1372 set latest {}
1373 for {set k $todol} {[incr k -1] >= 0} {} {
1373 for {set k $todol} {[incr k -1] >= 0} {} {
1374 set p [lindex $todo $k]
1374 set p [lindex $todo $k]
1375 if {$ncleft($p) == 0} {
1375 if {$ncleft($p) == 0} {
1376 if {$datemode} {
1376 if {$datemode} {
1377 if {![info exists commitinfo($p)]} {
1377 if {![info exists commitinfo($p)]} {
1378 if {$noread} {
1378 if {$noread} {
1379 return {}
1379 return {}
1380 }
1380 }
1381 readcommit $p
1381 readcommit $p
1382 }
1382 }
1383 if {$latest == {} || $cdate($p) > $latest} {
1383 if {$latest == {} || $cdate($p) > $latest} {
1384 set level $k
1384 set level $k
1385 set latest $cdate($p)
1385 set latest $cdate($p)
1386 }
1386 }
1387 } else {
1387 } else {
1388 set level $k
1388 set level $k
1389 break
1389 break
1390 }
1390 }
1391 }
1391 }
1392 }
1392 }
1393 if {$level < 0} {
1393 if {$level < 0} {
1394 if {$todo != {}} {
1394 if {$todo != {}} {
1395 puts "ERROR: none of the pending commits can be done yet:"
1395 puts "ERROR: none of the pending commits can be done yet:"
1396 foreach p $todo {
1396 foreach p $todo {
1397 puts " $p ($ncleft($p))"
1397 puts " $p ($ncleft($p))"
1398 }
1398 }
1399 }
1399 }
1400 return -1
1400 return -1
1401 }
1401 }
1402
1402
1403 return $level
1403 return $level
1404 }
1404 }
1405
1405
1406 proc drawcommit {id} {
1406 proc drawcommit {id} {
1407 global phase todo nchildren datemode nextupdate
1407 global phase todo nchildren datemode nextupdate
1408 global numcommits ncmupdate displayorder todo onscreen
1408 global numcommits ncmupdate displayorder todo onscreen
1409
1409
1410 if {$phase != "incrdraw"} {
1410 if {$phase != "incrdraw"} {
1411 set phase incrdraw
1411 set phase incrdraw
1412 set displayorder {}
1412 set displayorder {}
1413 set todo {}
1413 set todo {}
1414 initgraph
1414 initgraph
1415 }
1415 }
1416 if {$nchildren($id) == 0} {
1416 if {$nchildren($id) == 0} {
1417 lappend todo $id
1417 lappend todo $id
1418 set onscreen($id) 0
1418 set onscreen($id) 0
1419 }
1419 }
1420 set level [decidenext 1]
1420 set level [decidenext 1]
1421 if {$level == {} || $id != [lindex $todo $level]} {
1421 if {$level == {} || $id != [lindex $todo $level]} {
1422 return
1422 return
1423 }
1423 }
1424 while 1 {
1424 while 1 {
1425 lappend displayorder [lindex $todo $level]
1425 lappend displayorder [lindex $todo $level]
1426 if {[updatetodo $level $datemode]} {
1426 if {[updatetodo $level $datemode]} {
1427 set level [decidenext 1]
1427 set level [decidenext 1]
1428 if {$level == {}} break
1428 if {$level == {}} break
1429 }
1429 }
1430 set id [lindex $todo $level]
1430 set id [lindex $todo $level]
1431 if {![info exists commitlisted($id)]} {
1431 if {![info exists commitlisted($id)]} {
1432 break
1432 break
1433 }
1433 }
1434 }
1434 }
1435 drawmore 1
1435 drawmore 1
1436 }
1436 }
1437
1437
1438 proc finishcommits {} {
1438 proc finishcommits {} {
1439 global phase
1439 global phase
1440 global canv mainfont ctext maincursor textcursor
1440 global canv mainfont ctext maincursor textcursor
1441
1441
1442 if {$phase != "incrdraw"} {
1442 if {$phase != "incrdraw"} {
1443 $canv delete all
1443 $canv delete all
1444 $canv create text 3 3 -anchor nw -text "No commits selected" \
1444 $canv create text 3 3 -anchor nw -text "No commits selected" \
1445 -font $mainfont -tags textitems
1445 -font $mainfont -tags textitems
1446 set phase {}
1446 set phase {}
1447 } else {
1447 } else {
1448 drawrest
1448 drawrest
1449 }
1449 }
1450 . config -cursor $maincursor
1450 . config -cursor $maincursor
1451 settextcursor $textcursor
1451 settextcursor $textcursor
1452 }
1452 }
1453
1453
1454 # Don't change the text pane cursor if it is currently the hand cursor,
1454 # Don't change the text pane cursor if it is currently the hand cursor,
1455 # showing that we are over a sha1 ID link.
1455 # showing that we are over a sha1 ID link.
1456 proc settextcursor {c} {
1456 proc settextcursor {c} {
1457 global ctext curtextcursor
1457 global ctext curtextcursor
1458
1458
1459 if {[$ctext cget -cursor] == $curtextcursor} {
1459 if {[$ctext cget -cursor] == $curtextcursor} {
1460 $ctext config -cursor $c
1460 $ctext config -cursor $c
1461 }
1461 }
1462 set curtextcursor $c
1462 set curtextcursor $c
1463 }
1463 }
1464
1464
1465 proc drawgraph {} {
1465 proc drawgraph {} {
1466 global nextupdate startmsecs ncmupdate
1466 global nextupdate startmsecs ncmupdate
1467 global displayorder onscreen
1467 global displayorder onscreen
1468
1468
1469 if {$displayorder == {}} return
1469 if {$displayorder == {}} return
1470 set startmsecs [clock clicks -milliseconds]
1470 set startmsecs [clock clicks -milliseconds]
1471 set nextupdate [expr $startmsecs + 100]
1471 set nextupdate [expr $startmsecs + 100]
1472 set ncmupdate 1
1472 set ncmupdate 1
1473 initgraph
1473 initgraph
1474 foreach id $displayorder {
1474 foreach id $displayorder {
1475 set onscreen($id) 0
1475 set onscreen($id) 0
1476 }
1476 }
1477 drawmore 0
1477 drawmore 0
1478 }
1478 }
1479
1479
1480 proc drawrest {} {
1480 proc drawrest {} {
1481 global phase stopped redisplaying selectedline
1481 global phase stopped redisplaying selectedline
1482 global datemode todo displayorder
1482 global datemode todo displayorder
1483 global numcommits ncmupdate
1483 global numcommits ncmupdate
1484 global nextupdate startmsecs
1484 global nextupdate startmsecs
1485
1485
1486 set level [decidenext]
1486 set level [decidenext]
1487 if {$level >= 0} {
1487 if {$level >= 0} {
1488 set phase drawgraph
1488 set phase drawgraph
1489 while 1 {
1489 while 1 {
1490 lappend displayorder [lindex $todo $level]
1490 lappend displayorder [lindex $todo $level]
1491 set hard [updatetodo $level $datemode]
1491 set hard [updatetodo $level $datemode]
1492 if {$hard} {
1492 if {$hard} {
1493 set level [decidenext]
1493 set level [decidenext]
1494 if {$level < 0} break
1494 if {$level < 0} break
1495 }
1495 }
1496 }
1496 }
1497 drawmore 0
1497 drawmore 0
1498 }
1498 }
1499 set phase {}
1499 set phase {}
1500 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1500 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1501 #puts "overall $drawmsecs ms for $numcommits commits"
1501 #puts "overall $drawmsecs ms for $numcommits commits"
1502 if {$redisplaying} {
1502 if {$redisplaying} {
1503 if {$stopped == 0 && [info exists selectedline]} {
1503 if {$stopped == 0 && [info exists selectedline]} {
1504 selectline $selectedline 0
1504 selectline $selectedline 0
1505 }
1505 }
1506 if {$stopped == 1} {
1506 if {$stopped == 1} {
1507 set stopped 0
1507 set stopped 0
1508 after idle drawgraph
1508 after idle drawgraph
1509 } else {
1509 } else {
1510 set redisplaying 0
1510 set redisplaying 0
1511 }
1511 }
1512 }
1512 }
1513 }
1513 }
1514
1514
1515 proc findmatches {f} {
1515 proc findmatches {f} {
1516 global findtype foundstring foundstrlen
1516 global findtype foundstring foundstrlen
1517 if {$findtype == "Regexp"} {
1517 if {$findtype == "Regexp"} {
1518 set matches [regexp -indices -all -inline $foundstring $f]
1518 set matches [regexp -indices -all -inline $foundstring $f]
1519 } else {
1519 } else {
1520 if {$findtype == "IgnCase"} {
1520 if {$findtype == "IgnCase"} {
1521 set str [string tolower $f]
1521 set str [string tolower $f]
1522 } else {
1522 } else {
1523 set str $f
1523 set str $f
1524 }
1524 }
1525 set matches {}
1525 set matches {}
1526 set i 0
1526 set i 0
1527 while {[set j [string first $foundstring $str $i]] >= 0} {
1527 while {[set j [string first $foundstring $str $i]] >= 0} {
1528 lappend matches [list $j [expr $j+$foundstrlen-1]]
1528 lappend matches [list $j [expr $j+$foundstrlen-1]]
1529 set i [expr $j + $foundstrlen]
1529 set i [expr $j + $foundstrlen]
1530 }
1530 }
1531 }
1531 }
1532 return $matches
1532 return $matches
1533 }
1533 }
1534
1534
1535 proc dofind {} {
1535 proc dofind {} {
1536 global findtype findloc findstring markedmatches commitinfo
1536 global findtype findloc findstring markedmatches commitinfo
1537 global numcommits lineid linehtag linentag linedtag
1537 global numcommits lineid linehtag linentag linedtag
1538 global mainfont namefont canv canv2 canv3 selectedline
1538 global mainfont namefont canv canv2 canv3 selectedline
1539 global matchinglines foundstring foundstrlen
1539 global matchinglines foundstring foundstrlen
1540
1540
1541 stopfindproc
1541 stopfindproc
1542 unmarkmatches
1542 unmarkmatches
1543 focus .
1543 focus .
1544 set matchinglines {}
1544 set matchinglines {}
1545 if {$findloc == "Pickaxe"} {
1545 if {$findloc == "Pickaxe"} {
1546 findpatches
1546 findpatches
1547 return
1547 return
1548 }
1548 }
1549 if {$findtype == "IgnCase"} {
1549 if {$findtype == "IgnCase"} {
1550 set foundstring [string tolower $findstring]
1550 set foundstring [string tolower $findstring]
1551 } else {
1551 } else {
1552 set foundstring $findstring
1552 set foundstring $findstring
1553 }
1553 }
1554 set foundstrlen [string length $findstring]
1554 set foundstrlen [string length $findstring]
1555 if {$foundstrlen == 0} return
1555 if {$foundstrlen == 0} return
1556 if {$findloc == "Files"} {
1556 if {$findloc == "Files"} {
1557 findfiles
1557 findfiles
1558 return
1558 return
1559 }
1559 }
1560 if {![info exists selectedline]} {
1560 if {![info exists selectedline]} {
1561 set oldsel -1
1561 set oldsel -1
1562 } else {
1562 } else {
1563 set oldsel $selectedline
1563 set oldsel $selectedline
1564 }
1564 }
1565 set didsel 0
1565 set didsel 0
1566 set fldtypes {Headline Author Date Committer CDate Comment}
1566 set fldtypes {Headline Author Date Committer CDate Comment}
1567 for {set l 0} {$l < $numcommits} {incr l} {
1567 for {set l 0} {$l < $numcommits} {incr l} {
1568 set id $lineid($l)
1568 set id $lineid($l)
1569 set info $commitinfo($id)
1569 set info $commitinfo($id)
1570 set doesmatch 0
1570 set doesmatch 0
1571 foreach f $info ty $fldtypes {
1571 foreach f $info ty $fldtypes {
1572 if {$findloc != "All fields" && $findloc != $ty} {
1572 if {$findloc != "All fields" && $findloc != $ty} {
1573 continue
1573 continue
1574 }
1574 }
1575 set matches [findmatches $f]
1575 set matches [findmatches $f]
1576 if {$matches == {}} continue
1576 if {$matches == {}} continue
1577 set doesmatch 1
1577 set doesmatch 1
1578 if {$ty == "Headline"} {
1578 if {$ty == "Headline"} {
1579 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1579 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1580 } elseif {$ty == "Author"} {
1580 } elseif {$ty == "Author"} {
1581 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1581 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1582 } elseif {$ty == "Date"} {
1582 } elseif {$ty == "Date"} {
1583 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1583 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1584 }
1584 }
1585 }
1585 }
1586 if {$doesmatch} {
1586 if {$doesmatch} {
1587 lappend matchinglines $l
1587 lappend matchinglines $l
1588 if {!$didsel && $l > $oldsel} {
1588 if {!$didsel && $l > $oldsel} {
1589 findselectline $l
1589 findselectline $l
1590 set didsel 1
1590 set didsel 1
1591 }
1591 }
1592 }
1592 }
1593 }
1593 }
1594 if {$matchinglines == {}} {
1594 if {$matchinglines == {}} {
1595 bell
1595 bell
1596 } elseif {!$didsel} {
1596 } elseif {!$didsel} {
1597 findselectline [lindex $matchinglines 0]
1597 findselectline [lindex $matchinglines 0]
1598 }
1598 }
1599 }
1599 }
1600
1600
1601 proc findselectline {l} {
1601 proc findselectline {l} {
1602 global findloc commentend ctext
1602 global findloc commentend ctext
1603 selectline $l 1
1603 selectline $l 1
1604 if {$findloc == "All fields" || $findloc == "Comments"} {
1604 if {$findloc == "All fields" || $findloc == "Comments"} {
1605 # highlight the matches in the comments
1605 # highlight the matches in the comments
1606 set f [$ctext get 1.0 $commentend]
1606 set f [$ctext get 1.0 $commentend]
1607 set matches [findmatches $f]
1607 set matches [findmatches $f]
1608 foreach match $matches {
1608 foreach match $matches {
1609 set start [lindex $match 0]
1609 set start [lindex $match 0]
1610 set end [expr [lindex $match 1] + 1]
1610 set end [expr [lindex $match 1] + 1]
1611 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1611 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1612 }
1612 }
1613 }
1613 }
1614 }
1614 }
1615
1615
1616 proc findnext {restart} {
1616 proc findnext {restart} {
1617 global matchinglines selectedline
1617 global matchinglines selectedline
1618 if {![info exists matchinglines]} {
1618 if {![info exists matchinglines]} {
1619 if {$restart} {
1619 if {$restart} {
1620 dofind
1620 dofind
1621 }
1621 }
1622 return
1622 return
1623 }
1623 }
1624 if {![info exists selectedline]} return
1624 if {![info exists selectedline]} return
1625 foreach l $matchinglines {
1625 foreach l $matchinglines {
1626 if {$l > $selectedline} {
1626 if {$l > $selectedline} {
1627 findselectline $l
1627 findselectline $l
1628 return
1628 return
1629 }
1629 }
1630 }
1630 }
1631 bell
1631 bell
1632 }
1632 }
1633
1633
1634 proc findprev {} {
1634 proc findprev {} {
1635 global matchinglines selectedline
1635 global matchinglines selectedline
1636 if {![info exists matchinglines]} {
1636 if {![info exists matchinglines]} {
1637 dofind
1637 dofind
1638 return
1638 return
1639 }
1639 }
1640 if {![info exists selectedline]} return
1640 if {![info exists selectedline]} return
1641 set prev {}
1641 set prev {}
1642 foreach l $matchinglines {
1642 foreach l $matchinglines {
1643 if {$l >= $selectedline} break
1643 if {$l >= $selectedline} break
1644 set prev $l
1644 set prev $l
1645 }
1645 }
1646 if {$prev != {}} {
1646 if {$prev != {}} {
1647 findselectline $prev
1647 findselectline $prev
1648 } else {
1648 } else {
1649 bell
1649 bell
1650 }
1650 }
1651 }
1651 }
1652
1652
1653 proc findlocchange {name ix op} {
1653 proc findlocchange {name ix op} {
1654 global findloc findtype findtypemenu
1654 global findloc findtype findtypemenu
1655 if {$findloc == "Pickaxe"} {
1655 if {$findloc == "Pickaxe"} {
1656 set findtype Exact
1656 set findtype Exact
1657 set state disabled
1657 set state disabled
1658 } else {
1658 } else {
1659 set state normal
1659 set state normal
1660 }
1660 }
1661 $findtypemenu entryconf 1 -state $state
1661 $findtypemenu entryconf 1 -state $state
1662 $findtypemenu entryconf 2 -state $state
1662 $findtypemenu entryconf 2 -state $state
1663 }
1663 }
1664
1664
1665 proc stopfindproc {{done 0}} {
1665 proc stopfindproc {{done 0}} {
1666 global findprocpid findprocfile findids
1666 global findprocpid findprocfile findids
1667 global ctext findoldcursor phase maincursor textcursor
1667 global ctext findoldcursor phase maincursor textcursor
1668 global findinprogress
1668 global findinprogress
1669
1669
1670 catch {unset findids}
1670 catch {unset findids}
1671 if {[info exists findprocpid]} {
1671 if {[info exists findprocpid]} {
1672 if {!$done} {
1672 if {!$done} {
1673 catch {exec kill $findprocpid}
1673 catch {exec kill $findprocpid}
1674 }
1674 }
1675 catch {close $findprocfile}
1675 catch {close $findprocfile}
1676 unset findprocpid
1676 unset findprocpid
1677 }
1677 }
1678 if {[info exists findinprogress]} {
1678 if {[info exists findinprogress]} {
1679 unset findinprogress
1679 unset findinprogress
1680 if {$phase != "incrdraw"} {
1680 if {$phase != "incrdraw"} {
1681 . config -cursor $maincursor
1681 . config -cursor $maincursor
1682 settextcursor $textcursor
1682 settextcursor $textcursor
1683 }
1683 }
1684 }
1684 }
1685 }
1685 }
1686
1686
1687 proc findpatches {} {
1687 proc findpatches {} {
1688 global findstring selectedline numcommits
1688 global findstring selectedline numcommits
1689 global findprocpid findprocfile
1689 global findprocpid findprocfile
1690 global finddidsel ctext lineid findinprogress
1690 global finddidsel ctext lineid findinprogress
1691 global findinsertpos
1691 global findinsertpos
1692
1692
1693 if {$numcommits == 0} return
1693 if {$numcommits == 0} return
1694
1694
1695 # make a list of all the ids to search, starting at the one
1695 # make a list of all the ids to search, starting at the one
1696 # after the selected line (if any)
1696 # after the selected line (if any)
1697 if {[info exists selectedline]} {
1697 if {[info exists selectedline]} {
1698 set l $selectedline
1698 set l $selectedline
1699 } else {
1699 } else {
1700 set l -1
1700 set l -1
1701 }
1701 }
1702 set inputids {}
1702 set inputids {}
1703 for {set i 0} {$i < $numcommits} {incr i} {
1703 for {set i 0} {$i < $numcommits} {incr i} {
1704 if {[incr l] >= $numcommits} {
1704 if {[incr l] >= $numcommits} {
1705 set l 0
1705 set l 0
1706 }
1706 }
1707 append inputids $lineid($l) "\n"
1707 append inputids $lineid($l) "\n"
1708 }
1708 }
1709
1709
1710 if {[catch {
1710 if {[catch {
1711 set f [open [list | hg git-diff-tree --stdin -s -r -S$findstring \
1711 set f [open [list | hg debug-diff-tree --stdin -s -r -S$findstring \
1712 << $inputids] r]
1712 << $inputids] r]
1713 } err]} {
1713 } err]} {
1714 error_popup "Error starting search process: $err"
1714 error_popup "Error starting search process: $err"
1715 return
1715 return
1716 }
1716 }
1717
1717
1718 set findinsertpos end
1718 set findinsertpos end
1719 set findprocfile $f
1719 set findprocfile $f
1720 set findprocpid [pid $f]
1720 set findprocpid [pid $f]
1721 fconfigure $f -blocking 0
1721 fconfigure $f -blocking 0
1722 fileevent $f readable readfindproc
1722 fileevent $f readable readfindproc
1723 set finddidsel 0
1723 set finddidsel 0
1724 . config -cursor watch
1724 . config -cursor watch
1725 settextcursor watch
1725 settextcursor watch
1726 set findinprogress 1
1726 set findinprogress 1
1727 }
1727 }
1728
1728
1729 proc readfindproc {} {
1729 proc readfindproc {} {
1730 global findprocfile finddidsel
1730 global findprocfile finddidsel
1731 global idline matchinglines findinsertpos
1731 global idline matchinglines findinsertpos
1732
1732
1733 set n [gets $findprocfile line]
1733 set n [gets $findprocfile line]
1734 if {$n < 0} {
1734 if {$n < 0} {
1735 if {[eof $findprocfile]} {
1735 if {[eof $findprocfile]} {
1736 stopfindproc 1
1736 stopfindproc 1
1737 if {!$finddidsel} {
1737 if {!$finddidsel} {
1738 bell
1738 bell
1739 }
1739 }
1740 }
1740 }
1741 return
1741 return
1742 }
1742 }
1743 if {![regexp {^[0-9a-f]{40}} $line id]} {
1743 if {![regexp {^[0-9a-f]{40}} $line id]} {
1744 error_popup "Can't parse git-diff-tree output: $line"
1744 error_popup "Can't parse git-diff-tree output: $line"
1745 stopfindproc
1745 stopfindproc
1746 return
1746 return
1747 }
1747 }
1748 if {![info exists idline($id)]} {
1748 if {![info exists idline($id)]} {
1749 puts stderr "spurious id: $id"
1749 puts stderr "spurious id: $id"
1750 return
1750 return
1751 }
1751 }
1752 set l $idline($id)
1752 set l $idline($id)
1753 insertmatch $l $id
1753 insertmatch $l $id
1754 }
1754 }
1755
1755
1756 proc insertmatch {l id} {
1756 proc insertmatch {l id} {
1757 global matchinglines findinsertpos finddidsel
1757 global matchinglines findinsertpos finddidsel
1758
1758
1759 if {$findinsertpos == "end"} {
1759 if {$findinsertpos == "end"} {
1760 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1760 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1761 set matchinglines [linsert $matchinglines 0 $l]
1761 set matchinglines [linsert $matchinglines 0 $l]
1762 set findinsertpos 1
1762 set findinsertpos 1
1763 } else {
1763 } else {
1764 lappend matchinglines $l
1764 lappend matchinglines $l
1765 }
1765 }
1766 } else {
1766 } else {
1767 set matchinglines [linsert $matchinglines $findinsertpos $l]
1767 set matchinglines [linsert $matchinglines $findinsertpos $l]
1768 incr findinsertpos
1768 incr findinsertpos
1769 }
1769 }
1770 markheadline $l $id
1770 markheadline $l $id
1771 if {!$finddidsel} {
1771 if {!$finddidsel} {
1772 findselectline $l
1772 findselectline $l
1773 set finddidsel 1
1773 set finddidsel 1
1774 }
1774 }
1775 }
1775 }
1776
1776
1777 proc findfiles {} {
1777 proc findfiles {} {
1778 global selectedline numcommits lineid ctext
1778 global selectedline numcommits lineid ctext
1779 global ffileline finddidsel parents nparents
1779 global ffileline finddidsel parents nparents
1780 global findinprogress findstartline findinsertpos
1780 global findinprogress findstartline findinsertpos
1781 global treediffs fdiffids fdiffsneeded fdiffpos
1781 global treediffs fdiffids fdiffsneeded fdiffpos
1782 global findmergefiles
1782 global findmergefiles
1783
1783
1784 if {$numcommits == 0} return
1784 if {$numcommits == 0} return
1785
1785
1786 if {[info exists selectedline]} {
1786 if {[info exists selectedline]} {
1787 set l [expr {$selectedline + 1}]
1787 set l [expr {$selectedline + 1}]
1788 } else {
1788 } else {
1789 set l 0
1789 set l 0
1790 }
1790 }
1791 set ffileline $l
1791 set ffileline $l
1792 set findstartline $l
1792 set findstartline $l
1793 set diffsneeded {}
1793 set diffsneeded {}
1794 set fdiffsneeded {}
1794 set fdiffsneeded {}
1795 while 1 {
1795 while 1 {
1796 set id $lineid($l)
1796 set id $lineid($l)
1797 if {$findmergefiles || $nparents($id) == 1} {
1797 if {$findmergefiles || $nparents($id) == 1} {
1798 foreach p $parents($id) {
1798 foreach p $parents($id) {
1799 if {![info exists treediffs([list $id $p])]} {
1799 if {![info exists treediffs([list $id $p])]} {
1800 append diffsneeded "$id $p\n"
1800 append diffsneeded "$id $p\n"
1801 lappend fdiffsneeded [list $id $p]
1801 lappend fdiffsneeded [list $id $p]
1802 }
1802 }
1803 }
1803 }
1804 }
1804 }
1805 if {[incr l] >= $numcommits} {
1805 if {[incr l] >= $numcommits} {
1806 set l 0
1806 set l 0
1807 }
1807 }
1808 if {$l == $findstartline} break
1808 if {$l == $findstartline} break
1809 }
1809 }
1810
1810
1811 # start off a git-diff-tree process if needed
1811 # start off a git-diff-tree process if needed
1812 if {$diffsneeded ne {}} {
1812 if {$diffsneeded ne {}} {
1813 if {[catch {
1813 if {[catch {
1814 set df [open [list | hg git-diff-tree -r --stdin << $diffsneeded] r]
1814 set df [open [list | hg debug-diff-tree -r --stdin << $diffsneeded] r]
1815 } err ]} {
1815 } err ]} {
1816 error_popup "Error starting search process: $err"
1816 error_popup "Error starting search process: $err"
1817 return
1817 return
1818 }
1818 }
1819 catch {unset fdiffids}
1819 catch {unset fdiffids}
1820 set fdiffpos 0
1820 set fdiffpos 0
1821 fconfigure $df -blocking 0
1821 fconfigure $df -blocking 0
1822 fileevent $df readable [list readfilediffs $df]
1822 fileevent $df readable [list readfilediffs $df]
1823 }
1823 }
1824
1824
1825 set finddidsel 0
1825 set finddidsel 0
1826 set findinsertpos end
1826 set findinsertpos end
1827 set id $lineid($l)
1827 set id $lineid($l)
1828 set p [lindex $parents($id) 0]
1828 set p [lindex $parents($id) 0]
1829 . config -cursor watch
1829 . config -cursor watch
1830 settextcursor watch
1830 settextcursor watch
1831 set findinprogress 1
1831 set findinprogress 1
1832 findcont [list $id $p]
1832 findcont [list $id $p]
1833 update
1833 update
1834 }
1834 }
1835
1835
1836 proc readfilediffs {df} {
1836 proc readfilediffs {df} {
1837 global findids fdiffids fdiffs
1837 global findids fdiffids fdiffs
1838
1838
1839 set n [gets $df line]
1839 set n [gets $df line]
1840 if {$n < 0} {
1840 if {$n < 0} {
1841 if {[eof $df]} {
1841 if {[eof $df]} {
1842 donefilediff
1842 donefilediff
1843 if {[catch {close $df} err]} {
1843 if {[catch {close $df} err]} {
1844 stopfindproc
1844 stopfindproc
1845 bell
1845 bell
1846 error_popup "Error in hg git-diff-tree: $err"
1846 error_popup "Error in hg debug-diff-tree: $err"
1847 } elseif {[info exists findids]} {
1847 } elseif {[info exists findids]} {
1848 set ids $findids
1848 set ids $findids
1849 stopfindproc
1849 stopfindproc
1850 bell
1850 bell
1851 error_popup "Couldn't find diffs for {$ids}"
1851 error_popup "Couldn't find diffs for {$ids}"
1852 }
1852 }
1853 }
1853 }
1854 return
1854 return
1855 }
1855 }
1856 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1856 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1857 # start of a new string of diffs
1857 # start of a new string of diffs
1858 donefilediff
1858 donefilediff
1859 set fdiffids [list $id $p]
1859 set fdiffids [list $id $p]
1860 set fdiffs {}
1860 set fdiffs {}
1861 } elseif {[string match ":*" $line]} {
1861 } elseif {[string match ":*" $line]} {
1862 lappend fdiffs [lindex $line 5]
1862 lappend fdiffs [lindex $line 5]
1863 }
1863 }
1864 }
1864 }
1865
1865
1866 proc donefilediff {} {
1866 proc donefilediff {} {
1867 global fdiffids fdiffs treediffs findids
1867 global fdiffids fdiffs treediffs findids
1868 global fdiffsneeded fdiffpos
1868 global fdiffsneeded fdiffpos
1869
1869
1870 if {[info exists fdiffids]} {
1870 if {[info exists fdiffids]} {
1871 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1871 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1872 && $fdiffpos < [llength $fdiffsneeded]} {
1872 && $fdiffpos < [llength $fdiffsneeded]} {
1873 # git-diff-tree doesn't output anything for a commit
1873 # git-diff-tree doesn't output anything for a commit
1874 # which doesn't change anything
1874 # which doesn't change anything
1875 set nullids [lindex $fdiffsneeded $fdiffpos]
1875 set nullids [lindex $fdiffsneeded $fdiffpos]
1876 set treediffs($nullids) {}
1876 set treediffs($nullids) {}
1877 if {[info exists findids] && $nullids eq $findids} {
1877 if {[info exists findids] && $nullids eq $findids} {
1878 unset findids
1878 unset findids
1879 findcont $nullids
1879 findcont $nullids
1880 }
1880 }
1881 incr fdiffpos
1881 incr fdiffpos
1882 }
1882 }
1883 incr fdiffpos
1883 incr fdiffpos
1884
1884
1885 if {![info exists treediffs($fdiffids)]} {
1885 if {![info exists treediffs($fdiffids)]} {
1886 set treediffs($fdiffids) $fdiffs
1886 set treediffs($fdiffids) $fdiffs
1887 }
1887 }
1888 if {[info exists findids] && $fdiffids eq $findids} {
1888 if {[info exists findids] && $fdiffids eq $findids} {
1889 unset findids
1889 unset findids
1890 findcont $fdiffids
1890 findcont $fdiffids
1891 }
1891 }
1892 }
1892 }
1893 }
1893 }
1894
1894
1895 proc findcont {ids} {
1895 proc findcont {ids} {
1896 global findids treediffs parents nparents
1896 global findids treediffs parents nparents
1897 global ffileline findstartline finddidsel
1897 global ffileline findstartline finddidsel
1898 global lineid numcommits matchinglines findinprogress
1898 global lineid numcommits matchinglines findinprogress
1899 global findmergefiles
1899 global findmergefiles
1900
1900
1901 set id [lindex $ids 0]
1901 set id [lindex $ids 0]
1902 set p [lindex $ids 1]
1902 set p [lindex $ids 1]
1903 set pi [lsearch -exact $parents($id) $p]
1903 set pi [lsearch -exact $parents($id) $p]
1904 set l $ffileline
1904 set l $ffileline
1905 while 1 {
1905 while 1 {
1906 if {$findmergefiles || $nparents($id) == 1} {
1906 if {$findmergefiles || $nparents($id) == 1} {
1907 if {![info exists treediffs($ids)]} {
1907 if {![info exists treediffs($ids)]} {
1908 set findids $ids
1908 set findids $ids
1909 set ffileline $l
1909 set ffileline $l
1910 return
1910 return
1911 }
1911 }
1912 set doesmatch 0
1912 set doesmatch 0
1913 foreach f $treediffs($ids) {
1913 foreach f $treediffs($ids) {
1914 set x [findmatches $f]
1914 set x [findmatches $f]
1915 if {$x != {}} {
1915 if {$x != {}} {
1916 set doesmatch 1
1916 set doesmatch 1
1917 break
1917 break
1918 }
1918 }
1919 }
1919 }
1920 if {$doesmatch} {
1920 if {$doesmatch} {
1921 insertmatch $l $id
1921 insertmatch $l $id
1922 set pi $nparents($id)
1922 set pi $nparents($id)
1923 }
1923 }
1924 } else {
1924 } else {
1925 set pi $nparents($id)
1925 set pi $nparents($id)
1926 }
1926 }
1927 if {[incr pi] >= $nparents($id)} {
1927 if {[incr pi] >= $nparents($id)} {
1928 set pi 0
1928 set pi 0
1929 if {[incr l] >= $numcommits} {
1929 if {[incr l] >= $numcommits} {
1930 set l 0
1930 set l 0
1931 }
1931 }
1932 if {$l == $findstartline} break
1932 if {$l == $findstartline} break
1933 set id $lineid($l)
1933 set id $lineid($l)
1934 }
1934 }
1935 set p [lindex $parents($id) $pi]
1935 set p [lindex $parents($id) $pi]
1936 set ids [list $id $p]
1936 set ids [list $id $p]
1937 }
1937 }
1938 stopfindproc
1938 stopfindproc
1939 if {!$finddidsel} {
1939 if {!$finddidsel} {
1940 bell
1940 bell
1941 }
1941 }
1942 }
1942 }
1943
1943
1944 # mark a commit as matching by putting a yellow background
1944 # mark a commit as matching by putting a yellow background
1945 # behind the headline
1945 # behind the headline
1946 proc markheadline {l id} {
1946 proc markheadline {l id} {
1947 global canv mainfont linehtag commitinfo
1947 global canv mainfont linehtag commitinfo
1948
1948
1949 set bbox [$canv bbox $linehtag($l)]
1949 set bbox [$canv bbox $linehtag($l)]
1950 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1950 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1951 $canv lower $t
1951 $canv lower $t
1952 }
1952 }
1953
1953
1954 # mark the bits of a headline, author or date that match a find string
1954 # mark the bits of a headline, author or date that match a find string
1955 proc markmatches {canv l str tag matches font} {
1955 proc markmatches {canv l str tag matches font} {
1956 set bbox [$canv bbox $tag]
1956 set bbox [$canv bbox $tag]
1957 set x0 [lindex $bbox 0]
1957 set x0 [lindex $bbox 0]
1958 set y0 [lindex $bbox 1]
1958 set y0 [lindex $bbox 1]
1959 set y1 [lindex $bbox 3]
1959 set y1 [lindex $bbox 3]
1960 foreach match $matches {
1960 foreach match $matches {
1961 set start [lindex $match 0]
1961 set start [lindex $match 0]
1962 set end [lindex $match 1]
1962 set end [lindex $match 1]
1963 if {$start > $end} continue
1963 if {$start > $end} continue
1964 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1964 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1965 set xlen [font measure $font [string range $str 0 [expr $end]]]
1965 set xlen [font measure $font [string range $str 0 [expr $end]]]
1966 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1966 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1967 -outline {} -tags matches -fill yellow]
1967 -outline {} -tags matches -fill yellow]
1968 $canv lower $t
1968 $canv lower $t
1969 }
1969 }
1970 }
1970 }
1971
1971
1972 proc unmarkmatches {} {
1972 proc unmarkmatches {} {
1973 global matchinglines findids
1973 global matchinglines findids
1974 allcanvs delete matches
1974 allcanvs delete matches
1975 catch {unset matchinglines}
1975 catch {unset matchinglines}
1976 catch {unset findids}
1976 catch {unset findids}
1977 }
1977 }
1978
1978
1979 proc selcanvline {w x y} {
1979 proc selcanvline {w x y} {
1980 global canv canvy0 ctext linespc
1980 global canv canvy0 ctext linespc
1981 global lineid linehtag linentag linedtag rowtextx
1981 global lineid linehtag linentag linedtag rowtextx
1982 set ymax [lindex [$canv cget -scrollregion] 3]
1982 set ymax [lindex [$canv cget -scrollregion] 3]
1983 if {$ymax == {}} return
1983 if {$ymax == {}} return
1984 set yfrac [lindex [$canv yview] 0]
1984 set yfrac [lindex [$canv yview] 0]
1985 set y [expr {$y + $yfrac * $ymax}]
1985 set y [expr {$y + $yfrac * $ymax}]
1986 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1986 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1987 if {$l < 0} {
1987 if {$l < 0} {
1988 set l 0
1988 set l 0
1989 }
1989 }
1990 if {$w eq $canv} {
1990 if {$w eq $canv} {
1991 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1991 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1992 }
1992 }
1993 unmarkmatches
1993 unmarkmatches
1994 selectline $l 1
1994 selectline $l 1
1995 }
1995 }
1996
1996
1997 proc commit_descriptor {p} {
1997 proc commit_descriptor {p} {
1998 global commitinfo
1998 global commitinfo
1999 set l "..."
1999 set l "..."
2000 if {[info exists commitinfo($p)]} {
2000 if {[info exists commitinfo($p)]} {
2001 set l [lindex $commitinfo($p) 0]
2001 set l [lindex $commitinfo($p) 0]
2002 }
2002 }
2003 return "$p ($l)"
2003 return "$p ($l)"
2004 }
2004 }
2005
2005
2006 # append some text to the ctext widget, and make any SHA1 ID
2006 # append some text to the ctext widget, and make any SHA1 ID
2007 # that we know about be a clickable link.
2007 # that we know about be a clickable link.
2008 proc appendwithlinks {text} {
2008 proc appendwithlinks {text} {
2009 global ctext idline linknum
2009 global ctext idline linknum
2010
2010
2011 set start [$ctext index "end - 1c"]
2011 set start [$ctext index "end - 1c"]
2012 $ctext insert end $text
2012 $ctext insert end $text
2013 $ctext insert end "\n"
2013 $ctext insert end "\n"
2014 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2014 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2015 foreach l $links {
2015 foreach l $links {
2016 set s [lindex $l 0]
2016 set s [lindex $l 0]
2017 set e [lindex $l 1]
2017 set e [lindex $l 1]
2018 set linkid [string range $text $s $e]
2018 set linkid [string range $text $s $e]
2019 if {![info exists idline($linkid)]} continue
2019 if {![info exists idline($linkid)]} continue
2020 incr e
2020 incr e
2021 $ctext tag add link "$start + $s c" "$start + $e c"
2021 $ctext tag add link "$start + $s c" "$start + $e c"
2022 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2022 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2023 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2023 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2024 incr linknum
2024 incr linknum
2025 }
2025 }
2026 $ctext tag conf link -foreground blue -underline 1
2026 $ctext tag conf link -foreground blue -underline 1
2027 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2027 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2028 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2028 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2029 }
2029 }
2030
2030
2031 proc selectline {l isnew} {
2031 proc selectline {l isnew} {
2032 global canv canv2 canv3 ctext commitinfo selectedline
2032 global canv canv2 canv3 ctext commitinfo selectedline
2033 global lineid linehtag linentag linedtag
2033 global lineid linehtag linentag linedtag
2034 global canvy0 linespc parents nparents children
2034 global canvy0 linespc parents nparents children
2035 global cflist currentid sha1entry
2035 global cflist currentid sha1entry
2036 global commentend idtags idline linknum
2036 global commentend idtags idline linknum
2037
2037
2038 $canv delete hover
2038 $canv delete hover
2039 normalline
2039 normalline
2040 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2040 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2041 $canv delete secsel
2041 $canv delete secsel
2042 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2042 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2043 -tags secsel -fill [$canv cget -selectbackground]]
2043 -tags secsel -fill [$canv cget -selectbackground]]
2044 $canv lower $t
2044 $canv lower $t
2045 $canv2 delete secsel
2045 $canv2 delete secsel
2046 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2046 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2047 -tags secsel -fill [$canv2 cget -selectbackground]]
2047 -tags secsel -fill [$canv2 cget -selectbackground]]
2048 $canv2 lower $t
2048 $canv2 lower $t
2049 $canv3 delete secsel
2049 $canv3 delete secsel
2050 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2050 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2051 -tags secsel -fill [$canv3 cget -selectbackground]]
2051 -tags secsel -fill [$canv3 cget -selectbackground]]
2052 $canv3 lower $t
2052 $canv3 lower $t
2053 set y [expr {$canvy0 + $l * $linespc}]
2053 set y [expr {$canvy0 + $l * $linespc}]
2054 set ymax [lindex [$canv cget -scrollregion] 3]
2054 set ymax [lindex [$canv cget -scrollregion] 3]
2055 set ytop [expr {$y - $linespc - 1}]
2055 set ytop [expr {$y - $linespc - 1}]
2056 set ybot [expr {$y + $linespc + 1}]
2056 set ybot [expr {$y + $linespc + 1}]
2057 set wnow [$canv yview]
2057 set wnow [$canv yview]
2058 set wtop [expr [lindex $wnow 0] * $ymax]
2058 set wtop [expr [lindex $wnow 0] * $ymax]
2059 set wbot [expr [lindex $wnow 1] * $ymax]
2059 set wbot [expr [lindex $wnow 1] * $ymax]
2060 set wh [expr {$wbot - $wtop}]
2060 set wh [expr {$wbot - $wtop}]
2061 set newtop $wtop
2061 set newtop $wtop
2062 if {$ytop < $wtop} {
2062 if {$ytop < $wtop} {
2063 if {$ybot < $wtop} {
2063 if {$ybot < $wtop} {
2064 set newtop [expr {$y - $wh / 2.0}]
2064 set newtop [expr {$y - $wh / 2.0}]
2065 } else {
2065 } else {
2066 set newtop $ytop
2066 set newtop $ytop
2067 if {$newtop > $wtop - $linespc} {
2067 if {$newtop > $wtop - $linespc} {
2068 set newtop [expr {$wtop - $linespc}]
2068 set newtop [expr {$wtop - $linespc}]
2069 }
2069 }
2070 }
2070 }
2071 } elseif {$ybot > $wbot} {
2071 } elseif {$ybot > $wbot} {
2072 if {$ytop > $wbot} {
2072 if {$ytop > $wbot} {
2073 set newtop [expr {$y - $wh / 2.0}]
2073 set newtop [expr {$y - $wh / 2.0}]
2074 } else {
2074 } else {
2075 set newtop [expr {$ybot - $wh}]
2075 set newtop [expr {$ybot - $wh}]
2076 if {$newtop < $wtop + $linespc} {
2076 if {$newtop < $wtop + $linespc} {
2077 set newtop [expr {$wtop + $linespc}]
2077 set newtop [expr {$wtop + $linespc}]
2078 }
2078 }
2079 }
2079 }
2080 }
2080 }
2081 if {$newtop != $wtop} {
2081 if {$newtop != $wtop} {
2082 if {$newtop < 0} {
2082 if {$newtop < 0} {
2083 set newtop 0
2083 set newtop 0
2084 }
2084 }
2085 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
2085 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
2086 }
2086 }
2087
2087
2088 if {$isnew} {
2088 if {$isnew} {
2089 addtohistory [list selectline $l 0]
2089 addtohistory [list selectline $l 0]
2090 }
2090 }
2091
2091
2092 set selectedline $l
2092 set selectedline $l
2093
2093
2094 set id $lineid($l)
2094 set id $lineid($l)
2095 set currentid $id
2095 set currentid $id
2096 $sha1entry delete 0 end
2096 $sha1entry delete 0 end
2097 $sha1entry insert 0 $id
2097 $sha1entry insert 0 $id
2098 $sha1entry selection from 0
2098 $sha1entry selection from 0
2099 $sha1entry selection to end
2099 $sha1entry selection to end
2100
2100
2101 $ctext conf -state normal
2101 $ctext conf -state normal
2102 $ctext delete 0.0 end
2102 $ctext delete 0.0 end
2103 set linknum 0
2103 set linknum 0
2104 $ctext mark set fmark.0 0.0
2104 $ctext mark set fmark.0 0.0
2105 $ctext mark gravity fmark.0 left
2105 $ctext mark gravity fmark.0 left
2106 set info $commitinfo($id)
2106 set info $commitinfo($id)
2107 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
2107 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
2108 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
2108 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
2109 if {[info exists idtags($id)]} {
2109 if {[info exists idtags($id)]} {
2110 $ctext insert end "Tags:"
2110 $ctext insert end "Tags:"
2111 foreach tag $idtags($id) {
2111 foreach tag $idtags($id) {
2112 $ctext insert end " $tag"
2112 $ctext insert end " $tag"
2113 }
2113 }
2114 $ctext insert end "\n"
2114 $ctext insert end "\n"
2115 }
2115 }
2116
2116
2117 set comment {}
2117 set comment {}
2118 if {[info exists parents($id)]} {
2118 if {[info exists parents($id)]} {
2119 foreach p $parents($id) {
2119 foreach p $parents($id) {
2120 append comment "Parent: [commit_descriptor $p]\n"
2120 append comment "Parent: [commit_descriptor $p]\n"
2121 }
2121 }
2122 }
2122 }
2123 if {[info exists children($id)]} {
2123 if {[info exists children($id)]} {
2124 foreach c $children($id) {
2124 foreach c $children($id) {
2125 append comment "Child: [commit_descriptor $c]\n"
2125 append comment "Child: [commit_descriptor $c]\n"
2126 }
2126 }
2127 }
2127 }
2128 append comment "\n"
2128 append comment "\n"
2129 append comment [lindex $info 5]
2129 append comment [lindex $info 5]
2130
2130
2131 # make anything that looks like a SHA1 ID be a clickable link
2131 # make anything that looks like a SHA1 ID be a clickable link
2132 appendwithlinks $comment
2132 appendwithlinks $comment
2133
2133
2134 $ctext tag delete Comments
2134 $ctext tag delete Comments
2135 $ctext tag remove found 1.0 end
2135 $ctext tag remove found 1.0 end
2136 $ctext conf -state disabled
2136 $ctext conf -state disabled
2137 set commentend [$ctext index "end - 1c"]
2137 set commentend [$ctext index "end - 1c"]
2138
2138
2139 $cflist delete 0 end
2139 $cflist delete 0 end
2140 $cflist insert end "Comments"
2140 $cflist insert end "Comments"
2141 if {$nparents($id) == 1} {
2141 if {$nparents($id) == 1} {
2142 startdiff [concat $id $parents($id)]
2142 startdiff [concat $id $parents($id)]
2143 } elseif {$nparents($id) > 1} {
2143 } elseif {$nparents($id) > 1} {
2144 mergediff $id
2144 mergediff $id
2145 }
2145 }
2146 }
2146 }
2147
2147
2148 proc selnextline {dir} {
2148 proc selnextline {dir} {
2149 global selectedline
2149 global selectedline
2150 if {![info exists selectedline]} return
2150 if {![info exists selectedline]} return
2151 set l [expr $selectedline + $dir]
2151 set l [expr $selectedline + $dir]
2152 unmarkmatches
2152 unmarkmatches
2153 selectline $l 1
2153 selectline $l 1
2154 }
2154 }
2155
2155
2156 proc unselectline {} {
2156 proc unselectline {} {
2157 global selectedline
2157 global selectedline
2158
2158
2159 catch {unset selectedline}
2159 catch {unset selectedline}
2160 allcanvs delete secsel
2160 allcanvs delete secsel
2161 }
2161 }
2162
2162
2163 proc addtohistory {cmd} {
2163 proc addtohistory {cmd} {
2164 global history historyindex
2164 global history historyindex
2165
2165
2166 if {$historyindex > 0
2166 if {$historyindex > 0
2167 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2167 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2168 return
2168 return
2169 }
2169 }
2170
2170
2171 if {$historyindex < [llength $history]} {
2171 if {$historyindex < [llength $history]} {
2172 set history [lreplace $history $historyindex end $cmd]
2172 set history [lreplace $history $historyindex end $cmd]
2173 } else {
2173 } else {
2174 lappend history $cmd
2174 lappend history $cmd
2175 }
2175 }
2176 incr historyindex
2176 incr historyindex
2177 if {$historyindex > 1} {
2177 if {$historyindex > 1} {
2178 .ctop.top.bar.leftbut conf -state normal
2178 .ctop.top.bar.leftbut conf -state normal
2179 } else {
2179 } else {
2180 .ctop.top.bar.leftbut conf -state disabled
2180 .ctop.top.bar.leftbut conf -state disabled
2181 }
2181 }
2182 .ctop.top.bar.rightbut conf -state disabled
2182 .ctop.top.bar.rightbut conf -state disabled
2183 }
2183 }
2184
2184
2185 proc goback {} {
2185 proc goback {} {
2186 global history historyindex
2186 global history historyindex
2187
2187
2188 if {$historyindex > 1} {
2188 if {$historyindex > 1} {
2189 incr historyindex -1
2189 incr historyindex -1
2190 set cmd [lindex $history [expr {$historyindex - 1}]]
2190 set cmd [lindex $history [expr {$historyindex - 1}]]
2191 eval $cmd
2191 eval $cmd
2192 .ctop.top.bar.rightbut conf -state normal
2192 .ctop.top.bar.rightbut conf -state normal
2193 }
2193 }
2194 if {$historyindex <= 1} {
2194 if {$historyindex <= 1} {
2195 .ctop.top.bar.leftbut conf -state disabled
2195 .ctop.top.bar.leftbut conf -state disabled
2196 }
2196 }
2197 }
2197 }
2198
2198
2199 proc goforw {} {
2199 proc goforw {} {
2200 global history historyindex
2200 global history historyindex
2201
2201
2202 if {$historyindex < [llength $history]} {
2202 if {$historyindex < [llength $history]} {
2203 set cmd [lindex $history $historyindex]
2203 set cmd [lindex $history $historyindex]
2204 incr historyindex
2204 incr historyindex
2205 eval $cmd
2205 eval $cmd
2206 .ctop.top.bar.leftbut conf -state normal
2206 .ctop.top.bar.leftbut conf -state normal
2207 }
2207 }
2208 if {$historyindex >= [llength $history]} {
2208 if {$historyindex >= [llength $history]} {
2209 .ctop.top.bar.rightbut conf -state disabled
2209 .ctop.top.bar.rightbut conf -state disabled
2210 }
2210 }
2211 }
2211 }
2212
2212
2213 proc mergediff {id} {
2213 proc mergediff {id} {
2214 global parents diffmergeid diffmergegca mergefilelist diffpindex
2214 global parents diffmergeid diffmergegca mergefilelist diffpindex
2215
2215
2216 set diffmergeid $id
2216 set diffmergeid $id
2217 set diffpindex -1
2217 set diffpindex -1
2218 set diffmergegca [findgca $parents($id)]
2218 set diffmergegca [findgca $parents($id)]
2219 if {[info exists mergefilelist($id)]} {
2219 if {[info exists mergefilelist($id)]} {
2220 if {$mergefilelist($id) ne {}} {
2220 if {$mergefilelist($id) ne {}} {
2221 showmergediff
2221 showmergediff
2222 }
2222 }
2223 } else {
2223 } else {
2224 contmergediff {}
2224 contmergediff {}
2225 }
2225 }
2226 }
2226 }
2227
2227
2228 proc findgca {ids} {
2228 proc findgca {ids} {
2229 set gca {}
2229 set gca {}
2230 foreach id $ids {
2230 foreach id $ids {
2231 if {$gca eq {}} {
2231 if {$gca eq {}} {
2232 set gca $id
2232 set gca $id
2233 } else {
2233 } else {
2234 if {[catch {
2234 if {[catch {
2235 set gca [exec hg git-merge-base $gca $id]
2235 set gca [exec hg debug-merge-base $gca $id]
2236 } err]} {
2236 } err]} {
2237 return {}
2237 return {}
2238 }
2238 }
2239 }
2239 }
2240 }
2240 }
2241 return $gca
2241 return $gca
2242 }
2242 }
2243
2243
2244 proc contmergediff {ids} {
2244 proc contmergediff {ids} {
2245 global diffmergeid diffpindex parents nparents diffmergegca
2245 global diffmergeid diffpindex parents nparents diffmergegca
2246 global treediffs mergefilelist diffids treepending
2246 global treediffs mergefilelist diffids treepending
2247
2247
2248 # diff the child against each of the parents, and diff
2248 # diff the child against each of the parents, and diff
2249 # each of the parents against the GCA.
2249 # each of the parents against the GCA.
2250 while 1 {
2250 while 1 {
2251 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2251 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2252 set ids [list [lindex $ids 1] $diffmergegca]
2252 set ids [list [lindex $ids 1] $diffmergegca]
2253 } else {
2253 } else {
2254 if {[incr diffpindex] >= $nparents($diffmergeid)} break
2254 if {[incr diffpindex] >= $nparents($diffmergeid)} break
2255 set p [lindex $parents($diffmergeid) $diffpindex]
2255 set p [lindex $parents($diffmergeid) $diffpindex]
2256 set ids [list $diffmergeid $p]
2256 set ids [list $diffmergeid $p]
2257 }
2257 }
2258 if {![info exists treediffs($ids)]} {
2258 if {![info exists treediffs($ids)]} {
2259 set diffids $ids
2259 set diffids $ids
2260 if {![info exists treepending]} {
2260 if {![info exists treepending]} {
2261 gettreediffs $ids
2261 gettreediffs $ids
2262 }
2262 }
2263 return
2263 return
2264 }
2264 }
2265 }
2265 }
2266
2266
2267 # If a file in some parent is different from the child and also
2267 # If a file in some parent is different from the child and also
2268 # different from the GCA, then it's interesting.
2268 # different from the GCA, then it's interesting.
2269 # If we don't have a GCA, then a file is interesting if it is
2269 # If we don't have a GCA, then a file is interesting if it is
2270 # different from the child in all the parents.
2270 # different from the child in all the parents.
2271 if {$diffmergegca ne {}} {
2271 if {$diffmergegca ne {}} {
2272 set files {}
2272 set files {}
2273 foreach p $parents($diffmergeid) {
2273 foreach p $parents($diffmergeid) {
2274 set gcadiffs $treediffs([list $p $diffmergegca])
2274 set gcadiffs $treediffs([list $p $diffmergegca])
2275 foreach f $treediffs([list $diffmergeid $p]) {
2275 foreach f $treediffs([list $diffmergeid $p]) {
2276 if {[lsearch -exact $files $f] < 0
2276 if {[lsearch -exact $files $f] < 0
2277 && [lsearch -exact $gcadiffs $f] >= 0} {
2277 && [lsearch -exact $gcadiffs $f] >= 0} {
2278 lappend files $f
2278 lappend files $f
2279 }
2279 }
2280 }
2280 }
2281 }
2281 }
2282 set files [lsort $files]
2282 set files [lsort $files]
2283 } else {
2283 } else {
2284 set p [lindex $parents($diffmergeid) 0]
2284 set p [lindex $parents($diffmergeid) 0]
2285 set files $treediffs([list $diffmergeid $p])
2285 set files $treediffs([list $diffmergeid $p])
2286 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2286 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2287 set p [lindex $parents($diffmergeid) $i]
2287 set p [lindex $parents($diffmergeid) $i]
2288 set df $treediffs([list $diffmergeid $p])
2288 set df $treediffs([list $diffmergeid $p])
2289 set nf {}
2289 set nf {}
2290 foreach f $files {
2290 foreach f $files {
2291 if {[lsearch -exact $df $f] >= 0} {
2291 if {[lsearch -exact $df $f] >= 0} {
2292 lappend nf $f
2292 lappend nf $f
2293 }
2293 }
2294 }
2294 }
2295 set files $nf
2295 set files $nf
2296 }
2296 }
2297 }
2297 }
2298
2298
2299 set mergefilelist($diffmergeid) $files
2299 set mergefilelist($diffmergeid) $files
2300 if {$files ne {}} {
2300 if {$files ne {}} {
2301 showmergediff
2301 showmergediff
2302 }
2302 }
2303 }
2303 }
2304
2304
2305 proc showmergediff {} {
2305 proc showmergediff {} {
2306 global cflist diffmergeid mergefilelist parents
2306 global cflist diffmergeid mergefilelist parents
2307 global diffopts diffinhunk currentfile currenthunk filelines
2307 global diffopts diffinhunk currentfile currenthunk filelines
2308 global diffblocked groupfilelast mergefds groupfilenum grouphunks
2308 global diffblocked groupfilelast mergefds groupfilenum grouphunks
2309
2309
2310 set files $mergefilelist($diffmergeid)
2310 set files $mergefilelist($diffmergeid)
2311 foreach f $files {
2311 foreach f $files {
2312 $cflist insert end $f
2312 $cflist insert end $f
2313 }
2313 }
2314 set env(GIT_DIFF_OPTS) $diffopts
2314 set env(GIT_DIFF_OPTS) $diffopts
2315 set flist {}
2315 set flist {}
2316 catch {unset currentfile}
2316 catch {unset currentfile}
2317 catch {unset currenthunk}
2317 catch {unset currenthunk}
2318 catch {unset filelines}
2318 catch {unset filelines}
2319 catch {unset groupfilenum}
2319 catch {unset groupfilenum}
2320 catch {unset grouphunks}
2320 catch {unset grouphunks}
2321 set groupfilelast -1
2321 set groupfilelast -1
2322 foreach p $parents($diffmergeid) {
2322 foreach p $parents($diffmergeid) {
2323 set cmd [list | hg git-diff-tree -p $p $diffmergeid]
2323 set cmd [list | hg debug-diff-tree -p $p $diffmergeid]
2324 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2324 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2325 if {[catch {set f [open $cmd r]} err]} {
2325 if {[catch {set f [open $cmd r]} err]} {
2326 error_popup "Error getting diffs: $err"
2326 error_popup "Error getting diffs: $err"
2327 foreach f $flist {
2327 foreach f $flist {
2328 catch {close $f}
2328 catch {close $f}
2329 }
2329 }
2330 return
2330 return
2331 }
2331 }
2332 lappend flist $f
2332 lappend flist $f
2333 set ids [list $diffmergeid $p]
2333 set ids [list $diffmergeid $p]
2334 set mergefds($ids) $f
2334 set mergefds($ids) $f
2335 set diffinhunk($ids) 0
2335 set diffinhunk($ids) 0
2336 set diffblocked($ids) 0
2336 set diffblocked($ids) 0
2337 fconfigure $f -blocking 0
2337 fconfigure $f -blocking 0
2338 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2338 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2339 }
2339 }
2340 }
2340 }
2341
2341
2342 proc getmergediffline {f ids id} {
2342 proc getmergediffline {f ids id} {
2343 global diffmergeid diffinhunk diffoldlines diffnewlines
2343 global diffmergeid diffinhunk diffoldlines diffnewlines
2344 global currentfile currenthunk
2344 global currentfile currenthunk
2345 global diffoldstart diffnewstart diffoldlno diffnewlno
2345 global diffoldstart diffnewstart diffoldlno diffnewlno
2346 global diffblocked mergefilelist
2346 global diffblocked mergefilelist
2347 global noldlines nnewlines difflcounts filelines
2347 global noldlines nnewlines difflcounts filelines
2348
2348
2349 set n [gets $f line]
2349 set n [gets $f line]
2350 if {$n < 0} {
2350 if {$n < 0} {
2351 if {![eof $f]} return
2351 if {![eof $f]} return
2352 }
2352 }
2353
2353
2354 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2354 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2355 if {$n < 0} {
2355 if {$n < 0} {
2356 close $f
2356 close $f
2357 }
2357 }
2358 return
2358 return
2359 }
2359 }
2360
2360
2361 if {$diffinhunk($ids) != 0} {
2361 if {$diffinhunk($ids) != 0} {
2362 set fi $currentfile($ids)
2362 set fi $currentfile($ids)
2363 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2363 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2364 # continuing an existing hunk
2364 # continuing an existing hunk
2365 set line [string range $line 1 end]
2365 set line [string range $line 1 end]
2366 set p [lindex $ids 1]
2366 set p [lindex $ids 1]
2367 if {$match eq "-" || $match eq " "} {
2367 if {$match eq "-" || $match eq " "} {
2368 set filelines($p,$fi,$diffoldlno($ids)) $line
2368 set filelines($p,$fi,$diffoldlno($ids)) $line
2369 incr diffoldlno($ids)
2369 incr diffoldlno($ids)
2370 }
2370 }
2371 if {$match eq "+" || $match eq " "} {
2371 if {$match eq "+" || $match eq " "} {
2372 set filelines($id,$fi,$diffnewlno($ids)) $line
2372 set filelines($id,$fi,$diffnewlno($ids)) $line
2373 incr diffnewlno($ids)
2373 incr diffnewlno($ids)
2374 }
2374 }
2375 if {$match eq " "} {
2375 if {$match eq " "} {
2376 if {$diffinhunk($ids) == 2} {
2376 if {$diffinhunk($ids) == 2} {
2377 lappend difflcounts($ids) \
2377 lappend difflcounts($ids) \
2378 [list $noldlines($ids) $nnewlines($ids)]
2378 [list $noldlines($ids) $nnewlines($ids)]
2379 set noldlines($ids) 0
2379 set noldlines($ids) 0
2380 set diffinhunk($ids) 1
2380 set diffinhunk($ids) 1
2381 }
2381 }
2382 incr noldlines($ids)
2382 incr noldlines($ids)
2383 } elseif {$match eq "-" || $match eq "+"} {
2383 } elseif {$match eq "-" || $match eq "+"} {
2384 if {$diffinhunk($ids) == 1} {
2384 if {$diffinhunk($ids) == 1} {
2385 lappend difflcounts($ids) [list $noldlines($ids)]
2385 lappend difflcounts($ids) [list $noldlines($ids)]
2386 set noldlines($ids) 0
2386 set noldlines($ids) 0
2387 set nnewlines($ids) 0
2387 set nnewlines($ids) 0
2388 set diffinhunk($ids) 2
2388 set diffinhunk($ids) 2
2389 }
2389 }
2390 if {$match eq "-"} {
2390 if {$match eq "-"} {
2391 incr noldlines($ids)
2391 incr noldlines($ids)
2392 } else {
2392 } else {
2393 incr nnewlines($ids)
2393 incr nnewlines($ids)
2394 }
2394 }
2395 }
2395 }
2396 # and if it's \ No newline at end of line, then what?
2396 # and if it's \ No newline at end of line, then what?
2397 return
2397 return
2398 }
2398 }
2399 # end of a hunk
2399 # end of a hunk
2400 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2400 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2401 lappend difflcounts($ids) [list $noldlines($ids)]
2401 lappend difflcounts($ids) [list $noldlines($ids)]
2402 } elseif {$diffinhunk($ids) == 2
2402 } elseif {$diffinhunk($ids) == 2
2403 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2403 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2404 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2404 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2405 }
2405 }
2406 set currenthunk($ids) [list $currentfile($ids) \
2406 set currenthunk($ids) [list $currentfile($ids) \
2407 $diffoldstart($ids) $diffnewstart($ids) \
2407 $diffoldstart($ids) $diffnewstart($ids) \
2408 $diffoldlno($ids) $diffnewlno($ids) \
2408 $diffoldlno($ids) $diffnewlno($ids) \
2409 $difflcounts($ids)]
2409 $difflcounts($ids)]
2410 set diffinhunk($ids) 0
2410 set diffinhunk($ids) 0
2411 # -1 = need to block, 0 = unblocked, 1 = is blocked
2411 # -1 = need to block, 0 = unblocked, 1 = is blocked
2412 set diffblocked($ids) -1
2412 set diffblocked($ids) -1
2413 processhunks
2413 processhunks
2414 if {$diffblocked($ids) == -1} {
2414 if {$diffblocked($ids) == -1} {
2415 fileevent $f readable {}
2415 fileevent $f readable {}
2416 set diffblocked($ids) 1
2416 set diffblocked($ids) 1
2417 }
2417 }
2418 }
2418 }
2419
2419
2420 if {$n < 0} {
2420 if {$n < 0} {
2421 # eof
2421 # eof
2422 if {!$diffblocked($ids)} {
2422 if {!$diffblocked($ids)} {
2423 close $f
2423 close $f
2424 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2424 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2425 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2425 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2426 processhunks
2426 processhunks
2427 }
2427 }
2428 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2428 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2429 # start of a new file
2429 # start of a new file
2430 set currentfile($ids) \
2430 set currentfile($ids) \
2431 [lsearch -exact $mergefilelist($diffmergeid) $fname]
2431 [lsearch -exact $mergefilelist($diffmergeid) $fname]
2432 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2432 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2433 $line match f1l f1c f2l f2c rest]} {
2433 $line match f1l f1c f2l f2c rest]} {
2434 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2434 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2435 # start of a new hunk
2435 # start of a new hunk
2436 if {$f1l == 0 && $f1c == 0} {
2436 if {$f1l == 0 && $f1c == 0} {
2437 set f1l 1
2437 set f1l 1
2438 }
2438 }
2439 if {$f2l == 0 && $f2c == 0} {
2439 if {$f2l == 0 && $f2c == 0} {
2440 set f2l 1
2440 set f2l 1
2441 }
2441 }
2442 set diffinhunk($ids) 1
2442 set diffinhunk($ids) 1
2443 set diffoldstart($ids) $f1l
2443 set diffoldstart($ids) $f1l
2444 set diffnewstart($ids) $f2l
2444 set diffnewstart($ids) $f2l
2445 set diffoldlno($ids) $f1l
2445 set diffoldlno($ids) $f1l
2446 set diffnewlno($ids) $f2l
2446 set diffnewlno($ids) $f2l
2447 set difflcounts($ids) {}
2447 set difflcounts($ids) {}
2448 set noldlines($ids) 0
2448 set noldlines($ids) 0
2449 set nnewlines($ids) 0
2449 set nnewlines($ids) 0
2450 }
2450 }
2451 }
2451 }
2452 }
2452 }
2453
2453
2454 proc processhunks {} {
2454 proc processhunks {} {
2455 global diffmergeid parents nparents currenthunk
2455 global diffmergeid parents nparents currenthunk
2456 global mergefilelist diffblocked mergefds
2456 global mergefilelist diffblocked mergefds
2457 global grouphunks grouplinestart grouplineend groupfilenum
2457 global grouphunks grouplinestart grouplineend groupfilenum
2458
2458
2459 set nfiles [llength $mergefilelist($diffmergeid)]
2459 set nfiles [llength $mergefilelist($diffmergeid)]
2460 while 1 {
2460 while 1 {
2461 set fi $nfiles
2461 set fi $nfiles
2462 set lno 0
2462 set lno 0
2463 # look for the earliest hunk
2463 # look for the earliest hunk
2464 foreach p $parents($diffmergeid) {
2464 foreach p $parents($diffmergeid) {
2465 set ids [list $diffmergeid $p]
2465 set ids [list $diffmergeid $p]
2466 if {![info exists currenthunk($ids)]} return
2466 if {![info exists currenthunk($ids)]} return
2467 set i [lindex $currenthunk($ids) 0]
2467 set i [lindex $currenthunk($ids) 0]
2468 set l [lindex $currenthunk($ids) 2]
2468 set l [lindex $currenthunk($ids) 2]
2469 if {$i < $fi || ($i == $fi && $l < $lno)} {
2469 if {$i < $fi || ($i == $fi && $l < $lno)} {
2470 set fi $i
2470 set fi $i
2471 set lno $l
2471 set lno $l
2472 set pi $p
2472 set pi $p
2473 }
2473 }
2474 }
2474 }
2475
2475
2476 if {$fi < $nfiles} {
2476 if {$fi < $nfiles} {
2477 set ids [list $diffmergeid $pi]
2477 set ids [list $diffmergeid $pi]
2478 set hunk $currenthunk($ids)
2478 set hunk $currenthunk($ids)
2479 unset currenthunk($ids)
2479 unset currenthunk($ids)
2480 if {$diffblocked($ids) > 0} {
2480 if {$diffblocked($ids) > 0} {
2481 fileevent $mergefds($ids) readable \
2481 fileevent $mergefds($ids) readable \
2482 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2482 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2483 }
2483 }
2484 set diffblocked($ids) 0
2484 set diffblocked($ids) 0
2485
2485
2486 if {[info exists groupfilenum] && $groupfilenum == $fi
2486 if {[info exists groupfilenum] && $groupfilenum == $fi
2487 && $lno <= $grouplineend} {
2487 && $lno <= $grouplineend} {
2488 # add this hunk to the pending group
2488 # add this hunk to the pending group
2489 lappend grouphunks($pi) $hunk
2489 lappend grouphunks($pi) $hunk
2490 set endln [lindex $hunk 4]
2490 set endln [lindex $hunk 4]
2491 if {$endln > $grouplineend} {
2491 if {$endln > $grouplineend} {
2492 set grouplineend $endln
2492 set grouplineend $endln
2493 }
2493 }
2494 continue
2494 continue
2495 }
2495 }
2496 }
2496 }
2497
2497
2498 # succeeding stuff doesn't belong in this group, so
2498 # succeeding stuff doesn't belong in this group, so
2499 # process the group now
2499 # process the group now
2500 if {[info exists groupfilenum]} {
2500 if {[info exists groupfilenum]} {
2501 processgroup
2501 processgroup
2502 unset groupfilenum
2502 unset groupfilenum
2503 unset grouphunks
2503 unset grouphunks
2504 }
2504 }
2505
2505
2506 if {$fi >= $nfiles} break
2506 if {$fi >= $nfiles} break
2507
2507
2508 # start a new group
2508 # start a new group
2509 set groupfilenum $fi
2509 set groupfilenum $fi
2510 set grouphunks($pi) [list $hunk]
2510 set grouphunks($pi) [list $hunk]
2511 set grouplinestart $lno
2511 set grouplinestart $lno
2512 set grouplineend [lindex $hunk 4]
2512 set grouplineend [lindex $hunk 4]
2513 }
2513 }
2514 }
2514 }
2515
2515
2516 proc processgroup {} {
2516 proc processgroup {} {
2517 global groupfilelast groupfilenum difffilestart
2517 global groupfilelast groupfilenum difffilestart
2518 global mergefilelist diffmergeid ctext filelines
2518 global mergefilelist diffmergeid ctext filelines
2519 global parents diffmergeid diffoffset
2519 global parents diffmergeid diffoffset
2520 global grouphunks grouplinestart grouplineend nparents
2520 global grouphunks grouplinestart grouplineend nparents
2521 global mergemax
2521 global mergemax
2522
2522
2523 $ctext conf -state normal
2523 $ctext conf -state normal
2524 set id $diffmergeid
2524 set id $diffmergeid
2525 set f $groupfilenum
2525 set f $groupfilenum
2526 if {$groupfilelast != $f} {
2526 if {$groupfilelast != $f} {
2527 $ctext insert end "\n"
2527 $ctext insert end "\n"
2528 set here [$ctext index "end - 1c"]
2528 set here [$ctext index "end - 1c"]
2529 set difffilestart($f) $here
2529 set difffilestart($f) $here
2530 set mark fmark.[expr {$f + 1}]
2530 set mark fmark.[expr {$f + 1}]
2531 $ctext mark set $mark $here
2531 $ctext mark set $mark $here
2532 $ctext mark gravity $mark left
2532 $ctext mark gravity $mark left
2533 set header [lindex $mergefilelist($id) $f]
2533 set header [lindex $mergefilelist($id) $f]
2534 set l [expr {(78 - [string length $header]) / 2}]
2534 set l [expr {(78 - [string length $header]) / 2}]
2535 set pad [string range "----------------------------------------" 1 $l]
2535 set pad [string range "----------------------------------------" 1 $l]
2536 $ctext insert end "$pad $header $pad\n" filesep
2536 $ctext insert end "$pad $header $pad\n" filesep
2537 set groupfilelast $f
2537 set groupfilelast $f
2538 foreach p $parents($id) {
2538 foreach p $parents($id) {
2539 set diffoffset($p) 0
2539 set diffoffset($p) 0
2540 }
2540 }
2541 }
2541 }
2542
2542
2543 $ctext insert end "@@" msep
2543 $ctext insert end "@@" msep
2544 set nlines [expr {$grouplineend - $grouplinestart}]
2544 set nlines [expr {$grouplineend - $grouplinestart}]
2545 set events {}
2545 set events {}
2546 set pnum 0
2546 set pnum 0
2547 foreach p $parents($id) {
2547 foreach p $parents($id) {
2548 set startline [expr {$grouplinestart + $diffoffset($p)}]
2548 set startline [expr {$grouplinestart + $diffoffset($p)}]
2549 set ol $startline
2549 set ol $startline
2550 set nl $grouplinestart
2550 set nl $grouplinestart
2551 if {[info exists grouphunks($p)]} {
2551 if {[info exists grouphunks($p)]} {
2552 foreach h $grouphunks($p) {
2552 foreach h $grouphunks($p) {
2553 set l [lindex $h 2]
2553 set l [lindex $h 2]
2554 if {$nl < $l} {
2554 if {$nl < $l} {
2555 for {} {$nl < $l} {incr nl} {
2555 for {} {$nl < $l} {incr nl} {
2556 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2556 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2557 incr ol
2557 incr ol
2558 }
2558 }
2559 }
2559 }
2560 foreach chunk [lindex $h 5] {
2560 foreach chunk [lindex $h 5] {
2561 if {[llength $chunk] == 2} {
2561 if {[llength $chunk] == 2} {
2562 set olc [lindex $chunk 0]
2562 set olc [lindex $chunk 0]
2563 set nlc [lindex $chunk 1]
2563 set nlc [lindex $chunk 1]
2564 set nnl [expr {$nl + $nlc}]
2564 set nnl [expr {$nl + $nlc}]
2565 lappend events [list $nl $nnl $pnum $olc $nlc]
2565 lappend events [list $nl $nnl $pnum $olc $nlc]
2566 incr ol $olc
2566 incr ol $olc
2567 set nl $nnl
2567 set nl $nnl
2568 } else {
2568 } else {
2569 incr ol [lindex $chunk 0]
2569 incr ol [lindex $chunk 0]
2570 incr nl [lindex $chunk 0]
2570 incr nl [lindex $chunk 0]
2571 }
2571 }
2572 }
2572 }
2573 }
2573 }
2574 }
2574 }
2575 if {$nl < $grouplineend} {
2575 if {$nl < $grouplineend} {
2576 for {} {$nl < $grouplineend} {incr nl} {
2576 for {} {$nl < $grouplineend} {incr nl} {
2577 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2577 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2578 incr ol
2578 incr ol
2579 }
2579 }
2580 }
2580 }
2581 set nlines [expr {$ol - $startline}]
2581 set nlines [expr {$ol - $startline}]
2582 $ctext insert end " -$startline,$nlines" msep
2582 $ctext insert end " -$startline,$nlines" msep
2583 incr pnum
2583 incr pnum
2584 }
2584 }
2585
2585
2586 set nlines [expr {$grouplineend - $grouplinestart}]
2586 set nlines [expr {$grouplineend - $grouplinestart}]
2587 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2587 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2588
2588
2589 set events [lsort -integer -index 0 $events]
2589 set events [lsort -integer -index 0 $events]
2590 set nevents [llength $events]
2590 set nevents [llength $events]
2591 set nmerge $nparents($diffmergeid)
2591 set nmerge $nparents($diffmergeid)
2592 set l $grouplinestart
2592 set l $grouplinestart
2593 for {set i 0} {$i < $nevents} {set i $j} {
2593 for {set i 0} {$i < $nevents} {set i $j} {
2594 set nl [lindex $events $i 0]
2594 set nl [lindex $events $i 0]
2595 while {$l < $nl} {
2595 while {$l < $nl} {
2596 $ctext insert end " $filelines($id,$f,$l)\n"
2596 $ctext insert end " $filelines($id,$f,$l)\n"
2597 incr l
2597 incr l
2598 }
2598 }
2599 set e [lindex $events $i]
2599 set e [lindex $events $i]
2600 set enl [lindex $e 1]
2600 set enl [lindex $e 1]
2601 set j $i
2601 set j $i
2602 set active {}
2602 set active {}
2603 while 1 {
2603 while 1 {
2604 set pnum [lindex $e 2]
2604 set pnum [lindex $e 2]
2605 set olc [lindex $e 3]
2605 set olc [lindex $e 3]
2606 set nlc [lindex $e 4]
2606 set nlc [lindex $e 4]
2607 if {![info exists delta($pnum)]} {
2607 if {![info exists delta($pnum)]} {
2608 set delta($pnum) [expr {$olc - $nlc}]
2608 set delta($pnum) [expr {$olc - $nlc}]
2609 lappend active $pnum
2609 lappend active $pnum
2610 } else {
2610 } else {
2611 incr delta($pnum) [expr {$olc - $nlc}]
2611 incr delta($pnum) [expr {$olc - $nlc}]
2612 }
2612 }
2613 if {[incr j] >= $nevents} break
2613 if {[incr j] >= $nevents} break
2614 set e [lindex $events $j]
2614 set e [lindex $events $j]
2615 if {[lindex $e 0] >= $enl} break
2615 if {[lindex $e 0] >= $enl} break
2616 if {[lindex $e 1] > $enl} {
2616 if {[lindex $e 1] > $enl} {
2617 set enl [lindex $e 1]
2617 set enl [lindex $e 1]
2618 }
2618 }
2619 }
2619 }
2620 set nlc [expr {$enl - $l}]
2620 set nlc [expr {$enl - $l}]
2621 set ncol mresult
2621 set ncol mresult
2622 set bestpn -1
2622 set bestpn -1
2623 if {[llength $active] == $nmerge - 1} {
2623 if {[llength $active] == $nmerge - 1} {
2624 # no diff for one of the parents, i.e. it's identical
2624 # no diff for one of the parents, i.e. it's identical
2625 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2625 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2626 if {![info exists delta($pnum)]} {
2626 if {![info exists delta($pnum)]} {
2627 if {$pnum < $mergemax} {
2627 if {$pnum < $mergemax} {
2628 lappend ncol m$pnum
2628 lappend ncol m$pnum
2629 } else {
2629 } else {
2630 lappend ncol mmax
2630 lappend ncol mmax
2631 }
2631 }
2632 break
2632 break
2633 }
2633 }
2634 }
2634 }
2635 } elseif {[llength $active] == $nmerge} {
2635 } elseif {[llength $active] == $nmerge} {
2636 # all parents are different, see if one is very similar
2636 # all parents are different, see if one is very similar
2637 set bestsim 30
2637 set bestsim 30
2638 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2638 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2639 set sim [similarity $pnum $l $nlc $f \
2639 set sim [similarity $pnum $l $nlc $f \
2640 [lrange $events $i [expr {$j-1}]]]
2640 [lrange $events $i [expr {$j-1}]]]
2641 if {$sim > $bestsim} {
2641 if {$sim > $bestsim} {
2642 set bestsim $sim
2642 set bestsim $sim
2643 set bestpn $pnum
2643 set bestpn $pnum
2644 }
2644 }
2645 }
2645 }
2646 if {$bestpn >= 0} {
2646 if {$bestpn >= 0} {
2647 lappend ncol m$bestpn
2647 lappend ncol m$bestpn
2648 }
2648 }
2649 }
2649 }
2650 set pnum -1
2650 set pnum -1
2651 foreach p $parents($id) {
2651 foreach p $parents($id) {
2652 incr pnum
2652 incr pnum
2653 if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2653 if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2654 set olc [expr {$nlc + $delta($pnum)}]
2654 set olc [expr {$nlc + $delta($pnum)}]
2655 set ol [expr {$l + $diffoffset($p)}]
2655 set ol [expr {$l + $diffoffset($p)}]
2656 incr diffoffset($p) $delta($pnum)
2656 incr diffoffset($p) $delta($pnum)
2657 unset delta($pnum)
2657 unset delta($pnum)
2658 for {} {$olc > 0} {incr olc -1} {
2658 for {} {$olc > 0} {incr olc -1} {
2659 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2659 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2660 incr ol
2660 incr ol
2661 }
2661 }
2662 }
2662 }
2663 set endl [expr {$l + $nlc}]
2663 set endl [expr {$l + $nlc}]
2664 if {$bestpn >= 0} {
2664 if {$bestpn >= 0} {
2665 # show this pretty much as a normal diff
2665 # show this pretty much as a normal diff
2666 set p [lindex $parents($id) $bestpn]
2666 set p [lindex $parents($id) $bestpn]
2667 set ol [expr {$l + $diffoffset($p)}]
2667 set ol [expr {$l + $diffoffset($p)}]
2668 incr diffoffset($p) $delta($bestpn)
2668 incr diffoffset($p) $delta($bestpn)
2669 unset delta($bestpn)
2669 unset delta($bestpn)
2670 for {set k $i} {$k < $j} {incr k} {
2670 for {set k $i} {$k < $j} {incr k} {
2671 set e [lindex $events $k]
2671 set e [lindex $events $k]
2672 if {[lindex $e 2] != $bestpn} continue
2672 if {[lindex $e 2] != $bestpn} continue
2673 set nl [lindex $e 0]
2673 set nl [lindex $e 0]
2674 set ol [expr {$ol + $nl - $l}]
2674 set ol [expr {$ol + $nl - $l}]
2675 for {} {$l < $nl} {incr l} {
2675 for {} {$l < $nl} {incr l} {
2676 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2676 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2677 }
2677 }
2678 set c [lindex $e 3]
2678 set c [lindex $e 3]
2679 for {} {$c > 0} {incr c -1} {
2679 for {} {$c > 0} {incr c -1} {
2680 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2680 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2681 incr ol
2681 incr ol
2682 }
2682 }
2683 set nl [lindex $e 1]
2683 set nl [lindex $e 1]
2684 for {} {$l < $nl} {incr l} {
2684 for {} {$l < $nl} {incr l} {
2685 $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2685 $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2686 }
2686 }
2687 }
2687 }
2688 }
2688 }
2689 for {} {$l < $endl} {incr l} {
2689 for {} {$l < $endl} {incr l} {
2690 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2690 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2691 }
2691 }
2692 }
2692 }
2693 while {$l < $grouplineend} {
2693 while {$l < $grouplineend} {
2694 $ctext insert end " $filelines($id,$f,$l)\n"
2694 $ctext insert end " $filelines($id,$f,$l)\n"
2695 incr l
2695 incr l
2696 }
2696 }
2697 $ctext conf -state disabled
2697 $ctext conf -state disabled
2698 }
2698 }
2699
2699
2700 proc similarity {pnum l nlc f events} {
2700 proc similarity {pnum l nlc f events} {
2701 global diffmergeid parents diffoffset filelines
2701 global diffmergeid parents diffoffset filelines
2702
2702
2703 set id $diffmergeid
2703 set id $diffmergeid
2704 set p [lindex $parents($id) $pnum]
2704 set p [lindex $parents($id) $pnum]
2705 set ol [expr {$l + $diffoffset($p)}]
2705 set ol [expr {$l + $diffoffset($p)}]
2706 set endl [expr {$l + $nlc}]
2706 set endl [expr {$l + $nlc}]
2707 set same 0
2707 set same 0
2708 set diff 0
2708 set diff 0
2709 foreach e $events {
2709 foreach e $events {
2710 if {[lindex $e 2] != $pnum} continue
2710 if {[lindex $e 2] != $pnum} continue
2711 set nl [lindex $e 0]
2711 set nl [lindex $e 0]
2712 set ol [expr {$ol + $nl - $l}]
2712 set ol [expr {$ol + $nl - $l}]
2713 for {} {$l < $nl} {incr l} {
2713 for {} {$l < $nl} {incr l} {
2714 incr same [string length $filelines($id,$f,$l)]
2714 incr same [string length $filelines($id,$f,$l)]
2715 incr same
2715 incr same
2716 }
2716 }
2717 set oc [lindex $e 3]
2717 set oc [lindex $e 3]
2718 for {} {$oc > 0} {incr oc -1} {
2718 for {} {$oc > 0} {incr oc -1} {
2719 incr diff [string length $filelines($p,$f,$ol)]
2719 incr diff [string length $filelines($p,$f,$ol)]
2720 incr diff
2720 incr diff
2721 incr ol
2721 incr ol
2722 }
2722 }
2723 set nl [lindex $e 1]
2723 set nl [lindex $e 1]
2724 for {} {$l < $nl} {incr l} {
2724 for {} {$l < $nl} {incr l} {
2725 incr diff [string length $filelines($id,$f,$l)]
2725 incr diff [string length $filelines($id,$f,$l)]
2726 incr diff
2726 incr diff
2727 }
2727 }
2728 }
2728 }
2729 for {} {$l < $endl} {incr l} {
2729 for {} {$l < $endl} {incr l} {
2730 incr same [string length $filelines($id,$f,$l)]
2730 incr same [string length $filelines($id,$f,$l)]
2731 incr same
2731 incr same
2732 }
2732 }
2733 if {$same == 0} {
2733 if {$same == 0} {
2734 return 0
2734 return 0
2735 }
2735 }
2736 return [expr {200 * $same / (2 * $same + $diff)}]
2736 return [expr {200 * $same / (2 * $same + $diff)}]
2737 }
2737 }
2738
2738
2739 proc startdiff {ids} {
2739 proc startdiff {ids} {
2740 global treediffs diffids treepending diffmergeid
2740 global treediffs diffids treepending diffmergeid
2741
2741
2742 set diffids $ids
2742 set diffids $ids
2743 catch {unset diffmergeid}
2743 catch {unset diffmergeid}
2744 if {![info exists treediffs($ids)]} {
2744 if {![info exists treediffs($ids)]} {
2745 if {![info exists treepending]} {
2745 if {![info exists treepending]} {
2746 gettreediffs $ids
2746 gettreediffs $ids
2747 }
2747 }
2748 } else {
2748 } else {
2749 addtocflist $ids
2749 addtocflist $ids
2750 }
2750 }
2751 }
2751 }
2752
2752
2753 proc addtocflist {ids} {
2753 proc addtocflist {ids} {
2754 global treediffs cflist
2754 global treediffs cflist
2755 foreach f $treediffs($ids) {
2755 foreach f $treediffs($ids) {
2756 $cflist insert end $f
2756 $cflist insert end $f
2757 }
2757 }
2758 getblobdiffs $ids
2758 getblobdiffs $ids
2759 }
2759 }
2760
2760
2761 proc gettreediffs {ids} {
2761 proc gettreediffs {ids} {
2762 global treediff parents treepending
2762 global treediff parents treepending
2763 set treepending $ids
2763 set treepending $ids
2764 set treediff {}
2764 set treediff {}
2765 set id [lindex $ids 0]
2765 set id [lindex $ids 0]
2766 set p [lindex $ids 1]
2766 set p [lindex $ids 1]
2767 if [catch {set gdtf [open "|hg git-diff-tree -r $p $id" r]}] return
2767 if [catch {set gdtf [open "|hg debug-diff-tree -r $p $id" r]}] return
2768 fconfigure $gdtf -blocking 0
2768 fconfigure $gdtf -blocking 0
2769 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2769 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2770 }
2770 }
2771
2771
2772 proc gettreediffline {gdtf ids} {
2772 proc gettreediffline {gdtf ids} {
2773 global treediff treediffs treepending diffids diffmergeid
2773 global treediff treediffs treepending diffids diffmergeid
2774
2774
2775 set n [gets $gdtf line]
2775 set n [gets $gdtf line]
2776 if {$n < 0} {
2776 if {$n < 0} {
2777 if {![eof $gdtf]} return
2777 if {![eof $gdtf]} return
2778 close $gdtf
2778 close $gdtf
2779 set treediffs($ids) $treediff
2779 set treediffs($ids) $treediff
2780 unset treepending
2780 unset treepending
2781 if {$ids != $diffids} {
2781 if {$ids != $diffids} {
2782 gettreediffs $diffids
2782 gettreediffs $diffids
2783 } else {
2783 } else {
2784 if {[info exists diffmergeid]} {
2784 if {[info exists diffmergeid]} {
2785 contmergediff $ids
2785 contmergediff $ids
2786 } else {
2786 } else {
2787 addtocflist $ids
2787 addtocflist $ids
2788 }
2788 }
2789 }
2789 }
2790 return
2790 return
2791 }
2791 }
2792 set file [lindex $line 5]
2792 set file [lindex $line 5]
2793 lappend treediff $file
2793 lappend treediff $file
2794 }
2794 }
2795
2795
2796 proc getblobdiffs {ids} {
2796 proc getblobdiffs {ids} {
2797 global diffopts blobdifffd diffids env curdifftag curtagstart
2797 global diffopts blobdifffd diffids env curdifftag curtagstart
2798 global difffilestart nextupdate diffinhdr treediffs
2798 global difffilestart nextupdate diffinhdr treediffs
2799
2799
2800 set id [lindex $ids 0]
2800 set id [lindex $ids 0]
2801 set p [lindex $ids 1]
2801 set p [lindex $ids 1]
2802 set env(GIT_DIFF_OPTS) $diffopts
2802 set env(GIT_DIFF_OPTS) $diffopts
2803 set cmd [list | hg git-diff-tree -r -p -C $p $id]
2803 set cmd [list | hg debug-diff-tree -r -p -C $p $id]
2804 if {[catch {set bdf [open $cmd r]} err]} {
2804 if {[catch {set bdf [open $cmd r]} err]} {
2805 puts "error getting diffs: $err"
2805 puts "error getting diffs: $err"
2806 return
2806 return
2807 }
2807 }
2808 set diffinhdr 0
2808 set diffinhdr 0
2809 fconfigure $bdf -blocking 0
2809 fconfigure $bdf -blocking 0
2810 set blobdifffd($ids) $bdf
2810 set blobdifffd($ids) $bdf
2811 set curdifftag Comments
2811 set curdifftag Comments
2812 set curtagstart 0.0
2812 set curtagstart 0.0
2813 catch {unset difffilestart}
2813 catch {unset difffilestart}
2814 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2814 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2815 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2815 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2816 }
2816 }
2817
2817
2818 proc getblobdiffline {bdf ids} {
2818 proc getblobdiffline {bdf ids} {
2819 global diffids blobdifffd ctext curdifftag curtagstart
2819 global diffids blobdifffd ctext curdifftag curtagstart
2820 global diffnexthead diffnextnote difffilestart
2820 global diffnexthead diffnextnote difffilestart
2821 global nextupdate diffinhdr treediffs
2821 global nextupdate diffinhdr treediffs
2822 global gaudydiff
2822 global gaudydiff
2823
2823
2824 set n [gets $bdf line]
2824 set n [gets $bdf line]
2825 if {$n < 0} {
2825 if {$n < 0} {
2826 if {[eof $bdf]} {
2826 if {[eof $bdf]} {
2827 close $bdf
2827 close $bdf
2828 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2828 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2829 $ctext tag add $curdifftag $curtagstart end
2829 $ctext tag add $curdifftag $curtagstart end
2830 }
2830 }
2831 }
2831 }
2832 return
2832 return
2833 }
2833 }
2834 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2834 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2835 return
2835 return
2836 }
2836 }
2837 $ctext conf -state normal
2837 $ctext conf -state normal
2838 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2838 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2839 # start of a new file
2839 # start of a new file
2840 $ctext insert end "\n"
2840 $ctext insert end "\n"
2841 $ctext tag add $curdifftag $curtagstart end
2841 $ctext tag add $curdifftag $curtagstart end
2842 set curtagstart [$ctext index "end - 1c"]
2842 set curtagstart [$ctext index "end - 1c"]
2843 set header $newname
2843 set header $newname
2844 set here [$ctext index "end - 1c"]
2844 set here [$ctext index "end - 1c"]
2845 set i [lsearch -exact $treediffs($diffids) $fname]
2845 set i [lsearch -exact $treediffs($diffids) $fname]
2846 if {$i >= 0} {
2846 if {$i >= 0} {
2847 set difffilestart($i) $here
2847 set difffilestart($i) $here
2848 incr i
2848 incr i
2849 $ctext mark set fmark.$i $here
2849 $ctext mark set fmark.$i $here
2850 $ctext mark gravity fmark.$i left
2850 $ctext mark gravity fmark.$i left
2851 }
2851 }
2852 if {$newname != $fname} {
2852 if {$newname != $fname} {
2853 set i [lsearch -exact $treediffs($diffids) $newname]
2853 set i [lsearch -exact $treediffs($diffids) $newname]
2854 if {$i >= 0} {
2854 if {$i >= 0} {
2855 set difffilestart($i) $here
2855 set difffilestart($i) $here
2856 incr i
2856 incr i
2857 $ctext mark set fmark.$i $here
2857 $ctext mark set fmark.$i $here
2858 $ctext mark gravity fmark.$i left
2858 $ctext mark gravity fmark.$i left
2859 }
2859 }
2860 }
2860 }
2861 set curdifftag "f:$fname"
2861 set curdifftag "f:$fname"
2862 $ctext tag delete $curdifftag
2862 $ctext tag delete $curdifftag
2863 set l [expr {(78 - [string length $header]) / 2}]
2863 set l [expr {(78 - [string length $header]) / 2}]
2864 set pad [string range "----------------------------------------" 1 $l]
2864 set pad [string range "----------------------------------------" 1 $l]
2865 $ctext insert end "$pad $header $pad\n" filesep
2865 $ctext insert end "$pad $header $pad\n" filesep
2866 set diffinhdr 1
2866 set diffinhdr 1
2867 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2867 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2868 set diffinhdr 0
2868 set diffinhdr 0
2869 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2869 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2870 $line match f1l f1c f2l f2c rest]} {
2870 $line match f1l f1c f2l f2c rest]} {
2871 if {$gaudydiff} {
2871 if {$gaudydiff} {
2872 $ctext insert end "\t" hunksep
2872 $ctext insert end "\t" hunksep
2873 $ctext insert end " $f1l " d0 " $f2l " d1
2873 $ctext insert end " $f1l " d0 " $f2l " d1
2874 $ctext insert end " $rest \n" hunksep
2874 $ctext insert end " $rest \n" hunksep
2875 } else {
2875 } else {
2876 $ctext insert end "$line\n" hunksep
2876 $ctext insert end "$line\n" hunksep
2877 }
2877 }
2878 set diffinhdr 0
2878 set diffinhdr 0
2879 } else {
2879 } else {
2880 set x [string range $line 0 0]
2880 set x [string range $line 0 0]
2881 if {$x == "-" || $x == "+"} {
2881 if {$x == "-" || $x == "+"} {
2882 set tag [expr {$x == "+"}]
2882 set tag [expr {$x == "+"}]
2883 if {$gaudydiff} {
2883 if {$gaudydiff} {
2884 set line [string range $line 1 end]
2884 set line [string range $line 1 end]
2885 }
2885 }
2886 $ctext insert end "$line\n" d$tag
2886 $ctext insert end "$line\n" d$tag
2887 } elseif {$x == " "} {
2887 } elseif {$x == " "} {
2888 if {$gaudydiff} {
2888 if {$gaudydiff} {
2889 set line [string range $line 1 end]
2889 set line [string range $line 1 end]
2890 }
2890 }
2891 $ctext insert end "$line\n"
2891 $ctext insert end "$line\n"
2892 } elseif {$diffinhdr || $x == "\\"} {
2892 } elseif {$diffinhdr || $x == "\\"} {
2893 # e.g. "\ No newline at end of file"
2893 # e.g. "\ No newline at end of file"
2894 $ctext insert end "$line\n" filesep
2894 $ctext insert end "$line\n" filesep
2895 } else {
2895 } else {
2896 # Something else we don't recognize
2896 # Something else we don't recognize
2897 if {$curdifftag != "Comments"} {
2897 if {$curdifftag != "Comments"} {
2898 $ctext insert end "\n"
2898 $ctext insert end "\n"
2899 $ctext tag add $curdifftag $curtagstart end
2899 $ctext tag add $curdifftag $curtagstart end
2900 set curtagstart [$ctext index "end - 1c"]
2900 set curtagstart [$ctext index "end - 1c"]
2901 set curdifftag Comments
2901 set curdifftag Comments
2902 }
2902 }
2903 $ctext insert end "$line\n" filesep
2903 $ctext insert end "$line\n" filesep
2904 }
2904 }
2905 }
2905 }
2906 $ctext conf -state disabled
2906 $ctext conf -state disabled
2907 if {[clock clicks -milliseconds] >= $nextupdate} {
2907 if {[clock clicks -milliseconds] >= $nextupdate} {
2908 incr nextupdate 100
2908 incr nextupdate 100
2909 fileevent $bdf readable {}
2909 fileevent $bdf readable {}
2910 update
2910 update
2911 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2911 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2912 }
2912 }
2913 }
2913 }
2914
2914
2915 proc nextfile {} {
2915 proc nextfile {} {
2916 global difffilestart ctext
2916 global difffilestart ctext
2917 set here [$ctext index @0,0]
2917 set here [$ctext index @0,0]
2918 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2918 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2919 if {[$ctext compare $difffilestart($i) > $here]} {
2919 if {[$ctext compare $difffilestart($i) > $here]} {
2920 if {![info exists pos]
2920 if {![info exists pos]
2921 || [$ctext compare $difffilestart($i) < $pos]} {
2921 || [$ctext compare $difffilestart($i) < $pos]} {
2922 set pos $difffilestart($i)
2922 set pos $difffilestart($i)
2923 }
2923 }
2924 }
2924 }
2925 }
2925 }
2926 if {[info exists pos]} {
2926 if {[info exists pos]} {
2927 $ctext yview $pos
2927 $ctext yview $pos
2928 }
2928 }
2929 }
2929 }
2930
2930
2931 proc listboxsel {} {
2931 proc listboxsel {} {
2932 global ctext cflist currentid
2932 global ctext cflist currentid
2933 if {![info exists currentid]} return
2933 if {![info exists currentid]} return
2934 set sel [lsort [$cflist curselection]]
2934 set sel [lsort [$cflist curselection]]
2935 if {$sel eq {}} return
2935 if {$sel eq {}} return
2936 set first [lindex $sel 0]
2936 set first [lindex $sel 0]
2937 catch {$ctext yview fmark.$first}
2937 catch {$ctext yview fmark.$first}
2938 }
2938 }
2939
2939
2940 proc setcoords {} {
2940 proc setcoords {} {
2941 global linespc charspc canvx0 canvy0 mainfont
2941 global linespc charspc canvx0 canvy0 mainfont
2942 global xspc1 xspc2 lthickness
2942 global xspc1 xspc2 lthickness
2943
2943
2944 set linespc [font metrics $mainfont -linespace]
2944 set linespc [font metrics $mainfont -linespace]
2945 set charspc [font measure $mainfont "m"]
2945 set charspc [font measure $mainfont "m"]
2946 set canvy0 [expr 3 + 0.5 * $linespc]
2946 set canvy0 [expr 3 + 0.5 * $linespc]
2947 set canvx0 [expr 3 + 0.5 * $linespc]
2947 set canvx0 [expr 3 + 0.5 * $linespc]
2948 set lthickness [expr {int($linespc / 9) + 1}]
2948 set lthickness [expr {int($linespc / 9) + 1}]
2949 set xspc1(0) $linespc
2949 set xspc1(0) $linespc
2950 set xspc2 $linespc
2950 set xspc2 $linespc
2951 }
2951 }
2952
2952
2953 proc redisplay {} {
2953 proc redisplay {} {
2954 global stopped redisplaying phase
2954 global stopped redisplaying phase
2955 if {$stopped > 1} return
2955 if {$stopped > 1} return
2956 if {$phase == "getcommits"} return
2956 if {$phase == "getcommits"} return
2957 set redisplaying 1
2957 set redisplaying 1
2958 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2958 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2959 set stopped 1
2959 set stopped 1
2960 } else {
2960 } else {
2961 drawgraph
2961 drawgraph
2962 }
2962 }
2963 }
2963 }
2964
2964
2965 proc incrfont {inc} {
2965 proc incrfont {inc} {
2966 global mainfont namefont textfont ctext canv phase
2966 global mainfont namefont textfont ctext canv phase
2967 global stopped entries
2967 global stopped entries
2968 unmarkmatches
2968 unmarkmatches
2969 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2969 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2970 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2970 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2971 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2971 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2972 setcoords
2972 setcoords
2973 $ctext conf -font $textfont
2973 $ctext conf -font $textfont
2974 $ctext tag conf filesep -font [concat $textfont bold]
2974 $ctext tag conf filesep -font [concat $textfont bold]
2975 foreach e $entries {
2975 foreach e $entries {
2976 $e conf -font $mainfont
2976 $e conf -font $mainfont
2977 }
2977 }
2978 if {$phase == "getcommits"} {
2978 if {$phase == "getcommits"} {
2979 $canv itemconf textitems -font $mainfont
2979 $canv itemconf textitems -font $mainfont
2980 }
2980 }
2981 redisplay
2981 redisplay
2982 }
2982 }
2983
2983
2984 proc clearsha1 {} {
2984 proc clearsha1 {} {
2985 global sha1entry sha1string
2985 global sha1entry sha1string
2986 if {[string length $sha1string] == 40} {
2986 if {[string length $sha1string] == 40} {
2987 $sha1entry delete 0 end
2987 $sha1entry delete 0 end
2988 }
2988 }
2989 }
2989 }
2990
2990
2991 proc sha1change {n1 n2 op} {
2991 proc sha1change {n1 n2 op} {
2992 global sha1string currentid sha1but
2992 global sha1string currentid sha1but
2993 if {$sha1string == {}
2993 if {$sha1string == {}
2994 || ([info exists currentid] && $sha1string == $currentid)} {
2994 || ([info exists currentid] && $sha1string == $currentid)} {
2995 set state disabled
2995 set state disabled
2996 } else {
2996 } else {
2997 set state normal
2997 set state normal
2998 }
2998 }
2999 if {[$sha1but cget -state] == $state} return
2999 if {[$sha1but cget -state] == $state} return
3000 if {$state == "normal"} {
3000 if {$state == "normal"} {
3001 $sha1but conf -state normal -relief raised -text "Goto: "
3001 $sha1but conf -state normal -relief raised -text "Goto: "
3002 } else {
3002 } else {
3003 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3003 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3004 }
3004 }
3005 }
3005 }
3006
3006
3007 proc gotocommit {} {
3007 proc gotocommit {} {
3008 global sha1string currentid idline tagids
3008 global sha1string currentid idline tagids
3009 global lineid numcommits
3009 global lineid numcommits
3010
3010
3011 if {$sha1string == {}
3011 if {$sha1string == {}
3012 || ([info exists currentid] && $sha1string == $currentid)} return
3012 || ([info exists currentid] && $sha1string == $currentid)} return
3013 if {[info exists tagids($sha1string)]} {
3013 if {[info exists tagids($sha1string)]} {
3014 set id $tagids($sha1string)
3014 set id $tagids($sha1string)
3015 } else {
3015 } else {
3016 set id [string tolower $sha1string]
3016 set id [string tolower $sha1string]
3017 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3017 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3018 set matches {}
3018 set matches {}
3019 for {set l 0} {$l < $numcommits} {incr l} {
3019 for {set l 0} {$l < $numcommits} {incr l} {
3020 if {[string match $id* $lineid($l)]} {
3020 if {[string match $id* $lineid($l)]} {
3021 lappend matches $lineid($l)
3021 lappend matches $lineid($l)
3022 }
3022 }
3023 }
3023 }
3024 if {$matches ne {}} {
3024 if {$matches ne {}} {
3025 if {[llength $matches] > 1} {
3025 if {[llength $matches] > 1} {
3026 error_popup "Short SHA1 id $id is ambiguous"
3026 error_popup "Short SHA1 id $id is ambiguous"
3027 return
3027 return
3028 }
3028 }
3029 set id [lindex $matches 0]
3029 set id [lindex $matches 0]
3030 }
3030 }
3031 }
3031 }
3032 }
3032 }
3033 if {[info exists idline($id)]} {
3033 if {[info exists idline($id)]} {
3034 selectline $idline($id) 1
3034 selectline $idline($id) 1
3035 return
3035 return
3036 }
3036 }
3037 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3037 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3038 set type "SHA1 id"
3038 set type "SHA1 id"
3039 } else {
3039 } else {
3040 set type "Tag"
3040 set type "Tag"
3041 }
3041 }
3042 error_popup "$type $sha1string is not known"
3042 error_popup "$type $sha1string is not known"
3043 }
3043 }
3044
3044
3045 proc lineenter {x y id} {
3045 proc lineenter {x y id} {
3046 global hoverx hovery hoverid hovertimer
3046 global hoverx hovery hoverid hovertimer
3047 global commitinfo canv
3047 global commitinfo canv
3048
3048
3049 if {![info exists commitinfo($id)]} return
3049 if {![info exists commitinfo($id)]} return
3050 set hoverx $x
3050 set hoverx $x
3051 set hovery $y
3051 set hovery $y
3052 set hoverid $id
3052 set hoverid $id
3053 if {[info exists hovertimer]} {
3053 if {[info exists hovertimer]} {
3054 after cancel $hovertimer
3054 after cancel $hovertimer
3055 }
3055 }
3056 set hovertimer [after 500 linehover]
3056 set hovertimer [after 500 linehover]
3057 $canv delete hover
3057 $canv delete hover
3058 }
3058 }
3059
3059
3060 proc linemotion {x y id} {
3060 proc linemotion {x y id} {
3061 global hoverx hovery hoverid hovertimer
3061 global hoverx hovery hoverid hovertimer
3062
3062
3063 if {[info exists hoverid] && $id == $hoverid} {
3063 if {[info exists hoverid] && $id == $hoverid} {
3064 set hoverx $x
3064 set hoverx $x
3065 set hovery $y
3065 set hovery $y
3066 if {[info exists hovertimer]} {
3066 if {[info exists hovertimer]} {
3067 after cancel $hovertimer
3067 after cancel $hovertimer
3068 }
3068 }
3069 set hovertimer [after 500 linehover]
3069 set hovertimer [after 500 linehover]
3070 }
3070 }
3071 }
3071 }
3072
3072
3073 proc lineleave {id} {
3073 proc lineleave {id} {
3074 global hoverid hovertimer canv
3074 global hoverid hovertimer canv
3075
3075
3076 if {[info exists hoverid] && $id == $hoverid} {
3076 if {[info exists hoverid] && $id == $hoverid} {
3077 $canv delete hover
3077 $canv delete hover
3078 if {[info exists hovertimer]} {
3078 if {[info exists hovertimer]} {
3079 after cancel $hovertimer
3079 after cancel $hovertimer
3080 unset hovertimer
3080 unset hovertimer
3081 }
3081 }
3082 unset hoverid
3082 unset hoverid
3083 }
3083 }
3084 }
3084 }
3085
3085
3086 proc linehover {} {
3086 proc linehover {} {
3087 global hoverx hovery hoverid hovertimer
3087 global hoverx hovery hoverid hovertimer
3088 global canv linespc lthickness
3088 global canv linespc lthickness
3089 global commitinfo mainfont
3089 global commitinfo mainfont
3090
3090
3091 set text [lindex $commitinfo($hoverid) 0]
3091 set text [lindex $commitinfo($hoverid) 0]
3092 set ymax [lindex [$canv cget -scrollregion] 3]
3092 set ymax [lindex [$canv cget -scrollregion] 3]
3093 if {$ymax == {}} return
3093 if {$ymax == {}} return
3094 set yfrac [lindex [$canv yview] 0]
3094 set yfrac [lindex [$canv yview] 0]
3095 set x [expr {$hoverx + 2 * $linespc}]
3095 set x [expr {$hoverx + 2 * $linespc}]
3096 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3096 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3097 set x0 [expr {$x - 2 * $lthickness}]
3097 set x0 [expr {$x - 2 * $lthickness}]
3098 set y0 [expr {$y - 2 * $lthickness}]
3098 set y0 [expr {$y - 2 * $lthickness}]
3099 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3099 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3100 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3100 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3101 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3101 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3102 -fill \#ffff80 -outline black -width 1 -tags hover]
3102 -fill \#ffff80 -outline black -width 1 -tags hover]
3103 $canv raise $t
3103 $canv raise $t
3104 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
3104 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
3105 $canv raise $t
3105 $canv raise $t
3106 }
3106 }
3107
3107
3108 proc clickisonarrow {id y} {
3108 proc clickisonarrow {id y} {
3109 global mainline mainlinearrow sidelines lthickness
3109 global mainline mainlinearrow sidelines lthickness
3110
3110
3111 set thresh [expr {2 * $lthickness + 6}]
3111 set thresh [expr {2 * $lthickness + 6}]
3112 if {[info exists mainline($id)]} {
3112 if {[info exists mainline($id)]} {
3113 if {$mainlinearrow($id) ne "none"} {
3113 if {$mainlinearrow($id) ne "none"} {
3114 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3114 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3115 return "up"
3115 return "up"
3116 }
3116 }
3117 }
3117 }
3118 }
3118 }
3119 if {[info exists sidelines($id)]} {
3119 if {[info exists sidelines($id)]} {
3120 foreach ls $sidelines($id) {
3120 foreach ls $sidelines($id) {
3121 set coords [lindex $ls 0]
3121 set coords [lindex $ls 0]
3122 set arrow [lindex $ls 2]
3122 set arrow [lindex $ls 2]
3123 if {$arrow eq "first" || $arrow eq "both"} {
3123 if {$arrow eq "first" || $arrow eq "both"} {
3124 if {abs([lindex $coords 1] - $y) < $thresh} {
3124 if {abs([lindex $coords 1] - $y) < $thresh} {
3125 return "up"
3125 return "up"
3126 }
3126 }
3127 }
3127 }
3128 if {$arrow eq "last" || $arrow eq "both"} {
3128 if {$arrow eq "last" || $arrow eq "both"} {
3129 if {abs([lindex $coords end] - $y) < $thresh} {
3129 if {abs([lindex $coords end] - $y) < $thresh} {
3130 return "down"
3130 return "down"
3131 }
3131 }
3132 }
3132 }
3133 }
3133 }
3134 }
3134 }
3135 return {}
3135 return {}
3136 }
3136 }
3137
3137
3138 proc arrowjump {id dirn y} {
3138 proc arrowjump {id dirn y} {
3139 global mainline sidelines canv
3139 global mainline sidelines canv
3140
3140
3141 set yt {}
3141 set yt {}
3142 if {$dirn eq "down"} {
3142 if {$dirn eq "down"} {
3143 if {[info exists mainline($id)]} {
3143 if {[info exists mainline($id)]} {
3144 set y1 [lindex $mainline($id) 1]
3144 set y1 [lindex $mainline($id) 1]
3145 if {$y1 > $y} {
3145 if {$y1 > $y} {
3146 set yt $y1
3146 set yt $y1
3147 }
3147 }
3148 }
3148 }
3149 if {[info exists sidelines($id)]} {
3149 if {[info exists sidelines($id)]} {
3150 foreach ls $sidelines($id) {
3150 foreach ls $sidelines($id) {
3151 set y1 [lindex $ls 0 1]
3151 set y1 [lindex $ls 0 1]
3152 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3152 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3153 set yt $y1
3153 set yt $y1
3154 }
3154 }
3155 }
3155 }
3156 }
3156 }
3157 } else {
3157 } else {
3158 if {[info exists sidelines($id)]} {
3158 if {[info exists sidelines($id)]} {
3159 foreach ls $sidelines($id) {
3159 foreach ls $sidelines($id) {
3160 set y1 [lindex $ls 0 end]
3160 set y1 [lindex $ls 0 end]
3161 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3161 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3162 set yt $y1
3162 set yt $y1
3163 }
3163 }
3164 }
3164 }
3165 }
3165 }
3166 }
3166 }
3167 if {$yt eq {}} return
3167 if {$yt eq {}} return
3168 set ymax [lindex [$canv cget -scrollregion] 3]
3168 set ymax [lindex [$canv cget -scrollregion] 3]
3169 if {$ymax eq {} || $ymax <= 0} return
3169 if {$ymax eq {} || $ymax <= 0} return
3170 set view [$canv yview]
3170 set view [$canv yview]
3171 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3171 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3172 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3172 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3173 if {$yfrac < 0} {
3173 if {$yfrac < 0} {
3174 set yfrac 0
3174 set yfrac 0
3175 }
3175 }
3176 $canv yview moveto $yfrac
3176 $canv yview moveto $yfrac
3177 }
3177 }
3178
3178
3179 proc lineclick {x y id isnew} {
3179 proc lineclick {x y id isnew} {
3180 global ctext commitinfo children cflist canv thickerline
3180 global ctext commitinfo children cflist canv thickerline
3181
3181
3182 unmarkmatches
3182 unmarkmatches
3183 unselectline
3183 unselectline
3184 normalline
3184 normalline
3185 $canv delete hover
3185 $canv delete hover
3186 # draw this line thicker than normal
3186 # draw this line thicker than normal
3187 drawlines $id 1
3187 drawlines $id 1
3188 set thickerline $id
3188 set thickerline $id
3189 if {$isnew} {
3189 if {$isnew} {
3190 set ymax [lindex [$canv cget -scrollregion] 3]
3190 set ymax [lindex [$canv cget -scrollregion] 3]
3191 if {$ymax eq {}} return
3191 if {$ymax eq {}} return
3192 set yfrac [lindex [$canv yview] 0]
3192 set yfrac [lindex [$canv yview] 0]
3193 set y [expr {$y + $yfrac * $ymax}]
3193 set y [expr {$y + $yfrac * $ymax}]
3194 }
3194 }
3195 set dirn [clickisonarrow $id $y]
3195 set dirn [clickisonarrow $id $y]
3196 if {$dirn ne {}} {
3196 if {$dirn ne {}} {
3197 arrowjump $id $dirn $y
3197 arrowjump $id $dirn $y
3198 return
3198 return
3199 }
3199 }
3200
3200
3201 if {$isnew} {
3201 if {$isnew} {
3202 addtohistory [list lineclick $x $y $id 0]
3202 addtohistory [list lineclick $x $y $id 0]
3203 }
3203 }
3204 # fill the details pane with info about this line
3204 # fill the details pane with info about this line
3205 $ctext conf -state normal
3205 $ctext conf -state normal
3206 $ctext delete 0.0 end
3206 $ctext delete 0.0 end
3207 $ctext tag conf link -foreground blue -underline 1
3207 $ctext tag conf link -foreground blue -underline 1
3208 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3208 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3209 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3209 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3210 $ctext insert end "Parent:\t"
3210 $ctext insert end "Parent:\t"
3211 $ctext insert end $id [list link link0]
3211 $ctext insert end $id [list link link0]
3212 $ctext tag bind link0 <1> [list selbyid $id]
3212 $ctext tag bind link0 <1> [list selbyid $id]
3213 set info $commitinfo($id)
3213 set info $commitinfo($id)
3214 $ctext insert end "\n\t[lindex $info 0]\n"
3214 $ctext insert end "\n\t[lindex $info 0]\n"
3215 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3215 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3216 $ctext insert end "\tDate:\t[lindex $info 2]\n"
3216 $ctext insert end "\tDate:\t[lindex $info 2]\n"
3217 if {[info exists children($id)]} {
3217 if {[info exists children($id)]} {
3218 $ctext insert end "\nChildren:"
3218 $ctext insert end "\nChildren:"
3219 set i 0
3219 set i 0
3220 foreach child $children($id) {
3220 foreach child $children($id) {
3221 incr i
3221 incr i
3222 set info $commitinfo($child)
3222 set info $commitinfo($child)
3223 $ctext insert end "\n\t"
3223 $ctext insert end "\n\t"
3224 $ctext insert end $child [list link link$i]
3224 $ctext insert end $child [list link link$i]
3225 $ctext tag bind link$i <1> [list selbyid $child]
3225 $ctext tag bind link$i <1> [list selbyid $child]
3226 $ctext insert end "\n\t[lindex $info 0]"
3226 $ctext insert end "\n\t[lindex $info 0]"
3227 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3227 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3228 $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
3228 $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
3229 }
3229 }
3230 }
3230 }
3231 $ctext conf -state disabled
3231 $ctext conf -state disabled
3232
3232
3233 $cflist delete 0 end
3233 $cflist delete 0 end
3234 }
3234 }
3235
3235
3236 proc normalline {} {
3236 proc normalline {} {
3237 global thickerline
3237 global thickerline
3238 if {[info exists thickerline]} {
3238 if {[info exists thickerline]} {
3239 drawlines $thickerline 0
3239 drawlines $thickerline 0
3240 unset thickerline
3240 unset thickerline
3241 }
3241 }
3242 }
3242 }
3243
3243
3244 proc selbyid {id} {
3244 proc selbyid {id} {
3245 global idline
3245 global idline
3246 if {[info exists idline($id)]} {
3246 if {[info exists idline($id)]} {
3247 selectline $idline($id) 1
3247 selectline $idline($id) 1
3248 }
3248 }
3249 }
3249 }
3250
3250
3251 proc mstime {} {
3251 proc mstime {} {
3252 global startmstime
3252 global startmstime
3253 if {![info exists startmstime]} {
3253 if {![info exists startmstime]} {
3254 set startmstime [clock clicks -milliseconds]
3254 set startmstime [clock clicks -milliseconds]
3255 }
3255 }
3256 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3256 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3257 }
3257 }
3258
3258
3259 proc rowmenu {x y id} {
3259 proc rowmenu {x y id} {
3260 global rowctxmenu idline selectedline rowmenuid
3260 global rowctxmenu idline selectedline rowmenuid
3261
3261
3262 if {![info exists selectedline] || $idline($id) eq $selectedline} {
3262 if {![info exists selectedline] || $idline($id) eq $selectedline} {
3263 set state disabled
3263 set state disabled
3264 } else {
3264 } else {
3265 set state normal
3265 set state normal
3266 }
3266 }
3267 $rowctxmenu entryconfigure 0 -state $state
3267 $rowctxmenu entryconfigure 0 -state $state
3268 $rowctxmenu entryconfigure 1 -state $state
3268 $rowctxmenu entryconfigure 1 -state $state
3269 $rowctxmenu entryconfigure 2 -state $state
3269 $rowctxmenu entryconfigure 2 -state $state
3270 set rowmenuid $id
3270 set rowmenuid $id
3271 tk_popup $rowctxmenu $x $y
3271 tk_popup $rowctxmenu $x $y
3272 }
3272 }
3273
3273
3274 proc diffvssel {dirn} {
3274 proc diffvssel {dirn} {
3275 global rowmenuid selectedline lineid
3275 global rowmenuid selectedline lineid
3276
3276
3277 if {![info exists selectedline]} return
3277 if {![info exists selectedline]} return
3278 if {$dirn} {
3278 if {$dirn} {
3279 set oldid $lineid($selectedline)
3279 set oldid $lineid($selectedline)
3280 set newid $rowmenuid
3280 set newid $rowmenuid
3281 } else {
3281 } else {
3282 set oldid $rowmenuid
3282 set oldid $rowmenuid
3283 set newid $lineid($selectedline)
3283 set newid $lineid($selectedline)
3284 }
3284 }
3285 addtohistory [list doseldiff $oldid $newid]
3285 addtohistory [list doseldiff $oldid $newid]
3286 doseldiff $oldid $newid
3286 doseldiff $oldid $newid
3287 }
3287 }
3288
3288
3289 proc doseldiff {oldid newid} {
3289 proc doseldiff {oldid newid} {
3290 global ctext cflist
3290 global ctext cflist
3291 global commitinfo
3291 global commitinfo
3292
3292
3293 $ctext conf -state normal
3293 $ctext conf -state normal
3294 $ctext delete 0.0 end
3294 $ctext delete 0.0 end
3295 $ctext mark set fmark.0 0.0
3295 $ctext mark set fmark.0 0.0
3296 $ctext mark gravity fmark.0 left
3296 $ctext mark gravity fmark.0 left
3297 $cflist delete 0 end
3297 $cflist delete 0 end
3298 $cflist insert end "Top"
3298 $cflist insert end "Top"
3299 $ctext insert end "From "
3299 $ctext insert end "From "
3300 $ctext tag conf link -foreground blue -underline 1
3300 $ctext tag conf link -foreground blue -underline 1
3301 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3301 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3302 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3302 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3303 $ctext tag bind link0 <1> [list selbyid $oldid]
3303 $ctext tag bind link0 <1> [list selbyid $oldid]
3304 $ctext insert end $oldid [list link link0]
3304 $ctext insert end $oldid [list link link0]
3305 $ctext insert end "\n "
3305 $ctext insert end "\n "
3306 $ctext insert end [lindex $commitinfo($oldid) 0]
3306 $ctext insert end [lindex $commitinfo($oldid) 0]
3307 $ctext insert end "\n\nTo "
3307 $ctext insert end "\n\nTo "
3308 $ctext tag bind link1 <1> [list selbyid $newid]
3308 $ctext tag bind link1 <1> [list selbyid $newid]
3309 $ctext insert end $newid [list link link1]
3309 $ctext insert end $newid [list link link1]
3310 $ctext insert end "\n "
3310 $ctext insert end "\n "
3311 $ctext insert end [lindex $commitinfo($newid) 0]
3311 $ctext insert end [lindex $commitinfo($newid) 0]
3312 $ctext insert end "\n"
3312 $ctext insert end "\n"
3313 $ctext conf -state disabled
3313 $ctext conf -state disabled
3314 $ctext tag delete Comments
3314 $ctext tag delete Comments
3315 $ctext tag remove found 1.0 end
3315 $ctext tag remove found 1.0 end
3316 startdiff [list $newid $oldid]
3316 startdiff [list $newid $oldid]
3317 }
3317 }
3318
3318
3319 proc mkpatch {} {
3319 proc mkpatch {} {
3320 global rowmenuid currentid commitinfo patchtop patchnum
3320 global rowmenuid currentid commitinfo patchtop patchnum
3321
3321
3322 if {![info exists currentid]} return
3322 if {![info exists currentid]} return
3323 set oldid $currentid
3323 set oldid $currentid
3324 set oldhead [lindex $commitinfo($oldid) 0]
3324 set oldhead [lindex $commitinfo($oldid) 0]
3325 set newid $rowmenuid
3325 set newid $rowmenuid
3326 set newhead [lindex $commitinfo($newid) 0]
3326 set newhead [lindex $commitinfo($newid) 0]
3327 set top .patch
3327 set top .patch
3328 set patchtop $top
3328 set patchtop $top
3329 catch {destroy $top}
3329 catch {destroy $top}
3330 toplevel $top
3330 toplevel $top
3331 label $top.title -text "Generate patch"
3331 label $top.title -text "Generate patch"
3332 grid $top.title - -pady 10
3332 grid $top.title - -pady 10
3333 label $top.from -text "From:"
3333 label $top.from -text "From:"
3334 entry $top.fromsha1 -width 40 -relief flat
3334 entry $top.fromsha1 -width 40 -relief flat
3335 $top.fromsha1 insert 0 $oldid
3335 $top.fromsha1 insert 0 $oldid
3336 $top.fromsha1 conf -state readonly
3336 $top.fromsha1 conf -state readonly
3337 grid $top.from $top.fromsha1 -sticky w
3337 grid $top.from $top.fromsha1 -sticky w
3338 entry $top.fromhead -width 60 -relief flat
3338 entry $top.fromhead -width 60 -relief flat
3339 $top.fromhead insert 0 $oldhead
3339 $top.fromhead insert 0 $oldhead
3340 $top.fromhead conf -state readonly
3340 $top.fromhead conf -state readonly
3341 grid x $top.fromhead -sticky w
3341 grid x $top.fromhead -sticky w
3342 label $top.to -text "To:"
3342 label $top.to -text "To:"
3343 entry $top.tosha1 -width 40 -relief flat
3343 entry $top.tosha1 -width 40 -relief flat
3344 $top.tosha1 insert 0 $newid
3344 $top.tosha1 insert 0 $newid
3345 $top.tosha1 conf -state readonly
3345 $top.tosha1 conf -state readonly
3346 grid $top.to $top.tosha1 -sticky w
3346 grid $top.to $top.tosha1 -sticky w
3347 entry $top.tohead -width 60 -relief flat
3347 entry $top.tohead -width 60 -relief flat
3348 $top.tohead insert 0 $newhead
3348 $top.tohead insert 0 $newhead
3349 $top.tohead conf -state readonly
3349 $top.tohead conf -state readonly
3350 grid x $top.tohead -sticky w
3350 grid x $top.tohead -sticky w
3351 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3351 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3352 grid $top.rev x -pady 10
3352 grid $top.rev x -pady 10
3353 label $top.flab -text "Output file:"
3353 label $top.flab -text "Output file:"
3354 entry $top.fname -width 60
3354 entry $top.fname -width 60
3355 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3355 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3356 incr patchnum
3356 incr patchnum
3357 grid $top.flab $top.fname -sticky w
3357 grid $top.flab $top.fname -sticky w
3358 frame $top.buts
3358 frame $top.buts
3359 button $top.buts.gen -text "Generate" -command mkpatchgo
3359 button $top.buts.gen -text "Generate" -command mkpatchgo
3360 button $top.buts.can -text "Cancel" -command mkpatchcan
3360 button $top.buts.can -text "Cancel" -command mkpatchcan
3361 grid $top.buts.gen $top.buts.can
3361 grid $top.buts.gen $top.buts.can
3362 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3362 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3363 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3363 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3364 grid $top.buts - -pady 10 -sticky ew
3364 grid $top.buts - -pady 10 -sticky ew
3365 focus $top.fname
3365 focus $top.fname
3366 }
3366 }
3367
3367
3368 proc mkpatchrev {} {
3368 proc mkpatchrev {} {
3369 global patchtop
3369 global patchtop
3370
3370
3371 set oldid [$patchtop.fromsha1 get]
3371 set oldid [$patchtop.fromsha1 get]
3372 set oldhead [$patchtop.fromhead get]
3372 set oldhead [$patchtop.fromhead get]
3373 set newid [$patchtop.tosha1 get]
3373 set newid [$patchtop.tosha1 get]
3374 set newhead [$patchtop.tohead get]
3374 set newhead [$patchtop.tohead get]
3375 foreach e [list fromsha1 fromhead tosha1 tohead] \
3375 foreach e [list fromsha1 fromhead tosha1 tohead] \
3376 v [list $newid $newhead $oldid $oldhead] {
3376 v [list $newid $newhead $oldid $oldhead] {
3377 $patchtop.$e conf -state normal
3377 $patchtop.$e conf -state normal
3378 $patchtop.$e delete 0 end
3378 $patchtop.$e delete 0 end
3379 $patchtop.$e insert 0 $v
3379 $patchtop.$e insert 0 $v
3380 $patchtop.$e conf -state readonly
3380 $patchtop.$e conf -state readonly
3381 }
3381 }
3382 }
3382 }
3383
3383
3384 proc mkpatchgo {} {
3384 proc mkpatchgo {} {
3385 global patchtop
3385 global patchtop
3386
3386
3387 set oldid [$patchtop.fromsha1 get]
3387 set oldid [$patchtop.fromsha1 get]
3388 set newid [$patchtop.tosha1 get]
3388 set newid [$patchtop.tosha1 get]
3389 set fname [$patchtop.fname get]
3389 set fname [$patchtop.fname get]
3390 if {[catch {exec hg git-diff-tree -p $oldid $newid >$fname &} err]} {
3390 if {[catch {exec hg debug-diff-tree -p $oldid $newid >$fname &} err]} {
3391 error_popup "Error creating patch: $err"
3391 error_popup "Error creating patch: $err"
3392 }
3392 }
3393 catch {destroy $patchtop}
3393 catch {destroy $patchtop}
3394 unset patchtop
3394 unset patchtop
3395 }
3395 }
3396
3396
3397 proc mkpatchcan {} {
3397 proc mkpatchcan {} {
3398 global patchtop
3398 global patchtop
3399
3399
3400 catch {destroy $patchtop}
3400 catch {destroy $patchtop}
3401 unset patchtop
3401 unset patchtop
3402 }
3402 }
3403
3403
3404 proc mktag {} {
3404 proc mktag {} {
3405 global rowmenuid mktagtop commitinfo
3405 global rowmenuid mktagtop commitinfo
3406
3406
3407 set top .maketag
3407 set top .maketag
3408 set mktagtop $top
3408 set mktagtop $top
3409 catch {destroy $top}
3409 catch {destroy $top}
3410 toplevel $top
3410 toplevel $top
3411 label $top.title -text "Create tag"
3411 label $top.title -text "Create tag"
3412 grid $top.title - -pady 10
3412 grid $top.title - -pady 10
3413 label $top.id -text "ID:"
3413 label $top.id -text "ID:"
3414 entry $top.sha1 -width 40 -relief flat
3414 entry $top.sha1 -width 40 -relief flat
3415 $top.sha1 insert 0 $rowmenuid
3415 $top.sha1 insert 0 $rowmenuid
3416 $top.sha1 conf -state readonly
3416 $top.sha1 conf -state readonly
3417 grid $top.id $top.sha1 -sticky w
3417 grid $top.id $top.sha1 -sticky w
3418 entry $top.head -width 60 -relief flat
3418 entry $top.head -width 60 -relief flat
3419 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3419 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3420 $top.head conf -state readonly
3420 $top.head conf -state readonly
3421 grid x $top.head -sticky w
3421 grid x $top.head -sticky w
3422 label $top.tlab -text "Tag name:"
3422 label $top.tlab -text "Tag name:"
3423 entry $top.tag -width 60
3423 entry $top.tag -width 60
3424 grid $top.tlab $top.tag -sticky w
3424 grid $top.tlab $top.tag -sticky w
3425 frame $top.buts
3425 frame $top.buts
3426 button $top.buts.gen -text "Create" -command mktaggo
3426 button $top.buts.gen -text "Create" -command mktaggo
3427 button $top.buts.can -text "Cancel" -command mktagcan
3427 button $top.buts.can -text "Cancel" -command mktagcan
3428 grid $top.buts.gen $top.buts.can
3428 grid $top.buts.gen $top.buts.can
3429 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3429 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3430 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3430 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3431 grid $top.buts - -pady 10 -sticky ew
3431 grid $top.buts - -pady 10 -sticky ew
3432 focus $top.tag
3432 focus $top.tag
3433 }
3433 }
3434
3434
3435 proc domktag {} {
3435 proc domktag {} {
3436 global mktagtop env tagids idtags
3436 global mktagtop env tagids idtags
3437
3437
3438 set id [$mktagtop.sha1 get]
3438 set id [$mktagtop.sha1 get]
3439 set tag [$mktagtop.tag get]
3439 set tag [$mktagtop.tag get]
3440 if {$tag == {}} {
3440 if {$tag == {}} {
3441 error_popup "No tag name specified"
3441 error_popup "No tag name specified"
3442 return
3442 return
3443 }
3443 }
3444 if {[info exists tagids($tag)]} {
3444 if {[info exists tagids($tag)]} {
3445 error_popup "Tag \"$tag\" already exists"
3445 error_popup "Tag \"$tag\" already exists"
3446 return
3446 return
3447 }
3447 }
3448 if {[catch {
3448 if {[catch {
3449 set out [exec hg tag $tag $id]
3449 set out [exec hg tag $tag $id]
3450 } err]} {
3450 } err]} {
3451 error_popup "Error creating tag: $err"
3451 error_popup "Error creating tag: $err"
3452 return
3452 return
3453 }
3453 }
3454
3454
3455 set tagids($tag) $id
3455 set tagids($tag) $id
3456 lappend idtags($id) $tag
3456 lappend idtags($id) $tag
3457 redrawtags $id
3457 redrawtags $id
3458 }
3458 }
3459
3459
3460 proc redrawtags {id} {
3460 proc redrawtags {id} {
3461 global canv linehtag idline idpos selectedline
3461 global canv linehtag idline idpos selectedline
3462
3462
3463 if {![info exists idline($id)]} return
3463 if {![info exists idline($id)]} return
3464 $canv delete tag.$id
3464 $canv delete tag.$id
3465 set xt [eval drawtags $id $idpos($id)]
3465 set xt [eval drawtags $id $idpos($id)]
3466 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3466 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3467 if {[info exists selectedline] && $selectedline == $idline($id)} {
3467 if {[info exists selectedline] && $selectedline == $idline($id)} {
3468 selectline $selectedline 0
3468 selectline $selectedline 0
3469 }
3469 }
3470 }
3470 }
3471
3471
3472 proc mktagcan {} {
3472 proc mktagcan {} {
3473 global mktagtop
3473 global mktagtop
3474
3474
3475 catch {destroy $mktagtop}
3475 catch {destroy $mktagtop}
3476 unset mktagtop
3476 unset mktagtop
3477 }
3477 }
3478
3478
3479 proc mktaggo {} {
3479 proc mktaggo {} {
3480 domktag
3480 domktag
3481 mktagcan
3481 mktagcan
3482 }
3482 }
3483
3483
3484 proc writecommit {} {
3484 proc writecommit {} {
3485 global rowmenuid wrcomtop commitinfo wrcomcmd
3485 global rowmenuid wrcomtop commitinfo wrcomcmd
3486
3486
3487 set top .writecommit
3487 set top .writecommit
3488 set wrcomtop $top
3488 set wrcomtop $top
3489 catch {destroy $top}
3489 catch {destroy $top}
3490 toplevel $top
3490 toplevel $top
3491 label $top.title -text "Write commit to file"
3491 label $top.title -text "Write commit to file"
3492 grid $top.title - -pady 10
3492 grid $top.title - -pady 10
3493 label $top.id -text "ID:"
3493 label $top.id -text "ID:"
3494 entry $top.sha1 -width 40 -relief flat
3494 entry $top.sha1 -width 40 -relief flat
3495 $top.sha1 insert 0 $rowmenuid
3495 $top.sha1 insert 0 $rowmenuid
3496 $top.sha1 conf -state readonly
3496 $top.sha1 conf -state readonly
3497 grid $top.id $top.sha1 -sticky w
3497 grid $top.id $top.sha1 -sticky w
3498 entry $top.head -width 60 -relief flat
3498 entry $top.head -width 60 -relief flat
3499 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3499 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3500 $top.head conf -state readonly
3500 $top.head conf -state readonly
3501 grid x $top.head -sticky w
3501 grid x $top.head -sticky w
3502 label $top.clab -text "Command:"
3502 label $top.clab -text "Command:"
3503 entry $top.cmd -width 60 -textvariable wrcomcmd
3503 entry $top.cmd -width 60 -textvariable wrcomcmd
3504 grid $top.clab $top.cmd -sticky w -pady 10
3504 grid $top.clab $top.cmd -sticky w -pady 10
3505 label $top.flab -text "Output file:"
3505 label $top.flab -text "Output file:"
3506 entry $top.fname -width 60
3506 entry $top.fname -width 60
3507 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3507 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3508 grid $top.flab $top.fname -sticky w
3508 grid $top.flab $top.fname -sticky w
3509 frame $top.buts
3509 frame $top.buts
3510 button $top.buts.gen -text "Write" -command wrcomgo
3510 button $top.buts.gen -text "Write" -command wrcomgo
3511 button $top.buts.can -text "Cancel" -command wrcomcan
3511 button $top.buts.can -text "Cancel" -command wrcomcan
3512 grid $top.buts.gen $top.buts.can
3512 grid $top.buts.gen $top.buts.can
3513 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3513 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3514 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3514 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3515 grid $top.buts - -pady 10 -sticky ew
3515 grid $top.buts - -pady 10 -sticky ew
3516 focus $top.fname
3516 focus $top.fname
3517 }
3517 }
3518
3518
3519 proc wrcomgo {} {
3519 proc wrcomgo {} {
3520 global wrcomtop
3520 global wrcomtop
3521
3521
3522 set id [$wrcomtop.sha1 get]
3522 set id [$wrcomtop.sha1 get]
3523 set cmd "echo $id | [$wrcomtop.cmd get]"
3523 set cmd "echo $id | [$wrcomtop.cmd get]"
3524 set fname [$wrcomtop.fname get]
3524 set fname [$wrcomtop.fname get]
3525 if {[catch {exec sh -c $cmd >$fname &} err]} {
3525 if {[catch {exec sh -c $cmd >$fname &} err]} {
3526 error_popup "Error writing commit: $err"
3526 error_popup "Error writing commit: $err"
3527 }
3527 }
3528 catch {destroy $wrcomtop}
3528 catch {destroy $wrcomtop}
3529 unset wrcomtop
3529 unset wrcomtop
3530 }
3530 }
3531
3531
3532 proc wrcomcan {} {
3532 proc wrcomcan {} {
3533 global wrcomtop
3533 global wrcomtop
3534
3534
3535 catch {destroy $wrcomtop}
3535 catch {destroy $wrcomtop}
3536 unset wrcomtop
3536 unset wrcomtop
3537 }
3537 }
3538
3538
3539 proc listrefs {id} {
3539 proc listrefs {id} {
3540 global idtags idheads idotherrefs
3540 global idtags idheads idotherrefs
3541
3541
3542 set x {}
3542 set x {}
3543 if {[info exists idtags($id)]} {
3543 if {[info exists idtags($id)]} {
3544 set x $idtags($id)
3544 set x $idtags($id)
3545 }
3545 }
3546 set y {}
3546 set y {}
3547 if {[info exists idheads($id)]} {
3547 if {[info exists idheads($id)]} {
3548 set y $idheads($id)
3548 set y $idheads($id)
3549 }
3549 }
3550 set z {}
3550 set z {}
3551 if {[info exists idotherrefs($id)]} {
3551 if {[info exists idotherrefs($id)]} {
3552 set z $idotherrefs($id)
3552 set z $idotherrefs($id)
3553 }
3553 }
3554 return [list $x $y $z]
3554 return [list $x $y $z]
3555 }
3555 }
3556
3556
3557 proc rereadrefs {} {
3557 proc rereadrefs {} {
3558 global idtags idheads idotherrefs
3558 global idtags idheads idotherrefs
3559 global tagids headids otherrefids
3559 global tagids headids otherrefids
3560
3560
3561 set refids [concat [array names idtags] \
3561 set refids [concat [array names idtags] \
3562 [array names idheads] [array names idotherrefs]]
3562 [array names idheads] [array names idotherrefs]]
3563 foreach id $refids {
3563 foreach id $refids {
3564 if {![info exists ref($id)]} {
3564 if {![info exists ref($id)]} {
3565 set ref($id) [listrefs $id]
3565 set ref($id) [listrefs $id]
3566 }
3566 }
3567 }
3567 }
3568 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3568 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3569 catch {unset $v}
3569 catch {unset $v}
3570 }
3570 }
3571 readrefs
3571 readrefs
3572 set refids [lsort -unique [concat $refids [array names idtags] \
3572 set refids [lsort -unique [concat $refids [array names idtags] \
3573 [array names idheads] [array names idotherrefs]]]
3573 [array names idheads] [array names idotherrefs]]]
3574 foreach id $refids {
3574 foreach id $refids {
3575 set v [listrefs $id]
3575 set v [listrefs $id]
3576 if {![info exists ref($id)] || $ref($id) != $v} {
3576 if {![info exists ref($id)] || $ref($id) != $v} {
3577 redrawtags $id
3577 redrawtags $id
3578 }
3578 }
3579 }
3579 }
3580 }
3580 }
3581
3581
3582 proc showtag {tag isnew} {
3582 proc showtag {tag isnew} {
3583 global ctext cflist tagcontents tagids linknum
3583 global ctext cflist tagcontents tagids linknum
3584
3584
3585 if {$isnew} {
3585 if {$isnew} {
3586 addtohistory [list showtag $tag 0]
3586 addtohistory [list showtag $tag 0]
3587 }
3587 }
3588 $ctext conf -state normal
3588 $ctext conf -state normal
3589 $ctext delete 0.0 end
3589 $ctext delete 0.0 end
3590 set linknum 0
3590 set linknum 0
3591 if {[info exists tagcontents($tag)]} {
3591 if {[info exists tagcontents($tag)]} {
3592 set text $tagcontents($tag)
3592 set text $tagcontents($tag)
3593 } else {
3593 } else {
3594 set text "Tag: $tag\nId: $tagids($tag)"
3594 set text "Tag: $tag\nId: $tagids($tag)"
3595 }
3595 }
3596 appendwithlinks $text
3596 appendwithlinks $text
3597 $ctext conf -state disabled
3597 $ctext conf -state disabled
3598 $cflist delete 0 end
3598 $cflist delete 0 end
3599 }
3599 }
3600
3600
3601 proc doquit {} {
3601 proc doquit {} {
3602 global stopped
3602 global stopped
3603 set stopped 100
3603 set stopped 100
3604 destroy .
3604 destroy .
3605 }
3605 }
3606
3606
3607 # defaults...
3607 # defaults...
3608 set datemode 0
3608 set datemode 0
3609 set boldnames 0
3609 set boldnames 0
3610 set diffopts "-U 5 -p"
3610 set diffopts "-U 5 -p"
3611 set wrcomcmd "hg git-diff-tree --stdin -p --pretty"
3611 set wrcomcmd "hg debug-diff-tree --stdin -p --pretty"
3612
3612
3613 set mainfont {Helvetica 9}
3613 set mainfont {Helvetica 9}
3614 set textfont {Courier 9}
3614 set textfont {Courier 9}
3615 set findmergefiles 0
3615 set findmergefiles 0
3616 set gaudydiff 0
3616 set gaudydiff 0
3617 set maxgraphpct 50
3617 set maxgraphpct 50
3618 set maxwidth 16
3618 set maxwidth 16
3619
3619
3620 set colors {green red blue magenta darkgrey brown orange}
3620 set colors {green red blue magenta darkgrey brown orange}
3621
3621
3622 catch {source ~/.gitk}
3622 catch {source ~/.gitk}
3623
3623
3624 set namefont $mainfont
3624 set namefont $mainfont
3625 if {$boldnames} {
3625 if {$boldnames} {
3626 lappend namefont bold
3626 lappend namefont bold
3627 }
3627 }
3628
3628
3629 set revtreeargs {}
3629 set revtreeargs {}
3630 foreach arg $argv {
3630 foreach arg $argv {
3631 switch -regexp -- $arg {
3631 switch -regexp -- $arg {
3632 "^$" { }
3632 "^$" { }
3633 "^-b" { set boldnames 1 }
3633 "^-b" { set boldnames 1 }
3634 "^-d" { set datemode 1 }
3634 "^-d" { set datemode 1 }
3635 default {
3635 default {
3636 lappend revtreeargs $arg
3636 lappend revtreeargs $arg
3637 }
3637 }
3638 }
3638 }
3639 }
3639 }
3640
3640
3641 set history {}
3641 set history {}
3642 set historyindex 0
3642 set historyindex 0
3643
3643
3644 set stopped 0
3644 set stopped 0
3645 set redisplaying 0
3645 set redisplaying 0
3646 set stuffsaved 0
3646 set stuffsaved 0
3647 set patchnum 0
3647 set patchnum 0
3648 setcoords
3648 setcoords
3649 makewindow
3649 makewindow
3650 readrefs
3650 readrefs
3651 getcommits $revtreeargs
3651 getcommits $revtreeargs
@@ -1,335 +1,341 b''
1 #!/usr/bin/env python
1 #!/usr/bin/env python
2 #
2 #
3 # Minimal support for git commands on an hg repository
3 # Minimal support for git commands on an hg repository
4 #
4 #
5 # Copyright 2005 Chris Mason <mason@suse.com>
5 # Copyright 2005 Chris Mason <mason@suse.com>
6 #
6 #
7 # This software may be used and distributed according to the terms
7 # This software may be used and distributed according to the terms
8 # of the GNU General Public License, incorporated herein by reference.
8 # of the GNU General Public License, incorporated herein by reference.
9
9
10 import time, sys, signal
10 import time, sys, signal, os
11 from mercurial import hg, mdiff, fancyopts, commands, ui, util
11 from mercurial import hg, mdiff, fancyopts, commands, ui, util
12
12
13 def dodiff(fp, ui, repo, node1, node2, files=None, match=util.always,
13 def dodiff(fp, ui, repo, node1, node2, files=None, match=util.always,
14 changes=None, text=False):
14 changes=None, text=False):
15 def date(c):
15 def date(c):
16 return time.asctime(time.gmtime(float(c[2].split(' ')[0])))
16 return time.asctime(time.gmtime(float(c[2].split(' ')[0])))
17
17
18 if not changes:
18 if not changes:
19 (c, a, d, u) = repo.changes(node1, node2, files, match=match)
19 (c, a, d, u) = repo.changes(node1, node2, files, match=match)
20 else:
20 else:
21 (c, a, d, u) = changes
21 (c, a, d, u) = changes
22 if files:
22 if files:
23 c, a, d = map(lambda x: filterfiles(files, x), (c, a, d))
23 c, a, d = map(lambda x: filterfiles(files, x), (c, a, d))
24
24
25 if not c and not a and not d:
25 if not c and not a and not d:
26 return
26 return
27
27
28 if node2:
28 if node2:
29 change = repo.changelog.read(node2)
29 change = repo.changelog.read(node2)
30 mmap2 = repo.manifest.read(change[0])
30 mmap2 = repo.manifest.read(change[0])
31 date2 = date(change)
31 date2 = date(change)
32 def read(f):
32 def read(f):
33 return repo.file(f).read(mmap2[f])
33 return repo.file(f).read(mmap2[f])
34 else:
34 else:
35 date2 = time.asctime()
35 date2 = time.asctime()
36 if not node1:
36 if not node1:
37 node1 = repo.dirstate.parents()[0]
37 node1 = repo.dirstate.parents()[0]
38 def read(f):
38 def read(f):
39 return repo.wfile(f).read()
39 return repo.wfile(f).read()
40
40
41 change = repo.changelog.read(node1)
41 change = repo.changelog.read(node1)
42 mmap = repo.manifest.read(change[0])
42 mmap = repo.manifest.read(change[0])
43 date1 = date(change)
43 date1 = date(change)
44
44
45 for f in c:
45 for f in c:
46 to = None
46 to = None
47 if f in mmap:
47 if f in mmap:
48 to = repo.file(f).read(mmap[f])
48 to = repo.file(f).read(mmap[f])
49 tn = read(f)
49 tn = read(f)
50 fp.write("diff --git a/%s b/%s\n" % (f, f))
50 fp.write("diff --git a/%s b/%s\n" % (f, f))
51 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
51 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
52 for f in a:
52 for f in a:
53 to = None
53 to = None
54 tn = read(f)
54 tn = read(f)
55 fp.write("diff --git /dev/null b/%s\n" % (f))
55 fp.write("diff --git /dev/null b/%s\n" % (f))
56 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
56 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
57 for f in d:
57 for f in d:
58 to = repo.file(f).read(mmap[f])
58 to = repo.file(f).read(mmap[f])
59 tn = None
59 tn = None
60 fp.write("diff --git a/%s /dev/null\n" % (f))
60 fp.write("diff --git a/%s /dev/null\n" % (f))
61 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
61 fp.write(mdiff.unidiff(to, date1, tn, date2, f, None, text=text))
62
62
63 def difftree(ui, repo, node1=None, node2=None, **opts):
63 def difftree(ui, repo, node1=None, node2=None, **opts):
64 """diff trees from two commits"""
64 """diff trees from two commits"""
65 def __difftree(repo, node1, node2):
65 def __difftree(repo, node1, node2):
66 def date(c):
66 def date(c):
67 return time.asctime(time.gmtime(float(c[2].split(' ')[0])))
67 return time.asctime(time.gmtime(float(c[2].split(' ')[0])))
68
68
69 if node2:
69 if node2:
70 change = repo.changelog.read(node2)
70 change = repo.changelog.read(node2)
71 mmap2 = repo.manifest.read(change[0])
71 mmap2 = repo.manifest.read(change[0])
72 (c, a, d, u) = repo.changes(node1, node2)
72 (c, a, d, u) = repo.changes(node1, node2)
73 def read(f): return repo.file(f).read(mmap2[f])
73 def read(f): return repo.file(f).read(mmap2[f])
74 date2 = date(change)
74 date2 = date(change)
75 else:
75 else:
76 date2 = time.asctime()
76 date2 = time.asctime()
77 (c, a, d, u) = repo.changes(node1, None)
77 (c, a, d, u) = repo.changes(node1, None)
78 if not node1:
78 if not node1:
79 node1 = repo.dirstate.parents()[0]
79 node1 = repo.dirstate.parents()[0]
80 def read(f): return file(os.path.join(repo.root, f)).read()
80 def read(f): return file(os.path.join(repo.root, f)).read()
81
81
82 change = repo.changelog.read(node1)
82 change = repo.changelog.read(node1)
83 mmap = repo.manifest.read(change[0])
83 mmap = repo.manifest.read(change[0])
84 date1 = date(change)
84 date1 = date(change)
85 empty = "0" * 40;
85 empty = "0" * 40;
86
86
87 for f in c:
87 for f in c:
88 # TODO get file permissions
88 # TODO get file permissions
89 print ":100664 100664 %s %s M\t%s\t%s" % (hg.hex(mmap[f]),
89 print ":100664 100664 %s %s M\t%s\t%s" % (hg.hex(mmap[f]),
90 hg.hex(mmap2[f]), f, f)
90 hg.hex(mmap2[f]), f, f)
91 for f in a:
91 for f in a:
92 print ":000000 100664 %s %s N\t%s\t%s" % (empty, hg.hex(mmap2[f]), f, f)
92 print ":000000 100664 %s %s N\t%s\t%s" % (empty, hg.hex(mmap2[f]), f, f)
93 for f in d:
93 for f in d:
94 print ":100664 000000 %s %s D\t%s\t%s" % (hg.hex(mmap[f]), empty, f, f)
94 print ":100664 000000 %s %s D\t%s\t%s" % (hg.hex(mmap[f]), empty, f, f)
95 ##
95 ##
96
96
97 while True:
97 while True:
98 if opts['stdin']:
98 if opts['stdin']:
99 try:
99 try:
100 line = raw_input().split(' ')
100 line = raw_input().split(' ')
101 node1 = line[0]
101 node1 = line[0]
102 if len(line) > 1:
102 if len(line) > 1:
103 node2 = line[1]
103 node2 = line[1]
104 else:
104 else:
105 node2 = None
105 node2 = None
106 except EOFError:
106 except EOFError:
107 break
107 break
108 node1 = repo.lookup(node1)
108 node1 = repo.lookup(node1)
109 if node2:
109 if node2:
110 node2 = repo.lookup(node2)
110 node2 = repo.lookup(node2)
111 else:
111 else:
112 node2 = node1
112 node2 = node1
113 node1 = repo.changelog.parents(node1)[0]
113 node1 = repo.changelog.parents(node1)[0]
114 if opts['patch']:
114 if opts['patch']:
115 if opts['pretty']:
115 if opts['pretty']:
116 catcommit(repo, node2, "")
116 catcommit(repo, node2, "")
117 dodiff(sys.stdout, ui, repo, node1, node2)
117 dodiff(sys.stdout, ui, repo, node1, node2)
118 else:
118 else:
119 __difftree(repo, node1, node2)
119 __difftree(repo, node1, node2)
120 if not opts['stdin']:
120 if not opts['stdin']:
121 break
121 break
122
122
123 def catcommit(repo, n, prefix, changes=None):
123 def catcommit(repo, n, prefix, changes=None):
124 nlprefix = '\n' + prefix;
124 nlprefix = '\n' + prefix;
125 (p1, p2) = repo.changelog.parents(n)
125 (p1, p2) = repo.changelog.parents(n)
126 (h, h1, h2) = map(hg.hex, (n, p1, p2))
126 (h, h1, h2) = map(hg.hex, (n, p1, p2))
127 (i1, i2) = map(repo.changelog.rev, (p1, p2))
127 (i1, i2) = map(repo.changelog.rev, (p1, p2))
128 if not changes:
128 if not changes:
129 changes = repo.changelog.read(n)
129 changes = repo.changelog.read(n)
130 print "tree %s" % (hg.hex(changes[0]))
130 print "tree %s" % (hg.hex(changes[0]))
131 if i1 != -1: print "parent %s" % (h1)
131 if i1 != -1: print "parent %s" % (h1)
132 if i2 != -1: print "parent %s" % (h2)
132 if i2 != -1: print "parent %s" % (h2)
133 date_ar = changes[2].split(' ')
133 date_ar = changes[2].split(' ')
134 date = int(float(date_ar[0]))
134 date = int(float(date_ar[0]))
135 lines = changes[4].splitlines()
135 lines = changes[4].splitlines()
136 if lines[-1].startswith('committer:'):
136 if lines[-1].startswith('committer:'):
137 committer = lines[-1].split(': ')[1].rstrip()
137 committer = lines[-1].split(': ')[1].rstrip()
138 else:
138 else:
139 committer = "%s %s %s" % (changes[1], date, date_ar[1])
139 committer = "%s %s %s" % (changes[1], date, date_ar[1])
140
140
141 print "author %s %s %s" % (changes[1], date, date_ar[1])
141 print "author %s %s %s" % (changes[1], date, date_ar[1])
142 print "committer %s" % (committer)
142 print "committer %s" % (committer)
143 print ""
143 print ""
144 if prefix != "":
144 if prefix != "":
145 print "%s%s" % (prefix, changes[4].replace('\n', nlprefix).strip())
145 print "%s%s" % (prefix, changes[4].replace('\n', nlprefix).strip())
146 else:
146 else:
147 print changes[4]
147 print changes[4]
148 if prefix:
148 if prefix:
149 sys.stdout.write('\0')
149 sys.stdout.write('\0')
150
150
151 def base(ui, repo, node1, node2):
151 def base(ui, repo, node1, node2):
152 """Output common ancestor information"""
152 """Output common ancestor information"""
153 node1 = repo.lookup(node1)
153 node1 = repo.lookup(node1)
154 node2 = repo.lookup(node2)
154 node2 = repo.lookup(node2)
155 n = repo.changelog.ancestor(node1, node2)
155 n = repo.changelog.ancestor(node1, node2)
156 print hg.hex(n)
156 print hg.hex(n)
157
157
158 def catfile(ui, repo, type=None, r=None, **opts):
158 def catfile(ui, repo, type=None, r=None, **opts):
159 """cat a specific revision"""
159 """cat a specific revision"""
160 # in stdin mode, every line except the commit is prefixed with two
160 # in stdin mode, every line except the commit is prefixed with two
161 # spaces. This way the our caller can find the commit without magic
161 # spaces. This way the our caller can find the commit without magic
162 # strings
162 # strings
163 #
163 #
164 prefix = ""
164 prefix = ""
165 if opts['stdin']:
165 if opts['stdin']:
166 try:
166 try:
167 (type, r) = raw_input().split(' ');
167 (type, r) = raw_input().split(' ');
168 prefix = " "
168 prefix = " "
169 except EOFError:
169 except EOFError:
170 return
170 return
171
171
172 else:
172 else:
173 if not type or not r:
173 if not type or not r:
174 ui.warn("cat-file: type or revision not supplied\n")
174 ui.warn("cat-file: type or revision not supplied\n")
175 commands.help_(ui, 'cat-file')
175 commands.help_(ui, 'cat-file')
176
176
177 while r:
177 while r:
178 if type != "commit":
178 if type != "commit":
179 sys.stderr.write("aborting hg cat-file only understands commits\n")
179 sys.stderr.write("aborting hg cat-file only understands commits\n")
180 sys.exit(1);
180 sys.exit(1);
181 n = repo.lookup(r)
181 n = repo.lookup(r)
182 catcommit(repo, n, prefix)
182 catcommit(repo, n, prefix)
183 if opts['stdin']:
183 if opts['stdin']:
184 try:
184 try:
185 (type, r) = raw_input().split(' ');
185 (type, r) = raw_input().split(' ');
186 except EOFError:
186 except EOFError:
187 break
187 break
188 else:
188 else:
189 break
189 break
190
190
191 # git rev-tree is a confusing thing. You can supply a number of
191 # git rev-tree is a confusing thing. You can supply a number of
192 # commit sha1s on the command line, and it walks the commit history
192 # commit sha1s on the command line, and it walks the commit history
193 # telling you which commits are reachable from the supplied ones via
193 # telling you which commits are reachable from the supplied ones via
194 # a bitmask based on arg position.
194 # a bitmask based on arg position.
195 # you can specify a commit to stop at by starting the sha1 with ^
195 # you can specify a commit to stop at by starting the sha1 with ^
196 def revtree(args, repo, full="tree", maxnr=0, parents=False):
196 def revtree(args, repo, full="tree", maxnr=0, parents=False):
197 def chlogwalk():
197 def chlogwalk():
198 ch = repo.changelog
198 ch = repo.changelog
199 count = ch.count()
199 count = ch.count()
200 i = count
200 i = count
201 l = [0] * 100
201 l = [0] * 100
202 chunk = 100
202 chunk = 100
203 while True:
203 while True:
204 if chunk > i:
204 if chunk > i:
205 chunk = i
205 chunk = i
206 i = 0
206 i = 0
207 else:
207 else:
208 i -= chunk
208 i -= chunk
209
209
210 for x in xrange(0, chunk):
210 for x in xrange(0, chunk):
211 if i + x >= count:
211 if i + x >= count:
212 l[chunk - x:] = [0] * (chunk - x)
212 l[chunk - x:] = [0] * (chunk - x)
213 break
213 break
214 if full != None:
214 if full != None:
215 l[x] = ch.read(ch.node(i + x))
215 l[x] = ch.read(ch.node(i + x))
216 else:
216 else:
217 l[x] = 1
217 l[x] = 1
218 for x in xrange(chunk-1, -1, -1):
218 for x in xrange(chunk-1, -1, -1):
219 if l[x] != 0:
219 if l[x] != 0:
220 yield (i + x, full != None and l[x] or None)
220 yield (i + x, full != None and l[x] or None)
221 if i == 0:
221 if i == 0:
222 break
222 break
223
223
224 # calculate and return the reachability bitmask for sha
224 # calculate and return the reachability bitmask for sha
225 def is_reachable(ar, reachable, sha):
225 def is_reachable(ar, reachable, sha):
226 if len(ar) == 0:
226 if len(ar) == 0:
227 return 1
227 return 1
228 mask = 0
228 mask = 0
229 for i in range(len(ar)):
229 for i in range(len(ar)):
230 if sha in reachable[i]:
230 if sha in reachable[i]:
231 mask |= 1 << i
231 mask |= 1 << i
232
232
233 return mask
233 return mask
234
234
235 reachable = []
235 reachable = []
236 stop_sha1 = []
236 stop_sha1 = []
237 want_sha1 = []
237 want_sha1 = []
238 count = 0
238 count = 0
239
239
240 # figure out which commits they are asking for and which ones they
240 # figure out which commits they are asking for and which ones they
241 # want us to stop on
241 # want us to stop on
242 for i in range(len(args)):
242 for i in range(len(args)):
243 if args[i].startswith('^'):
243 if args[i].startswith('^'):
244 s = repo.lookup(args[i][1:])
244 s = repo.lookup(args[i][1:])
245 stop_sha1.append(s)
245 stop_sha1.append(s)
246 want_sha1.append(s)
246 want_sha1.append(s)
247 elif args[i] != 'HEAD':
247 elif args[i] != 'HEAD':
248 want_sha1.append(repo.lookup(args[i]))
248 want_sha1.append(repo.lookup(args[i]))
249
249
250 # calculate the graph for the supplied commits
250 # calculate the graph for the supplied commits
251 for i in range(len(want_sha1)):
251 for i in range(len(want_sha1)):
252 reachable.append({});
252 reachable.append({});
253 n = want_sha1[i];
253 n = want_sha1[i];
254 visit = [n];
254 visit = [n];
255 reachable[i][n] = 1
255 reachable[i][n] = 1
256 while visit:
256 while visit:
257 n = visit.pop(0)
257 n = visit.pop(0)
258 if n in stop_sha1:
258 if n in stop_sha1:
259 continue
259 continue
260 for p in repo.changelog.parents(n):
260 for p in repo.changelog.parents(n):
261 if p not in reachable[i]:
261 if p not in reachable[i]:
262 reachable[i][p] = 1
262 reachable[i][p] = 1
263 visit.append(p)
263 visit.append(p)
264 if p in stop_sha1:
264 if p in stop_sha1:
265 continue
265 continue
266
266
267 # walk the repository looking for commits that are in our
267 # walk the repository looking for commits that are in our
268 # reachability graph
268 # reachability graph
269 #for i in range(repo.changelog.count()-1, -1, -1):
269 #for i in range(repo.changelog.count()-1, -1, -1):
270 for i, changes in chlogwalk():
270 for i, changes in chlogwalk():
271 n = repo.changelog.node(i)
271 n = repo.changelog.node(i)
272 mask = is_reachable(want_sha1, reachable, n)
272 mask = is_reachable(want_sha1, reachable, n)
273 if mask:
273 if mask:
274 parentstr = ""
274 parentstr = ""
275 if parents:
275 if parents:
276 pp = repo.changelog.parents(n)
276 pp = repo.changelog.parents(n)
277 if pp[0] != hg.nullid:
277 if pp[0] != hg.nullid:
278 parentstr += " " + hg.hex(pp[0])
278 parentstr += " " + hg.hex(pp[0])
279 if pp[1] != hg.nullid:
279 if pp[1] != hg.nullid:
280 parentstr += " " + hg.hex(pp[1])
280 parentstr += " " + hg.hex(pp[1])
281 if not full:
281 if not full:
282 print hg.hex(n) + parentstr
282 print hg.hex(n) + parentstr
283 elif full is "commit":
283 elif full is "commit":
284 print hg.hex(n) + parentstr
284 print hg.hex(n) + parentstr
285 catcommit(repo, n, ' ', changes)
285 catcommit(repo, n, ' ', changes)
286 else:
286 else:
287 (p1, p2) = repo.changelog.parents(n)
287 (p1, p2) = repo.changelog.parents(n)
288 (h, h1, h2) = map(hg.hex, (n, p1, p2))
288 (h, h1, h2) = map(hg.hex, (n, p1, p2))
289 (i1, i2) = map(repo.changelog.rev, (p1, p2))
289 (i1, i2) = map(repo.changelog.rev, (p1, p2))
290
290
291 date = changes[2].split(' ')[0]
291 date = changes[2].split(' ')[0]
292 print "%s %s:%s" % (date, h, mask),
292 print "%s %s:%s" % (date, h, mask),
293 mask = is_reachable(want_sha1, reachable, p1)
293 mask = is_reachable(want_sha1, reachable, p1)
294 if i1 != -1 and mask > 0:
294 if i1 != -1 and mask > 0:
295 print "%s:%s " % (h1, mask),
295 print "%s:%s " % (h1, mask),
296 mask = is_reachable(want_sha1, reachable, p2)
296 mask = is_reachable(want_sha1, reachable, p2)
297 if i2 != -1 and mask > 0:
297 if i2 != -1 and mask > 0:
298 print "%s:%s " % (h2, mask),
298 print "%s:%s " % (h2, mask),
299 print ""
299 print ""
300 if maxnr and count >= maxnr:
300 if maxnr and count >= maxnr:
301 break
301 break
302 count += 1
302 count += 1
303
303
304 # git rev-list tries to order things by date, and has the ability to stop
304 # git rev-list tries to order things by date, and has the ability to stop
305 # at a given commit without walking the whole repo. TODO add the stop
305 # at a given commit without walking the whole repo. TODO add the stop
306 # parameter
306 # parameter
307 def revlist(ui, repo, *revs, **opts):
307 def revlist(ui, repo, *revs, **opts):
308 """print revisions"""
308 """print revisions"""
309 if opts['header']:
309 if opts['header']:
310 full = "commit"
310 full = "commit"
311 else:
311 else:
312 full = None
312 full = None
313 copy = [x for x in revs]
313 copy = [x for x in revs]
314 revtree(copy, repo, full, opts['max_count'], opts['parents'])
314 revtree(copy, repo, full, opts['max_count'], opts['parents'])
315
315
316 def view(ui, repo, *etc):
317 "start interactive history viewer"
318 os.chdir(repo.root)
319 os.system("hgk " + " ".join(etc))
320
316 cmdtable = {
321 cmdtable = {
317 "git-diff-tree": (difftree, [('p', 'patch', None, 'generate patch'),
322 "view": (view, [], 'hg view'),
323 "debug-diff-tree": (difftree, [('p', 'patch', None, 'generate patch'),
318 ('r', 'recursive', None, 'recursive'),
324 ('r', 'recursive', None, 'recursive'),
319 ('P', 'pretty', None, 'pretty'),
325 ('P', 'pretty', None, 'pretty'),
320 ('s', 'stdin', None, 'stdin'),
326 ('s', 'stdin', None, 'stdin'),
321 ('C', 'copy', None, 'detect copies'),
327 ('C', 'copy', None, 'detect copies'),
322 ('S', 'search', "", 'search')],
328 ('S', 'search', "", 'search')],
323 "hg git-diff-tree [options] node1 node2"),
329 "hg git-diff-tree [options] node1 node2"),
324 "git-cat-file": (catfile, [('s', 'stdin', None, 'stdin')],
330 "debug-cat-file": (catfile, [('s', 'stdin', None, 'stdin')],
325 "hg cat-file [options] type file"),
331 "hg debug-cat-file [options] type file"),
326 "git-merge-base": (base, [], "hg git-merge-base node node"),
332 "debug-merge-base": (base, [], "hg debug-merge-base node node"),
327 "git-rev-list": (revlist, [('H', 'header', None, 'header'),
333 "debug-rev-list": (revlist, [('H', 'header', None, 'header'),
328 ('t', 'topo-order', None, 'topo-order'),
334 ('t', 'topo-order', None, 'topo-order'),
329 ('p', 'parents', None, 'parents'),
335 ('p', 'parents', None, 'parents'),
330 ('n', 'max-count', 0, 'max-count')],
336 ('n', 'max-count', 0, 'max-count')],
331 "hg git-rev-list [options] revs"),
337 "hg debug-rev-list [options] revs"),
332 }
338 }
333
339
334 def reposetup(ui, repo):
340 def reposetup(ui, repo):
335 pass
341 pass
General Comments 0
You need to be logged in to leave comments. Login now