##// END OF EJS Templates
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com -
r1240:cc756ffd default
parent child Browse files
Show More
This diff has been collapsed as it changes many lines, (3345 lines changed) Show them Hide them
@@ -7,68 +7,170 b' exec wish "$0" -- "${1+$@}"'
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 }
16 }
17 set commits {}
17 }
18 set curcommit {}
18
19 set allcommitstate none
19 proc getcommits {rargs} {
20 set phase getcommits
20 global commits commfd phase canv mainfont env
21 if [catch {set commfd [open "|hgit rev-list -c $rargs" r]} err] {
21 global startmsecs nextupdate ncmupdate
22 puts stderr "Error executing hgit rev-list: $err"
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\"."
23 exit 1
28 exit 1
24 }
29 }
25 fconfigure $commfd -blocking 0
30 set commits {}
26 fileevent $commfd readable "getallcommitline $commfd"
31 set phase getcommits
32 set startmsecs [clock clicks -milliseconds]
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"
49 exit 1
50 }
51 set leftover {}
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
57 . config -cursor watch
58 settextcursor watch
30 }
59 }
31
60
32 proc getcommitline {commfd} {
61 proc getcommitlines {commfd} {
33 global commits parents cdate nparents children nchildren
62 global commits parents cdate children
34 set n [gets $commfd line]
63 global commitlisted phase commitinfo nextupdate
35 if {$n < 0} {
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]
89 if {$i < 0} {
90 append leftover [string range $stuff $start end]
91 return
92 }
93 set cmit [string range $stuff $start [expr {$i - 1}]]
94 if {$start == 0} {
95 set cmit "$leftover$cmit"
96 set leftover {}
97 }
98 set start [expr {$i + 1}]
99 set j [string first "\n" $cmit]
100 set ok 0
101 if {$j >= 0} {
102 set ids [string range $cmit 0 [expr {$j - 1}]]
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 }
57 }
143 }
58 lappend commits $line
59 }
144 }
60
145
61 proc readallcommits {} {
146 proc doupdate {reading} {
62 global commits
147 global commfd nextupdate numcommits ncmupdate
63 foreach id $commits {
148
64 readcommit $id
149 if {$reading} {
65 update
150 fileevent $commfd readable {}
66 }
151 }
67 drawgraph
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 }
68 }
164 }
69
165
70 proc readonecommit {id contents} {
166 proc readcommit {id} {
71 global commitinfo children nchildren parents nparents cdate
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 {}
@@ -79,28 +181,28 b' proc readonecommit {id contents} {'
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
184 set ncleft($id) 0
82 }
185 }
83 set parents($id) {}
186 set parents($id) $olds
84 set nparents($id) 0
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}]]
@@ -112,10 +214,15 b' proc readonecommit {id contents} {'
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"
118 }
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 " "
225 }
119 append comment $line
226 append comment $line
120 }
227 }
121 }
228 }
@@ -130,115 +237,45 b' proc readonecommit {id contents} {'
130 $comname $comdate $comment]
237 $comname $comdate $comment]
131 }
238 }
132
239
133 proc getallcommitline {commfd} {
240 proc readrefs {} {
134 global commits allcommitstate curcommit curcommitid
241 global tagids idtags headids idheads tagcontents
135 set n [gets $commfd line]
242
136 set s "\n"
243 set tags [exec hg tags]
137 if {$n < 0} {
244 set lines [split $tags '\n']
138 if {![eof $commfd]} return
245 foreach f $lines {
139 # this works around what is apparently a bug in Tcl...
246 set f [regexp -all -inline {\S+} $f]
140 fconfigure $commfd -blocking 1
247 set direct [lindex $f 0]
141 if {![catch {close $commfd} err]} {
248 set full [lindex $f 1]
142 if {$allcommitstate == "indent"} {
249 set sha [split $full ':']
143 readonecommit $curcommitid $curcommit
250 set tag [lindex $sha 1]
144 }
251 lappend tagids($direct) $tag
145 after idle drawgraph
252 lappend idtags($tag) $direct
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 }
253 }
176 }
254 }
177
255
178 proc getcommits {rargs} {
256 proc readotherrefs {base dname excl} {
179 global commits commfd phase canv mainfont
257 global otherrefids idotherrefs
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
258
196 proc readcommit {id} {
259 set git [gitdir]
197 global commitinfo children nchildren parents nparents cdate
260 set files [glob -nocomplain -types f [file join $git $base *]]
198 set inhdr 1
261 foreach f $files {
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 {} {
216 global tagids idtags
217 set tags [glob -nocomplain -types f .git/refs/tags/*]
218 foreach f $tags {
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 {}
227 foreach l $contents {
228 if {$l == {}} break
229 switch -- [lindex $l 0] {
230 "object" {set obj [lindex $l 1]}
231 "type" {set type [lindex $l 1]}
232 "tag" {set tag [string range $l 4 end]}
233 }
234 }
235 if {$obj != {} && $type == "commit" && $tag != {}} {
236 set tagids($tag) $obj
237 lappend idtags($obj) $tag
238 }
239 }
269 }
270 close $fd
240 }
271 }
241 }
272 }
273 set dirs [glob -nocomplain -types d [file join $git $base *]]
274 foreach d $dirs {
275 set dir [file tail $d]
276 if {[lsearch -exact $excl $dir] >= 0} continue
277 readotherrefs [file join $base $dir] "$dname$dir/" {}
278 }
242 }
279 }
243
280
244 proc error_popup msg {
281 proc error_popup msg {
@@ -255,12 +292,15 b' proc error_popup msg {'
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
@@ -317,6 +357,30 b' proc makewindow {} {'
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 {}
@@ -325,12 +389,15 b' proc makewindow {} {'
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
@@ -338,17 +405,32 b' proc makewindow {} {'
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
@@ -362,8 +444,8 b' proc makewindow {} {'
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"
@@ -380,12 +462,13 b' proc makewindow {} {'
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}
@@ -396,6 +479,21 b' proc makewindow {} {'
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
@@ -425,13 +523,19 b' proc click {w} {'
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]"
@@ -525,66 +629,60 b' proc about {} {'
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)]
653 && $nparents($child) == 1} {
654 set colormap($id) $colormap($child)
655 return
569 }
656 }
570 set comm [lindex $commitinfo($id) 3]
657 }
571 if {![info exists commcolors($comm)]} {
658 set badcolors {}
572 set commcolors($comm) [lindex $colors $nextcolor]
659 if {[info exists cornercrossings($id)]} {
573 if {[incr nextcolor] >= $ncolors} {
660 foreach x $cornercrossings($id) {
574 set nextcolor 0
661 if {[info exists colormap($x)]
662 && [lsearch -exact $badcolors $colormap($x)] < 0} {
663 lappend badcolors $colormap($x)
575 }
664 }
576 }
665 }
577 set colormap($id) $commcolors($comm)
666 if {[llength $badcolors] >= $ncolors} {
578 } else {
667 set badcolors {}
579 if {$nparents($id) == 1 && $nchildren($id) == 1} {
668 }
580 set child [lindex $children($id) 0]
669 }
581 if {[info exists colormap($child)]
670 set origbad $badcolors
582 && $nparents($child) == 1} {
671 if {[llength $badcolors] < $ncolors - 1} {
583 set colormap($id) $colormap($child)
672 if {[info exists crossings($id)]} {
584 return
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
585 }
681 }
586 }
682 }
587 set badcolors {}
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} {
@@ -600,277 +698,810 b' proc assigncolor {id} {'
600 }
698 }
601 }
699 }
602 if {[llength $badcolors] >= $ncolors} {
700 if {[llength $badcolors] >= $ncolors} {
603 set badcolors {}
701 set badcolors $origbad
702 }
703 }
704 for {set i 0} {$i <= $ncolors} {incr i} {
705 set c [lindex $colors $nextcolor]
706 if {[incr nextcolor] >= $ncolors} {
707 set nextcolor 0
604 }
708 }
605 for {set i 0} {$i <= $ncolors} {incr i} {
709 if {[lsearch -exact $badcolors $c]} break
606 set c [lindex $colors $nextcolor]
710 }
607 if {[incr nextcolor] >= $ncolors} {
711 set colormap($id) $c
608 set nextcolor 0
712 }
609 }
713
610 if {[lsearch -exact $badcolors $c]} break
714 proc initgraph {} {
715 global canvy canvy0 lineno numcommits nextcolor linespc
716 global mainline mainlinearrow sidelines
717 global nchildren ncleft
718 global displist nhyperspace
719
720 allcanvs delete all
721 set nextcolor 0
722 set canvy $canvy0
723 set lineno -1
724 set numcommits 0
725 catch {unset mainline}
726 catch {unset mainlinearrow}
727 catch {unset sidelines}
728 foreach id [array names nchildren] {
729 set ncleft($id) $nchildren($id)
730 }
731 set displist {}
732 set nhyperspace 0
733 }
734
735 proc bindline {t id} {
736 global canv
737
738 $canv bind $t <Enter> "lineenter %x %y $id"
739 $canv bind $t <Motion> "linemotion %x %y $id"
740 $canv bind $t <Leave> "lineleave $id"
741 $canv bind $t <Button-1> "lineclick %x %y $id 1"
742 }
743
744 proc drawlines {id xtra} {
745 global mainline mainlinearrow sidelines lthickness colormap canv
746
747 $canv delete lines.$id
748 if {[info exists mainline($id)]} {
749 set t [$canv create line $mainline($id) \
750 -width [expr {($xtra + 1) * $lthickness}] \
751 -fill $colormap($id) -tags lines.$id \
752 -arrow $mainlinearrow($id)]
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
611 }
766 }
612 set colormap($id) $c
613 }
767 }
614 }
768 }
615
769
616 proc drawgraph {} {
770 # level here is an index in displist
617 global parents children nparents nchildren commits
771 proc drawcommitline {level} {
618 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
772 global parents children nparents displist
619 global datemode cdate
773 global canv canv2 canv3 mainfont namefont canvy linespc
620 global lineid linehtag linentag linedtag commitinfo
774 global lineid linehtag linentag linedtag commitinfo
621 global nextcolor colormap numcommits
775 global colormap numcommits currentparents dupparents
622 global stopped phase redisplaying selectedline idtags idline
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
623
780
624 allcanvs delete all
781 incr numcommits
625 set start {}
782 incr lineno
626 foreach id [array names nchildren] {
783 set id [lindex $displist $level]
627 if {$nchildren($id) == 0} {
784 set lastuse($id) $lineno
628 lappend start $id
785 set lineid($lineno) $id
629 }
786 set idline($id) $lineno
630 set ncleft($id) $nchildren($id)
787 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
631 if {![info exists nparents($id)]} {
788 if {![info exists commitinfo($id)]} {
789 readcommit $id
790 if {![info exists commitinfo($id)]} {
791 set commitinfo($id) {"No commit information available"}
632 set nparents($id) 0
792 set nparents($id) 0
633 }
793 }
634 }
794 }
635 if {$start == {}} {
795 assigncolor $id
636 error_popup "Gitk: ERROR: No starting commits found"
796 set currentparents {}
637 exit 1
797 set dupparents {}
798 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
799 foreach p $parents($id) {
800 if {[lsearch -exact $currentparents $p] < 0} {
801 lappend currentparents $p
802 } else {
803 # remember that this parent was listed twice
804 lappend dupparents $p
805 }
806 }
807 }
808 set x [xcoord $level $level $lineno]
809 set y1 $canvy
810 set canvy [expr $canvy + $linespc]
811 allcanvs conf -scrollregion \
812 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
813 if {[info exists mainline($id)]} {
814 lappend mainline($id) $x $y1
815 if {$mainlinearrow($id) ne "none"} {
816 set mainline($id) [trimdiagstart $mainline($id)]
817 }
818 }
819 drawlines $id 0
820 set orad [expr {$linespc / 3}]
821 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
822 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
823 -fill $ofill -outline black -width 1]
824 $canv raise $t
825 $canv bind $t <1> {selcanvline {} %x %y}
826 set xt [xcoord [llength $displist] $level $lineno]
827 if {[llength $currentparents] > 2} {
828 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
829 }
830 set rowtextx($lineno) $xt
831 set idpos($id) [list $x $xt $y1]
832 if {[info exists idtags($id)] || [info exists idheads($id)]
833 || [info exists idotherrefs($id)]} {
834 set xt [drawtags $id $x $xt $y1]
835 }
836 set headline [lindex $commitinfo($id) 0]
837 set name [lindex $commitinfo($id) 1]
838 set date [lindex $commitinfo($id) 2]
839 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
840 -text $headline -font $mainfont ]
841 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
842 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
843 -text $name -font $namefont]
844 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
845 -text $date -font $mainfont]
846
847 set olddlevel $level
848 set olddisplist $displist
849 set oldnlines [llength $displist]
850 }
851
852 proc drawtags {id x xt y1} {
853 global idtags idheads idotherrefs
854 global linespc lthickness
855 global canv mainfont idline rowtextx
856
857 set marks {}
858 set ntags 0
859 set nheads 0
860 if {[info exists idtags($id)]} {
861 set marks $idtags($id)
862 set ntags [llength $marks]
863 }
864 if {[info exists idheads($id)]} {
865 set marks [concat $marks $idheads($id)]
866 set nheads [llength $idheads($id)]
867 }
868 if {[info exists idotherrefs($id)]} {
869 set marks [concat $marks $idotherrefs($id)]
870 }
871 if {$marks eq {}} {
872 return $xt
873 }
874
875 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
876 set yt [expr $y1 - 0.5 * $linespc]
877 set yb [expr $yt + $linespc - 1]
878 set xvals {}
879 set wvals {}
880 foreach tag $marks {
881 set wid [font measure $mainfont $tag]
882 lappend xvals $xt
883 lappend wvals $wid
884 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
885 }
886 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
887 -width $lthickness -fill black -tags tag.$id]
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
638 }
1019 }
639
1020
640 set nextcolor 0
1021 # try the shortcut
641 foreach id $start {
1022 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
642 assigncolor $id
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 }
643 }
1105 }
644 set todo $start
1106
645 set level [expr [llength $todo] - 1]
1107 set dlevel [lsearch -exact $displist $id]
646 set y2 $canvy0
1108
647 set nullentry -1
1109 # If we are reducing, put in a null entry
648 set lineno -1
1110 if {$displ < $oldnlines} {
649 set numcommits 0
1111 # does the next line look like a merge?
650 set phase drawgraph
1112 # i.e. does it have > 1 new parent?
651 set lthickness [expr {($linespc / 9) + 1}]
1113 if {$nnewparents($id) > 1} {
652 while 1 {
1114 set i [expr {$dlevel + 1}]
653 set canvy $y2
1115 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
654 allcanvs conf -scrollregion \
1116 set i $olddlevel
655 [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]]
1117 if {$nullentry >= 0 && $nullentry < $i} {
656 update
1118 incr i -1
657 if {$stopped} break
1119 }
658 incr numcommits
1120 } elseif {$nullentry >= 0} {
659 incr lineno
1121 set i $nullentry
660 set nlines [llength $todo]
1122 while {$i < $displ
661 set id [lindex $todo $level]
1123 && [lindex $olddisplist $i] == [lindex $displist $i]} {
662 set lineid($lineno) $id
1124 incr i
663 set idline($id) $lineno
1125 }
664 set actualparents {}
1126 } else {
665 set ofill white
1127 set i $olddlevel
666 if {[info exists parents($id)]} {
1128 if {$dlevel >= $i} {
667 foreach p $parents($id) {
1129 incr i
668 if {[info exists ncleft($p)]} {
1130 }
669 incr ncleft($p) -1
1131 }
670 if {![info exists commitinfo($p)]} {
1132 if {$i < $displ} {
671 readcommit $p
1133 set displist [linsert $displist $i {}]
672 if {![info exists commitinfo($p)]} continue
1134 incr displ
1135 if {$dlevel >= $i} {
1136 incr dlevel
1137 }
1138 }
1139 }
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
673 }
1186 }
674 lappend actualparents $p
1187 } else {
675 set ofill blue
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
676 }
1257 }
677 }
1258 }
678 }
1259 }
679 if {![info exists commitinfo($id)]} {
1260 set nohs {}
680 readcommit $id
1261 set reins {}
681 if {![info exists commitinfo($id)]} {
1262 set isfat [expr {[llength $dlist] > $maxwidth}]
682 set commitinfo($id) {"No commit information available"}
1263 if {$nhyperspace > 0 || $isfat} {
683 }
1264 if {$ctxend > $n} break
684 }
1265 # work out what to bring back and
685 set x [expr $canvx0 + $level * $linespc]
1266 # what we want to don't want to send into hyperspace
686 set y2 [expr $canvy + $linespc]
1267 set room 1
687 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
1268 for {set k $numcommits} {$k < $ctxend} {incr k} {
688 set t [$canv create line $x $linestarty($level) $x $canvy \
1269 set x [lindex $displayorder $k]
689 -width $lthickness -fill $colormap($id)]
1270 set i [llsearch $dlist $x]
690 $canv lower $t
1271 if {$i < 0} {
691 }
1272 set i [llength $dlist]
692 set linestarty($level) $canvy
1273 lappend dlist $x
693 set orad [expr {$linespc / 3}]
1274 }
694 set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \
1275 if {[lsearch -exact $nohs $x] < 0} {
695 [expr $x + $orad - 1] [expr $canvy + $orad - 1] \
1276 lappend nohs $x
696 -fill $ofill -outline black -width 1]
1277 }
697 $canv raise $t
1278 if {$reins eq {} && $onscreen($x) < 0 && $room} {
698 set xt [expr $canvx0 + $nlines * $linespc]
1279 set reins [list $x $i]
699 if {$nparents($id) > 2} {
1280 }
700 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
1281 set newp {}
701 }
1282 if {[info exists commitlisted($x)]} {
702 if {[info exists idtags($id)] && $idtags($id) != {}} {
1283 set right 0
703 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1284 foreach p $parents($x) {
704 set yt [expr $canvy - 0.5 * $linespc]
1285 if {[llsearch $dlist $p] < 0} {
705 set yb [expr $yt + $linespc - 1]
1286 lappend newp $p
706 set xvals {}
1287 if {[lsearch -exact $nohs $p] < 0} {
707 set wvals {}
1288 lappend nohs $p
708 foreach tag $idtags($id) {
1289 }
709 set wid [font measure $mainfont $tag]
1290 if {$reins eq {} && $onscreen($p) < 0 && $room} {
710 lappend xvals $xt
1291 set reins [list $p [expr {$i + $right}]]
711 lappend wvals $wid
1292 }
712 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1293 }
713 }
1294 set right 1
714 set t [$canv create line $x $canvy [lindex $xvals end] $canvy \
1295 }
715 -width $lthickness -fill black]
1296 }
716 $canv lower $t
1297 set l [lindex $dlist $i]
717 foreach tag $idtags($id) x $xvals wid $wvals {
1298 if {[llength $l] == 1} {
718 set xl [expr $x + $delta]
1299 set l $newp
719 set xr [expr $x + $delta + $wid + $lthickness]
1300 } else {
720 $canv create polygon $x [expr $yt + $delta] $xl $yt\
1301 set j [lsearch -exact $l $x]
721 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
1302 set l [concat [lreplace $l $j $j] $newp]
722 -width 1 -outline black -fill yellow
1303 }
723 $canv create text $xl $canvy -anchor w -text $tag \
1304 set dlist [lreplace $dlist $i $i $l]
724 -font $mainfont
1305 if {$room && $isfat && [llength $newp] <= 1} {
725 }
1306 set room 0
726 }
1307 }
727 set headline [lindex $commitinfo($id) 0]
728 set name [lindex $commitinfo($id) 1]
729 set date [lindex $commitinfo($id) 2]
730 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
731 -text $headline -font $mainfont ]
732 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
733 -text $name -font $namefont]
734 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
735 -text $date -font $mainfont]
736 if {!$datemode && [llength $actualparents] == 1} {
737 set p [lindex $actualparents 0]
738 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
739 assigncolor $p
740 set todo [lreplace $todo $level $level $p]
741 continue
742 }
743 }
744
745 set oldtodo $todo
746 set oldlevel $level
747 set lines {}
748 for {set i 0} {$i < $nlines} {incr i} {
749 if {[lindex $todo $i] == {}} continue
750 if {[info exists linestarty($i)]} {
751 set oldstarty($i) $linestarty($i)
752 unset linestarty($i)
753 }
754 if {$i != $level} {
755 lappend lines [list $i [lindex $todo $i]]
756 }
757 }
758 if {$nullentry >= 0} {
759 set todo [lreplace $todo $nullentry $nullentry]
760 if {$nullentry < $level} {
761 incr level -1
762 }
1308 }
763 }
1309 }
764
1310
765 set todo [lreplace $todo $level $level]
1311 set dlevel [drawslants $id $reins $nohs]
766 if {$nullentry > $level} {
1312 drawcommitline $dlevel
767 incr nullentry -1
1313 if {[clock clicks -milliseconds] >= $nextupdate
1314 && $numcommits >= $ncmupdate} {
1315 doupdate $reading
1316 if {$stopped} break
768 }
1317 }
769 set i $level
1318 }
770 foreach p $actualparents {
1319 }
771 set k [lsearch -exact $todo $p]
772 if {$k < 0} {
773 assigncolor $p
774 set todo [linsert $todo $i $p]
775 if {$nullentry >= $i} {
776 incr nullentry
777 }
778 incr i
779 }
780 lappend lines [list $oldlevel $p]
781 }
782
1320
783 # choose which one to do next time around
1321 # level here is an index in todo
784 set todol [llength $todo]
1322 proc updatetodo {level noshortcut} {
785 set level -1
1323 global ncleft todo nnewparents
786 set latest {}
1324 global commitlisted parents onscreen
787 for {set k $todol} {[incr k -1] >= 0} {} {
1325
788 set p [lindex $todo $k]
1326 set id [lindex $todo $level]
789 if {$p == {}} continue
1327 set olds {}
790 if {$ncleft($p) == 0} {
1328 if {[info exists commitlisted($id)]} {
791 if {$datemode} {
1329 foreach p $parents($id) {
792 if {$latest == {} || $cdate($p) > $latest} {
1330 if {[lsearch -exact $olds $p] < 0} {
793 set level $k
1331 lappend olds $p
794 set latest $cdate($p)
795 }
796 } else {
797 set level $k
798 break
799 }
800 }
1332 }
801 }
1333 }
802 if {$level < 0} {
1334 }
803 if {$todo != {}} {
1335 if {!$noshortcut && [llength $olds] == 1} {
804 puts "ERROR: none of the pending commits can be done yet:"
1336 set p [lindex $olds 0]
805 foreach p $todo {
1337 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
806 puts " $p"
1338 set ncleft($p) 0
807 }
1339 set todo [lreplace $todo $level $level $p]
808 }
1340 set onscreen($p) 0
809 break
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
810 }
1357 }
1358 }
1359 set nnewparents($id) $n
811
1360
812 # If we are reducing, put in a null entry
1361 return 1
813 if {$todol < $nlines} {
1362 }
814 if {$nullentry >= 0} {
1363
815 set i $nullentry
1364 proc decidenext {{noread 0}} {
816 while {$i < $todol
1365 global ncleft todo
817 && [lindex $oldtodo $i] == [lindex $todo $i]} {
1366 global datemode cdate
818 incr i
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} {
1384 set level $k
1385 set latest $cdate($p)
819 }
1386 }
820 } else {
1387 } else {
821 set i $oldlevel
1388 set level $k
822 if {$level >= $i} {
1389 break
823 incr i
824 }
825 }
826 if {$i >= $todol} {
827 set nullentry -1
828 } else {
829 set nullentry $i
830 set todo [linsert $todo $nullentry {}]
831 if {$level >= $i} {
832 incr level
833 }
834 }
835 } else {
836 set nullentry -1
837 }
838
839 foreach l $lines {
840 set i [lindex $l 0]
841 set dst [lindex $l 1]
842 set j [lsearch -exact $todo $dst]
843 if {$i == $j} {
844 if {[info exists oldstarty($i)]} {
845 set linestarty($i) $oldstarty($i)
846 }
847 continue
848 }
849 set xi [expr {$canvx0 + $i * $linespc}]
850 set xj [expr {$canvx0 + $j * $linespc}]
851 set coords {}
852 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
853 lappend coords $xi $oldstarty($i)
854 }
855 lappend coords $xi $canvy
856 if {$j < $i - 1} {
857 lappend coords [expr $xj + $linespc] $canvy
858 } elseif {$j > $i + 1} {
859 lappend coords [expr $xj - $linespc] $canvy
860 }
861 lappend coords $xj $y2
862 set t [$canv create line $coords -width $lthickness \
863 -fill $colormap($dst)]
864 $canv lower $t
865 if {![info exists linestarty($j)]} {
866 set linestarty($j) $y2
867 }
1390 }
868 }
1391 }
869 }
1392 }
1393 if {$level < 0} {
1394 if {$todo != {}} {
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)]} {
1432 break
1433 }
1434 }
1435 drawmore 1
1436 }
1437
1438 proc finishcommits {} {
1439 global phase
1440 global canv mainfont ctext maincursor textcursor
1441
1442 if {$phase != "incrdraw"} {
1443 $canv delete all
1444 $canv create text 3 3 -anchor nw -text "No commits selected" \
1445 -font $mainfont -tags textitems
1446 set phase {}
1447 } else {
1448 drawrest
1449 }
1450 . config -cursor $maincursor
1451 settextcursor $textcursor
1452 }
1453
1454 # Don't change the text pane cursor if it is currently the hand cursor,
1455 # showing that we are over a sha1 ID link.
1456 proc settextcursor {c} {
1457 global ctext curtextcursor
1458
1459 if {[$ctext cget -cursor] == $curtextcursor} {
1460 $ctext config -cursor $c
1461 }
1462 set curtextcursor $c
1463 }
1464
1465 proc drawgraph {} {
1466 global nextupdate startmsecs ncmupdate
1467 global displayorder onscreen
1468
1469 if {$displayorder == {}} return
1470 set startmsecs [clock clicks -milliseconds]
1471 set nextupdate [expr $startmsecs + 100]
1472 set ncmupdate 1
1473 initgraph
1474 foreach id $displayorder {
1475 set onscreen($id) 0
1476 }
1477 drawmore 0
1478 }
1479
1480 proc drawrest {} {
1481 global phase stopped redisplaying selectedline
1482 global datemode todo displayorder
1483 global numcommits ncmupdate
1484 global nextupdate startmsecs
1485
1486 set level [decidenext]
1487 if {$level >= 0} {
1488 set phase drawgraph
1489 while 1 {
1490 lappend displayorder [lindex $todo $level]
1491 set hard [updatetodo $level $datemode]
1492 if {$hard} {
1493 set level [decidenext]
1494 if {$level < 0} break
1495 }
1496 }
1497 drawmore 0
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
@@ -905,11 +1536,16 b' 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 {
@@ -917,12 +1553,17 b' proc dofind {} {'
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)
@@ -959,7 +1600,7 b' proc dofind {} {'
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]
@@ -972,10 +1613,12 b' proc findselectline {l} {'
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
@@ -1007,6 +1650,308 b' proc findprev {} {'
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]
@@ -1025,14 +1970,15 b' proc markmatches {canv l str tag matches'
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}
1976 catch {unset findids}
1031 }
1977 }
1032
1978
1033 proc selcanvline {x y} {
1979 proc selcanvline {w x y} {
1034 global canv canvy0 ctext linespc selectedline
1980 global canv canvy0 ctext linespc
1035 global lineid linehtag linentag linedtag
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]
@@ -1041,17 +1987,56 b' proc selcanvline {x y} {'
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
1995 }
1996
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)"
1047 }
2004 }
1048
2005
1049 proc selectline {l} {
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 {{}} \
@@ -1099,6 +2084,11 b' proc selectline {l} {'
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)
@@ -1110,6 +2100,9 b' proc selectline {l} {'
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"
@@ -1120,25 +2113,36 b' proc selectline {l} {'
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 }
1137 } else {
1138 addtocflist $id
1139 }
1140 }
2145 }
1141 catch {unset seenfile}
1142 }
2146 }
1143
2147
1144 proc selnextline {dir} {
2148 proc selnextline {dir} {
@@ -1146,132 +2150,746 b' proc selnextline {dir} {'
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
2154 }
2155
2156 proc unselectline {} {
2157 global selectedline
2158
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} {
2168 return
2169 }
2170
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 }
1150 }
2226 }
1151
2227
1152 proc addtocflist {id} {
2228 proc findgca {ids} {
1153 global currentid treediffs cflist treepending
2229 set gca {}
1154 if {$id != $currentid} {
2230 foreach id $ids {
1155 gettreediffs $currentid
2231 if {$gca eq {}} {
1156 return
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 }
1157 }
2265 }
1158 $cflist insert end "All files"
2266
1159 foreach f $treediffs($currentid) {
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
2315 set flist {}
2316 catch {unset currentfile}
2317 catch {unset currenthunk}
2318 catch {unset filelines}
2319 catch {unset groupfilenum}
2320 catch {unset grouphunks}
2321 set groupfilelast -1
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 }
1163 }
2514 }
1164
2515
1165 proc gettreediffs {id} {
2516 proc processgroup {} {
1166 global treediffs parents treepending
2517 global groupfilelast groupfilenum difffilestart
1167 set treepending $id
2518 global mergefilelist diffmergeid ctext filelines
1168 set treediffs($id) {}
2519 global parents diffmergeid diffoffset
1169 set p [lindex $parents($id) 0]
2520 global grouphunks grouplinestart grouplineend nparents
1170 if [catch {set gdtf [open "|hgit diff-tree -r $p $id" r]}] return
2521 global mergemax
1171 fconfigure $gdtf -blocking 0
2522
1172 fileevent $gdtf readable "gettreediffline $gdtf $id"
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
1173 }
2698 }
1174
2699
1175 proc gettreediffline {gdtf id} {
2700 proc similarity {pnum l nlc f events} {
1176 global treediffs treepending
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
2768 fconfigure $gdtf -blocking 0
2769 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2770 }
2771
2772 proc gettreediffline {gdtf ids} {
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]
2815 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1205 }
2816 }
1206
2817
1207 proc getblobdiffline {bdf id} {
2818 proc getblobdiffline {bdf ids} {
1208 global currentid blobdifffd ctext curdifftag curtagstart seenfile
2819 global diffids blobdifffd ctext curdifftag curtagstart
1209 global diffnexthead diffnextnote diffindex difffilestart
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
2848 incr i
2849 $ctext mark set fmark.$i $here
2850 $ctext mark gravity fmark.$i left
1236 }
2851 }
1237 set difffilestart($diffindex) [$ctext index "end - 1c"]
2852 if {$newname != $fname} {
1238 incr diffindex
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 {
@@ -1279,7 +2897,6 b' proc getblobdiffline {bdf id} {'
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 }
@@ -1287,6 +2904,12 b' proc getblobdiffline {bdf id} {'
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 {} {
@@ -1294,52 +2917,45 b' proc nextfile {} {'
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]} {
2922 set pos $difffilestart($i)
2923 }
1299 }
2924 }
1300 }
2925 }
2926 if {[info exists pos]} {
2927 $ctext yview $pos
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
@@ -1347,7 +2963,7 b' proc redisplay {} {'
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}]]
@@ -1365,6 +2981,13 b' proc incrfont {inc} {'
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 == {}
@@ -1383,18 +3006,35 b' proc sha1change {n1 n2 op} {'
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"
@@ -1402,6 +3042,562 b' proc gotocommit {} {'
1402 error_popup "$type $sha1string is not known"
3042 error_popup "$type $sha1string is not known"
1403 }
3043 }
1404
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
3599 }
3600
1405 proc doquit {} {
3601 proc doquit {} {
1406 global stopped
3602 global stopped
1407 set stopped 100
3603 set stopped 100
@@ -1412,12 +3608,16 b' proc doquit {} {'
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
@@ -1431,7 +3631,6 b' 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
@@ -1439,10 +3638,14 b' foreach arg $argv {'
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
General Comments 0
You need to be logged in to leave comments. Login now