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