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