author | Matt Mackall <mpm@selenic.com> |
Mon, 07 Aug 2006 23:53:04 -0500 | |
changeset 2824 | ca06d35af65e |
parent 2297 | 936b615eb44e |
child 3056 | 3dab573a4330 |
permissions | -rwxr-xr-x |
1361
f6d73b26dbdb
contrib/hgk: remove hardcoded path to Wish
TK Soh <teekaysoh@yahoo.com>
parents:
1340
diff
changeset
|
1 |
#!/usr/bin/env wish |
267 | 2 |
|
3 |
# Copyright (C) 2005 Paul Mackerras. All rights reserved. |
|
4 |
# This program is free software; it may be used, copied, modified |
|
5 |
# and distributed under the terms of the GNU General Public Licence, |
|
6 |
# either version 2, or (at your option) any later version. |
|
7 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
8 |
proc gitdir {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
9 |
global env |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
10 |
if {[info exists env(GIT_DIR)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
11 |
return $env(GIT_DIR) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
12 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
13 |
return ".hg" |
267 | 14 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
15 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
16 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
17 |
proc getcommits {rargs} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
18 |
global commits commfd phase canv mainfont env |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
19 |
global startmsecs nextupdate ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
20 |
global ctext maincursor textcursor leftover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
21 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
22 |
# check that we can find a .git directory somewhere... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
23 |
set gitdir [gitdir] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
24 |
if {![file isdirectory $gitdir]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
25 |
error_popup "Cannot find the git directory \"$gitdir\"." |
267 | 26 |
exit 1 |
27 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
28 |
set commits {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
29 |
set phase getcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
30 |
set startmsecs [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
31 |
set nextupdate [expr $startmsecs + 100] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
32 |
set ncmupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
33 |
if [catch { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
34 |
set parse_args [concat --default HEAD $rargs] |
1278 | 35 |
set parsed_args [split [eval exec hg debug-rev-parse $parse_args] "\n"] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
36 |
}] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
37 |
# if git-rev-parse failed for some reason... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
38 |
if {$rargs == {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
39 |
set rargs HEAD |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
40 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
41 |
set parsed_args $rargs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
42 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
43 |
if [catch { |
1278 | 44 |
set commfd [open "|hg debug-rev-list --header --topo-order --parents $parsed_args" r] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
45 |
} err] { |
1278 | 46 |
puts stderr "Error executing hg debug-rev-list: $err" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
47 |
exit 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
48 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
49 |
set leftover {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
50 |
fconfigure $commfd -blocking 0 -translation lf |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
51 |
fileevent $commfd readable [list getcommitlines $commfd] |
267 | 52 |
$canv delete all |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
53 |
$canv create text 3 3 -anchor nw -text "Reading commits..." \ |
267 | 54 |
-font $mainfont -tags textitems |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
55 |
. config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
56 |
settextcursor watch |
267 | 57 |
} |
58 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
59 |
proc getcommitlines {commfd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
60 |
global commits parents cdate children |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
61 |
global commitlisted phase commitinfo nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
62 |
global stopped redisplaying leftover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
63 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
64 |
set stuff [read $commfd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
65 |
if {$stuff == {}} { |
267 | 66 |
if {![eof $commfd]} return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
67 |
# set it blocking so we wait for the process to terminate |
267 | 68 |
fconfigure $commfd -blocking 1 |
69 |
if {![catch {close $commfd} err]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
70 |
after idle finishcommits |
267 | 71 |
return |
72 |
} |
|
73 |
if {[string range $err 0 4] == "usage"} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
74 |
set err \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
75 |
{Gitk: error reading commits: bad arguments to git-rev-list. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
76 |
(Note: arguments to gitk are passed to git-rev-list |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
77 |
to allow selection of commits to be displayed.)} |
267 | 78 |
} else { |
79 |
set err "Error reading commits: $err" |
|
80 |
} |
|
81 |
error_popup $err |
|
82 |
exit 1 |
|
83 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
84 |
set start 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
85 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
86 |
set i [string first "\0" $stuff $start] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
87 |
if {$i < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
88 |
append leftover [string range $stuff $start end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
89 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
90 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
91 |
set cmit [string range $stuff $start [expr {$i - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
92 |
if {$start == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
93 |
set cmit "$leftover$cmit" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
94 |
set leftover {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
95 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
96 |
set start [expr {$i + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
97 |
set j [string first "\n" $cmit] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
98 |
set ok 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
99 |
if {$j >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
100 |
set ids [string range $cmit 0 [expr {$j - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
101 |
set ok 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
102 |
foreach id $ids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
103 |
if {![regexp {^[0-9a-f]{40}$} $id]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
104 |
set ok 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
105 |
break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
106 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
107 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
108 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
109 |
if {!$ok} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
110 |
set shortcmit $cmit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
111 |
if {[string length $shortcmit] > 80} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
112 |
set shortcmit "[string range $shortcmit 0 80]..." |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
113 |
} |
1278 | 114 |
error_popup "Can't parse hg debug-rev-list output: {$shortcmit}" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
115 |
exit 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
116 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
117 |
set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
118 |
set olds [lrange $ids 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
119 |
set cmit [string range $cmit [expr {$j + 1}] end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
120 |
lappend commits $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
121 |
set commitlisted($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
122 |
parsecommit $id $cmit 1 [lrange $ids 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
123 |
drawcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
124 |
if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
125 |
doupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
126 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
127 |
while {$redisplaying} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
128 |
set redisplaying 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
129 |
if {$stopped == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
130 |
set stopped 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
131 |
set phase "getcommits" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
132 |
foreach id $commits { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
133 |
drawcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
134 |
if {$stopped} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
135 |
if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
136 |
doupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
137 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
138 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
139 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
140 |
} |
267 | 141 |
} |
142 |
} |
|
143 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
144 |
proc doupdate {reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
145 |
global commfd nextupdate numcommits ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
146 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
147 |
if {$reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
148 |
fileevent $commfd readable {} |
267 | 149 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
150 |
update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
151 |
set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
152 |
if {$numcommits < 100} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
153 |
set ncmupdate [expr {$numcommits + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
154 |
} elseif {$numcommits < 10000} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
155 |
set ncmupdate [expr {$numcommits + 10}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
156 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
157 |
set ncmupdate [expr {$numcommits + 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
158 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
159 |
if {$reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
160 |
fileevent $commfd readable [list getcommitlines $commfd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
161 |
} |
267 | 162 |
} |
163 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
164 |
proc readcommit {id} { |
1278 | 165 |
if [catch {set contents [exec hg debug-cat-file commit $id]}] return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
166 |
parsecommit $id $contents 0 {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
167 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
168 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
169 |
proc parsecommit {id contents listed olds} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
170 |
global commitinfo children nchildren parents nparents cdate ncleft |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
171 |
|
267 | 172 |
set inhdr 1 |
173 |
set comment {} |
|
174 |
set headline {} |
|
175 |
set auname {} |
|
176 |
set audate {} |
|
177 |
set comname {} |
|
178 |
set comdate {} |
|
179 |
if {![info exists nchildren($id)]} { |
|
180 |
set children($id) {} |
|
181 |
set nchildren($id) 0 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
182 |
set ncleft($id) 0 |
267 | 183 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
184 |
set parents($id) $olds |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
185 |
set nparents($id) [llength $olds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
186 |
foreach p $olds { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
187 |
if {![info exists nchildren($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
188 |
set children($p) [list $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
189 |
set nchildren($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
190 |
set ncleft($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
191 |
} elseif {[lsearch -exact $children($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
192 |
lappend children($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
193 |
incr nchildren($p) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
194 |
incr ncleft($p) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
195 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
196 |
} |
267 | 197 |
foreach line [split $contents "\n"] { |
198 |
if {$inhdr} { |
|
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
199 |
set line [split $line] |
267 | 200 |
if {$line == {}} { |
201 |
set inhdr 0 |
|
202 |
} else { |
|
203 |
set tag [lindex $line 0] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
204 |
if {$tag == "author"} { |
267 | 205 |
set x [expr {[llength $line] - 2}] |
206 |
set audate [lindex $line $x] |
|
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
207 |
set auname [join [lrange $line 1 [expr {$x - 1}]]] |
267 | 208 |
} elseif {$tag == "committer"} { |
209 |
set x [expr {[llength $line] - 2}] |
|
210 |
set comdate [lindex $line $x] |
|
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
211 |
set comname [join [lrange $line 1 [expr {$x - 1}]]] |
267 | 212 |
} |
213 |
} |
|
214 |
} else { |
|
215 |
if {$comment == {}} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
216 |
set headline [string trim $line] |
267 | 217 |
} else { |
218 |
append comment "\n" |
|
219 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
220 |
if {!$listed} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
221 |
# git-rev-list indents the comment by 4 spaces; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
222 |
# if we got this via git-cat-file, add the indentation |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
223 |
append comment " " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
224 |
} |
267 | 225 |
append comment $line |
226 |
} |
|
227 |
} |
|
228 |
if {$audate != {}} { |
|
229 |
set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] |
|
230 |
} |
|
231 |
if {$comdate != {}} { |
|
232 |
set cdate($id) $comdate |
|
233 |
set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] |
|
234 |
} |
|
235 |
set commitinfo($id) [list $headline $auname $audate \ |
|
236 |
$comname $comdate $comment] |
|
237 |
} |
|
238 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
239 |
proc readrefs {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
240 |
global tagids idtags headids idheads tagcontents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
241 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
242 |
set tags [exec hg tags] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
243 |
set lines [split $tags '\n'] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
244 |
foreach f $lines { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
245 |
set f [regexp -all -inline {\S+} $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
246 |
set direct [lindex $f 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
247 |
set full [lindex $f 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
248 |
set sha [split $full ':'] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
249 |
set tag [lindex $sha 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
250 |
lappend tagids($direct) $tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
251 |
lappend idtags($tag) $direct |
267 | 252 |
} |
253 |
} |
|
254 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
255 |
proc readotherrefs {base dname excl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
256 |
global otherrefids idotherrefs |
267 | 257 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
258 |
set git [gitdir] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
259 |
set files [glob -nocomplain -types f [file join $git $base *]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
260 |
foreach f $files { |
267 | 261 |
catch { |
262 |
set fd [open $f r] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
263 |
set line [read $fd 40] |
267 | 264 |
if {[regexp {^[0-9a-f]{40}} $line id]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
265 |
set name "$dname[file tail $f]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
266 |
set otherrefids($name) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
267 |
lappend idotherrefs($id) $name |
267 | 268 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
269 |
close $fd |
267 | 270 |
} |
271 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
272 |
set dirs [glob -nocomplain -types d [file join $git $base *]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
273 |
foreach d $dirs { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
274 |
set dir [file tail $d] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
275 |
if {[lsearch -exact $excl $dir] >= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
276 |
readotherrefs [file join $base $dir] "$dname$dir/" {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
277 |
} |
267 | 278 |
} |
279 |
||
280 |
proc error_popup msg { |
|
281 |
set w .error |
|
282 |
toplevel $w |
|
283 |
wm transient $w . |
|
284 |
message $w.m -text $msg -justify center -aspect 400 |
|
285 |
pack $w.m -side top -fill x -padx 20 -pady 20 |
|
286 |
button $w.ok -text OK -command "destroy $w" |
|
287 |
pack $w.ok -side bottom -fill x |
|
288 |
bind $w <Visibility> "grab $w; focus $w" |
|
289 |
tkwait window $w |
|
290 |
} |
|
291 |
||
292 |
proc makewindow {} { |
|
293 |
global canv canv2 canv3 linespc charspc ctext cflist textfont |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
294 |
global findtype findtypemenu findloc findstring fstring geometry |
267 | 295 |
global entries sha1entry sha1string sha1but |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
296 |
global maincursor textcursor curtextcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
297 |
global rowctxmenu gaudydiff mergemax |
267 | 298 |
|
299 |
menu .bar |
|
300 |
.bar add cascade -label "File" -menu .bar.file |
|
301 |
menu .bar.file |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
302 |
.bar.file add command -label "Reread references" -command rereadrefs |
267 | 303 |
.bar.file add command -label "Quit" -command doquit |
304 |
menu .bar.help |
|
305 |
.bar add cascade -label "Help" -menu .bar.help |
|
306 |
.bar.help add command -label "About gitk" -command about |
|
307 |
. configure -menu .bar |
|
308 |
||
309 |
if {![info exists geometry(canv1)]} { |
|
310 |
set geometry(canv1) [expr 45 * $charspc] |
|
311 |
set geometry(canv2) [expr 30 * $charspc] |
|
312 |
set geometry(canv3) [expr 15 * $charspc] |
|
313 |
set geometry(canvh) [expr 25 * $linespc + 4] |
|
314 |
set geometry(ctextw) 80 |
|
315 |
set geometry(ctexth) 30 |
|
316 |
set geometry(cflistw) 30 |
|
317 |
} |
|
318 |
panedwindow .ctop -orient vertical |
|
319 |
if {[info exists geometry(width)]} { |
|
320 |
.ctop conf -width $geometry(width) -height $geometry(height) |
|
321 |
set texth [expr {$geometry(height) - $geometry(canvh) - 56}] |
|
322 |
set geometry(ctexth) [expr {($texth - 8) / |
|
323 |
[font metrics $textfont -linespace]}] |
|
324 |
} |
|
325 |
frame .ctop.top |
|
326 |
frame .ctop.top.bar |
|
327 |
pack .ctop.top.bar -side bottom -fill x |
|
328 |
set cscroll .ctop.top.csb |
|
329 |
scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 |
|
330 |
pack $cscroll -side right -fill y |
|
331 |
panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 |
|
332 |
pack .ctop.top.clist -side top -fill both -expand 1 |
|
333 |
.ctop add .ctop.top |
|
334 |
set canv .ctop.top.clist.canv |
|
335 |
canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ |
|
336 |
-bg white -bd 0 \ |
|
337 |
-yscrollincr $linespc -yscrollcommand "$cscroll set" |
|
338 |
.ctop.top.clist add $canv |
|
339 |
set canv2 .ctop.top.clist.canv2 |
|
340 |
canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ |
|
341 |
-bg white -bd 0 -yscrollincr $linespc |
|
342 |
.ctop.top.clist add $canv2 |
|
343 |
set canv3 .ctop.top.clist.canv3 |
|
344 |
canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ |
|
345 |
-bg white -bd 0 -yscrollincr $linespc |
|
346 |
.ctop.top.clist add $canv3 |
|
347 |
bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} |
|
348 |
||
349 |
set sha1entry .ctop.top.bar.sha1 |
|
350 |
set entries $sha1entry |
|
351 |
set sha1but .ctop.top.bar.sha1label |
|
352 |
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ |
|
353 |
-command gotocommit -width 8 |
|
354 |
$sha1but conf -disabledforeground [$sha1but cget -foreground] |
|
355 |
pack .ctop.top.bar.sha1label -side left |
|
356 |
entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
|
357 |
trace add variable sha1string write sha1change |
|
358 |
pack $sha1entry -side left -pady 2 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
359 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
360 |
image create bitmap bm-left -data { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
361 |
#define left_width 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
362 |
#define left_height 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
363 |
static unsigned char left_bits[] = { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
364 |
0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
365 |
0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
366 |
0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
367 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
368 |
image create bitmap bm-right -data { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
369 |
#define right_width 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
370 |
#define right_height 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
371 |
static unsigned char right_bits[] = { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
372 |
0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
373 |
0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
374 |
0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
375 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
376 |
button .ctop.top.bar.leftbut -image bm-left -command goback \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
377 |
-state disabled -width 26 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
378 |
pack .ctop.top.bar.leftbut -side left -fill y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
379 |
button .ctop.top.bar.rightbut -image bm-right -command goforw \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
380 |
-state disabled -width 26 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
381 |
pack .ctop.top.bar.rightbut -side left -fill y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
382 |
|
267 | 383 |
button .ctop.top.bar.findbut -text "Find" -command dofind |
384 |
pack .ctop.top.bar.findbut -side left |
|
385 |
set findstring {} |
|
386 |
set fstring .ctop.top.bar.findstring |
|
387 |
lappend entries $fstring |
|
388 |
entry $fstring -width 30 -font $textfont -textvariable findstring |
|
389 |
pack $fstring -side left -expand 1 -fill x |
|
390 |
set findtype Exact |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
391 |
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
392 |
findtype Exact IgnCase Regexp] |
267 | 393 |
set findloc "All fields" |
394 |
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
395 |
Comments Author Committer Files Pickaxe |
267 | 396 |
pack .ctop.top.bar.findloc -side right |
397 |
pack .ctop.top.bar.findtype -side right |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
398 |
# for making sure type==Exact whenever loc==Pickaxe |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
399 |
trace add variable findloc write findlocchange |
267 | 400 |
|
401 |
panedwindow .ctop.cdet -orient horizontal |
|
402 |
.ctop add .ctop.cdet |
|
403 |
frame .ctop.cdet.left |
|
404 |
set ctext .ctop.cdet.left.ctext |
|
405 |
text $ctext -bg white -state disabled -font $textfont \ |
|
406 |
-width $geometry(ctextw) -height $geometry(ctexth) \ |
|
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
407 |
-yscrollcommand ".ctop.cdet.left.sb set" \ |
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
408 |
-xscrollcommand ".ctop.cdet.left.hb set" -wrap none |
267 | 409 |
scrollbar .ctop.cdet.left.sb -command "$ctext yview" |
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
410 |
scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview" |
267 | 411 |
pack .ctop.cdet.left.sb -side right -fill y |
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
412 |
pack .ctop.cdet.left.hb -side bottom -fill x |
267 | 413 |
pack $ctext -side left -fill both -expand 1 |
414 |
.ctop.cdet add .ctop.cdet.left |
|
415 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
416 |
$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
417 |
if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
418 |
$ctext tag conf hunksep -back blue -fore white |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
419 |
$ctext tag conf d0 -back "#ff8080" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
420 |
$ctext tag conf d1 -back green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
421 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
422 |
$ctext tag conf hunksep -fore blue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
423 |
$ctext tag conf d0 -fore red |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
424 |
$ctext tag conf d1 -fore "#00a000" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
425 |
$ctext tag conf m0 -fore red |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
426 |
$ctext tag conf m1 -fore blue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
427 |
$ctext tag conf m2 -fore green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
428 |
$ctext tag conf m3 -fore purple |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
429 |
$ctext tag conf m4 -fore brown |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
430 |
$ctext tag conf mmax -fore darkgrey |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
431 |
set mergemax 5 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
432 |
$ctext tag conf mresult -font [concat $textfont bold] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
433 |
$ctext tag conf msep -font [concat $textfont bold] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
434 |
$ctext tag conf found -back yellow |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
435 |
} |
267 | 436 |
|
437 |
frame .ctop.cdet.right |
|
438 |
set cflist .ctop.cdet.right.cfiles |
|
439 |
listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ |
|
440 |
-yscrollcommand ".ctop.cdet.right.sb set" |
|
441 |
scrollbar .ctop.cdet.right.sb -command "$cflist yview" |
|
442 |
pack .ctop.cdet.right.sb -side right -fill y |
|
443 |
pack $cflist -side left -fill both -expand 1 |
|
444 |
.ctop.cdet add .ctop.cdet.right |
|
445 |
bind .ctop.cdet <Configure> {resizecdetpanes %W %w} |
|
446 |
||
447 |
pack .ctop -side top -fill both -expand 1 |
|
448 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
449 |
bindall <1> {selcanvline %W %x %y} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
450 |
#bindall <B1-Motion> {selcanvline %W %x %y} |
267 | 451 |
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
452 |
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" |
|
453 |
bindall <2> "allcanvs scan mark 0 %y" |
|
454 |
bindall <B2-Motion> "allcanvs scan dragto 0 %y" |
|
455 |
bind . <Key-Up> "selnextline -1" |
|
456 |
bind . <Key-Down> "selnextline 1" |
|
457 |
bind . <Key-Prior> "allcanvs yview scroll -1 pages" |
|
458 |
bind . <Key-Next> "allcanvs yview scroll 1 pages" |
|
459 |
bindkey <Key-Delete> "$ctext yview scroll -1 pages" |
|
460 |
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" |
|
461 |
bindkey <Key-space> "$ctext yview scroll 1 pages" |
|
462 |
bindkey p "selnextline -1" |
|
463 |
bindkey n "selnextline 1" |
|
464 |
bindkey b "$ctext yview scroll -1 pages" |
|
465 |
bindkey d "$ctext yview scroll 18 units" |
|
466 |
bindkey u "$ctext yview scroll -18 units" |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
467 |
bindkey / {findnext 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
468 |
bindkey <Key-Return> {findnext 0} |
267 | 469 |
bindkey ? findprev |
470 |
bindkey f nextfile |
|
471 |
bind . <Control-q> doquit |
|
1429
45bd7925dceb
Add control-w key binding to quit hgk.
Eric Bloodworth <ergosys@gmail.com>
parents:
1361
diff
changeset
|
472 |
bind . <Control-w> doquit |
267 | 473 |
bind . <Control-f> dofind |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
474 |
bind . <Control-g> {findnext 0} |
267 | 475 |
bind . <Control-r> findprev |
476 |
bind . <Control-equal> {incrfont 1} |
|
477 |
bind . <Control-KP_Add> {incrfont 1} |
|
478 |
bind . <Control-minus> {incrfont -1} |
|
479 |
bind . <Control-KP_Subtract> {incrfont -1} |
|
480 |
bind $cflist <<ListboxSelect>> listboxsel |
|
481 |
bind . <Destroy> {savestuff %W} |
|
482 |
bind . <Button-1> "click %W" |
|
483 |
bind $fstring <Key-Return> dofind |
|
484 |
bind $sha1entry <Key-Return> gotocommit |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
485 |
bind $sha1entry <<PasteSelection>> clearsha1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
486 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
487 |
set maincursor [. cget -cursor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
488 |
set textcursor [$ctext cget -cursor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
489 |
set curtextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
490 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
491 |
set rowctxmenu .rowctxmenu |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
492 |
menu $rowctxmenu -tearoff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
493 |
$rowctxmenu add command -label "Diff this -> selected" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
494 |
-command {diffvssel 0} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
495 |
$rowctxmenu add command -label "Diff selected -> this" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
496 |
-command {diffvssel 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
497 |
$rowctxmenu add command -label "Make patch" -command mkpatch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
498 |
$rowctxmenu add command -label "Create tag" -command mktag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
499 |
$rowctxmenu add command -label "Write commit to file" -command writecommit |
267 | 500 |
} |
501 |
||
502 |
# when we make a key binding for the toplevel, make sure |
|
503 |
# it doesn't get triggered when that key is pressed in the |
|
504 |
# find string entry widget. |
|
505 |
proc bindkey {ev script} { |
|
506 |
global entries |
|
507 |
bind . $ev $script |
|
508 |
set escript [bind Entry $ev] |
|
509 |
if {$escript == {}} { |
|
510 |
set escript [bind Entry <Key>] |
|
511 |
} |
|
512 |
foreach e $entries { |
|
513 |
bind $e $ev "$escript; break" |
|
514 |
} |
|
515 |
} |
|
516 |
||
517 |
# set the focus back to the toplevel for any click outside |
|
518 |
# the entry widgets |
|
519 |
proc click {w} { |
|
520 |
global entries |
|
521 |
foreach e $entries { |
|
522 |
if {$w == $e} return |
|
523 |
} |
|
524 |
focus . |
|
525 |
} |
|
526 |
||
527 |
proc savestuff {w} { |
|
528 |
global canv canv2 canv3 ctext cflist mainfont textfont |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
529 |
global stuffsaved findmergefiles gaudydiff maxgraphpct |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
530 |
global maxwidth |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
531 |
|
267 | 532 |
if {$stuffsaved} return |
533 |
if {![winfo viewable .]} return |
|
534 |
catch { |
|
535 |
set f [open "~/.gitk-new" w] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
536 |
puts $f [list set mainfont $mainfont] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
537 |
puts $f [list set textfont $textfont] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
538 |
puts $f [list set findmergefiles $findmergefiles] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
539 |
puts $f [list set gaudydiff $gaudydiff] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
540 |
puts $f [list set maxgraphpct $maxgraphpct] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
541 |
puts $f [list set maxwidth $maxwidth] |
267 | 542 |
puts $f "set geometry(width) [winfo width .ctop]" |
543 |
puts $f "set geometry(height) [winfo height .ctop]" |
|
544 |
puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" |
|
545 |
puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" |
|
546 |
puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" |
|
547 |
puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" |
|
548 |
set wid [expr {([winfo width $ctext] - 8) \ |
|
549 |
/ [font measure $textfont "0"]}] |
|
550 |
puts $f "set geometry(ctextw) $wid" |
|
551 |
set wid [expr {([winfo width $cflist] - 11) \ |
|
552 |
/ [font measure [$cflist cget -font] "0"]}] |
|
553 |
puts $f "set geometry(cflistw) $wid" |
|
554 |
close $f |
|
555 |
file rename -force "~/.gitk-new" "~/.gitk" |
|
556 |
} |
|
557 |
set stuffsaved 1 |
|
558 |
} |
|
559 |
||
560 |
proc resizeclistpanes {win w} { |
|
561 |
global oldwidth |
|
562 |
if [info exists oldwidth($win)] { |
|
563 |
set s0 [$win sash coord 0] |
|
564 |
set s1 [$win sash coord 1] |
|
565 |
if {$w < 60} { |
|
566 |
set sash0 [expr {int($w/2 - 2)}] |
|
567 |
set sash1 [expr {int($w*5/6 - 2)}] |
|
568 |
} else { |
|
569 |
set factor [expr {1.0 * $w / $oldwidth($win)}] |
|
570 |
set sash0 [expr {int($factor * [lindex $s0 0])}] |
|
571 |
set sash1 [expr {int($factor * [lindex $s1 0])}] |
|
572 |
if {$sash0 < 30} { |
|
573 |
set sash0 30 |
|
574 |
} |
|
575 |
if {$sash1 < $sash0 + 20} { |
|
576 |
set sash1 [expr $sash0 + 20] |
|
577 |
} |
|
578 |
if {$sash1 > $w - 10} { |
|
579 |
set sash1 [expr $w - 10] |
|
580 |
if {$sash0 > $sash1 - 20} { |
|
581 |
set sash0 [expr $sash1 - 20] |
|
582 |
} |
|
583 |
} |
|
584 |
} |
|
585 |
$win sash place 0 $sash0 [lindex $s0 1] |
|
586 |
$win sash place 1 $sash1 [lindex $s1 1] |
|
587 |
} |
|
588 |
set oldwidth($win) $w |
|
589 |
} |
|
590 |
||
591 |
proc resizecdetpanes {win w} { |
|
592 |
global oldwidth |
|
593 |
if [info exists oldwidth($win)] { |
|
594 |
set s0 [$win sash coord 0] |
|
595 |
if {$w < 60} { |
|
596 |
set sash0 [expr {int($w*3/4 - 2)}] |
|
597 |
} else { |
|
598 |
set factor [expr {1.0 * $w / $oldwidth($win)}] |
|
599 |
set sash0 [expr {int($factor * [lindex $s0 0])}] |
|
600 |
if {$sash0 < 45} { |
|
601 |
set sash0 45 |
|
602 |
} |
|
603 |
if {$sash0 > $w - 15} { |
|
604 |
set sash0 [expr $w - 15] |
|
605 |
} |
|
606 |
} |
|
607 |
$win sash place 0 $sash0 [lindex $s0 1] |
|
608 |
} |
|
609 |
set oldwidth($win) $w |
|
610 |
} |
|
611 |
||
612 |
proc allcanvs args { |
|
613 |
global canv canv2 canv3 |
|
614 |
eval $canv $args |
|
615 |
eval $canv2 $args |
|
616 |
eval $canv3 $args |
|
617 |
} |
|
618 |
||
619 |
proc bindall {event action} { |
|
620 |
global canv canv2 canv3 |
|
621 |
bind $canv $event $action |
|
622 |
bind $canv2 $event $action |
|
623 |
bind $canv3 $event $action |
|
624 |
} |
|
625 |
||
626 |
proc about {} { |
|
627 |
set w .about |
|
628 |
if {[winfo exists $w]} { |
|
629 |
raise $w |
|
630 |
return |
|
631 |
} |
|
632 |
toplevel $w |
|
633 |
wm title $w "About gitk" |
|
634 |
message $w.m -text { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
635 |
Gitk version 1.2 |
267 | 636 |
|
637 |
Copyright © 2005 Paul Mackerras |
|
638 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
639 |
Use and redistribute under the terms of the GNU General Public License} \ |
267 | 640 |
-justify center -aspect 400 |
641 |
pack $w.m -side top -fill x -padx 20 -pady 20 |
|
642 |
button $w.ok -text Close -command "destroy $w" |
|
643 |
pack $w.ok -side bottom |
|
644 |
} |
|
645 |
||
646 |
proc assigncolor {id} { |
|
647 |
global commitinfo colormap commcolors colors nextcolor |
|
648 |
global parents nparents children nchildren |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
649 |
global cornercrossings crossings |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
650 |
|
267 | 651 |
if [info exists colormap($id)] return |
652 |
set ncolors [llength $colors] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
653 |
if {$nparents($id) <= 1 && $nchildren($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
654 |
set child [lindex $children($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
655 |
if {[info exists colormap($child)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
656 |
&& $nparents($child) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
657 |
set colormap($id) $colormap($child) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
658 |
return |
267 | 659 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
660 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
661 |
set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
662 |
if {[info exists cornercrossings($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
663 |
foreach x $cornercrossings($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
664 |
if {[info exists colormap($x)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
665 |
&& [lsearch -exact $badcolors $colormap($x)] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
666 |
lappend badcolors $colormap($x) |
267 | 667 |
} |
668 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
669 |
if {[llength $badcolors] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
670 |
set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
671 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
672 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
673 |
set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
674 |
if {[llength $badcolors] < $ncolors - 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
675 |
if {[info exists crossings($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
676 |
foreach x $crossings($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
677 |
if {[info exists colormap($x)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
678 |
&& [lsearch -exact $badcolors $colormap($x)] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
679 |
lappend badcolors $colormap($x) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
680 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
681 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
682 |
if {[llength $badcolors] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
683 |
set badcolors $origbad |
267 | 684 |
} |
685 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
686 |
set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
687 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
688 |
if {[llength $badcolors] < $ncolors - 1} { |
267 | 689 |
foreach child $children($id) { |
690 |
if {[info exists colormap($child)] |
|
691 |
&& [lsearch -exact $badcolors $colormap($child)] < 0} { |
|
692 |
lappend badcolors $colormap($child) |
|
693 |
} |
|
694 |
if {[info exists parents($child)]} { |
|
695 |
foreach p $parents($child) { |
|
696 |
if {[info exists colormap($p)] |
|
697 |
&& [lsearch -exact $badcolors $colormap($p)] < 0} { |
|
698 |
lappend badcolors $colormap($p) |
|
699 |
} |
|
700 |
} |
|
701 |
} |
|
702 |
} |
|
703 |
if {[llength $badcolors] >= $ncolors} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
704 |
set badcolors $origbad |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
705 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
706 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
707 |
for {set i 0} {$i <= $ncolors} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
708 |
set c [lindex $colors $nextcolor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
709 |
if {[incr nextcolor] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
710 |
set nextcolor 0 |
267 | 711 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
712 |
if {[lsearch -exact $badcolors $c]} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
713 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
714 |
set colormap($id) $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
715 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
716 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
717 |
proc initgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
718 |
global canvy canvy0 lineno numcommits nextcolor linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
719 |
global mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
720 |
global nchildren ncleft |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
721 |
global displist nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
722 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
723 |
allcanvs delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
724 |
set nextcolor 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
725 |
set canvy $canvy0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
726 |
set lineno -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
727 |
set numcommits 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
728 |
catch {unset mainline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
729 |
catch {unset mainlinearrow} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
730 |
catch {unset sidelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
731 |
foreach id [array names nchildren] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
732 |
set ncleft($id) $nchildren($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
733 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
734 |
set displist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
735 |
set nhyperspace 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
736 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
737 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
738 |
proc bindline {t id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
739 |
global canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
740 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
741 |
$canv bind $t <Enter> "lineenter %x %y $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
742 |
$canv bind $t <Motion> "linemotion %x %y $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
743 |
$canv bind $t <Leave> "lineleave $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
744 |
$canv bind $t <Button-1> "lineclick %x %y $id 1" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
745 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
746 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
747 |
proc drawlines {id xtra} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
748 |
global mainline mainlinearrow sidelines lthickness colormap canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
749 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
750 |
$canv delete lines.$id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
751 |
if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
752 |
set t [$canv create line $mainline($id) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
753 |
-width [expr {($xtra + 1) * $lthickness}] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
754 |
-fill $colormap($id) -tags lines.$id \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
755 |
-arrow $mainlinearrow($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
756 |
$canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
757 |
bindline $t $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
758 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
759 |
if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
760 |
foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
761 |
set coords [lindex $ls 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
762 |
set thick [lindex $ls 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
763 |
set arrow [lindex $ls 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
764 |
set t [$canv create line $coords -fill $colormap($id) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
765 |
-width [expr {($thick + $xtra) * $lthickness}] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
766 |
-arrow $arrow -tags lines.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
767 |
$canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
768 |
bindline $t $id |
267 | 769 |
} |
770 |
} |
|
771 |
} |
|
772 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
773 |
# level here is an index in displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
774 |
proc drawcommitline {level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
775 |
global parents children nparents displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
776 |
global canv canv2 canv3 mainfont namefont canvy linespc |
267 | 777 |
global lineid linehtag linentag linedtag commitinfo |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
778 |
global colormap numcommits currentparents dupparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
779 |
global idtags idline idheads idotherrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
780 |
global lineno lthickness mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
781 |
global commitlisted rowtextx idpos lastuse displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
782 |
global oldnlines olddlevel olddisplist |
267 | 783 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
784 |
incr numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
785 |
incr lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
786 |
set id [lindex $displist $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
787 |
set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
788 |
set lineid($lineno) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
789 |
set idline($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
790 |
set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
791 |
if {![info exists commitinfo($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
792 |
readcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
793 |
if {![info exists commitinfo($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
794 |
set commitinfo($id) {"No commit information available"} |
267 | 795 |
set nparents($id) 0 |
796 |
} |
|
797 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
798 |
assigncolor $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
799 |
set currentparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
800 |
set dupparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
801 |
if {[info exists commitlisted($id)] && [info exists parents($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
802 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
803 |
if {[lsearch -exact $currentparents $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
804 |
lappend currentparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
805 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
806 |
# remember that this parent was listed twice |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
807 |
lappend dupparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
808 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
809 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
810 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
811 |
set x [xcoord $level $level $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
812 |
set y1 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
813 |
set canvy [expr $canvy + $linespc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
814 |
allcanvs conf -scrollregion \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
815 |
[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
816 |
if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
817 |
lappend mainline($id) $x $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
818 |
if {$mainlinearrow($id) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
819 |
set mainline($id) [trimdiagstart $mainline($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
820 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
821 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
822 |
drawlines $id 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
823 |
set orad [expr {$linespc / 3}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
824 |
set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
825 |
[expr $x + $orad - 1] [expr $y1 + $orad - 1] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
826 |
-fill $ofill -outline black -width 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
827 |
$canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
828 |
$canv bind $t <1> {selcanvline {} %x %y} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
829 |
set xt [xcoord [llength $displist] $level $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
830 |
if {[llength $currentparents] > 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
831 |
set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
832 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
833 |
set rowtextx($lineno) $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
834 |
set idpos($id) [list $x $xt $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
835 |
if {[info exists idtags($id)] || [info exists idheads($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
836 |
|| [info exists idotherrefs($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
837 |
set xt [drawtags $id $x $xt $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
838 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
839 |
set headline [lindex $commitinfo($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
840 |
set name [lindex $commitinfo($id) 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
841 |
set date [lindex $commitinfo($id) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
842 |
set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
843 |
-text $headline -font $mainfont ] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
844 |
$canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
845 |
set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
846 |
-text $name -font $namefont] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
847 |
set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
848 |
-text $date -font $mainfont] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
849 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
850 |
set olddlevel $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
851 |
set olddisplist $displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
852 |
set oldnlines [llength $displist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
853 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
854 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
855 |
proc drawtags {id x xt y1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
856 |
global idtags idheads idotherrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
857 |
global linespc lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
858 |
global canv mainfont idline rowtextx |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
859 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
860 |
set marks {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
861 |
set ntags 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
862 |
set nheads 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
863 |
if {[info exists idtags($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
864 |
set marks $idtags($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
865 |
set ntags [llength $marks] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
866 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
867 |
if {[info exists idheads($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
868 |
set marks [concat $marks $idheads($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
869 |
set nheads [llength $idheads($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
870 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
871 |
if {[info exists idotherrefs($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
872 |
set marks [concat $marks $idotherrefs($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
873 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
874 |
if {$marks eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
875 |
return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
876 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
877 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
878 |
set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
879 |
set yt [expr $y1 - 0.5 * $linespc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
880 |
set yb [expr $yt + $linespc - 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
881 |
set xvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
882 |
set wvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
883 |
foreach tag $marks { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
884 |
set wid [font measure $mainfont $tag] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
885 |
lappend xvals $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
886 |
lappend wvals $wid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
887 |
set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
888 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
889 |
set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
890 |
-width $lthickness -fill black -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
891 |
$canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
892 |
foreach tag $marks x $xvals wid $wvals { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
893 |
set xl [expr $x + $delta] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
894 |
set xr [expr $x + $delta + $wid + $lthickness] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
895 |
if {[incr ntags -1] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
896 |
# draw a tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
897 |
set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
898 |
$xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
899 |
-width 1 -outline black -fill yellow -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
900 |
$canv bind $t <1> [list showtag $tag 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
901 |
set rowtextx($idline($id)) [expr {$xr + $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
902 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
903 |
# draw a head or other ref |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
904 |
if {[incr nheads -1] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
905 |
set col green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
906 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
907 |
set col "#ddddff" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
908 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
909 |
set xl [expr $xl - $delta/2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
910 |
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
911 |
-width 1 -outline black -fill $col -tags tag.$id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
912 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
913 |
set t [$canv create text $xl $y1 -anchor w -text $tag \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
914 |
-font $mainfont -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
915 |
if {$ntags >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
916 |
$canv bind $t <1> [list showtag $tag 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
917 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
918 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
919 |
return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
920 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
921 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
922 |
proc notecrossings {id lo hi corner} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
923 |
global olddisplist crossings cornercrossings |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
924 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
925 |
for {set i $lo} {[incr i] < $hi} {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
926 |
set p [lindex $olddisplist $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
927 |
if {$p == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
928 |
if {$i == $corner} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
929 |
if {![info exists cornercrossings($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
930 |
|| [lsearch -exact $cornercrossings($id) $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
931 |
lappend cornercrossings($id) $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
932 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
933 |
if {![info exists cornercrossings($p)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
934 |
|| [lsearch -exact $cornercrossings($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
935 |
lappend cornercrossings($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
936 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
937 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
938 |
if {![info exists crossings($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
939 |
|| [lsearch -exact $crossings($id) $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
940 |
lappend crossings($id) $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
941 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
942 |
if {![info exists crossings($p)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
943 |
|| [lsearch -exact $crossings($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
944 |
lappend crossings($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
945 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
946 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
947 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
948 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
949 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
950 |
proc xcoord {i level ln} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
951 |
global canvx0 xspc1 xspc2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
952 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
953 |
set x [expr {$canvx0 + $i * $xspc1($ln)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
954 |
if {$i > 0 && $i == $level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
955 |
set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
956 |
} elseif {$i > $level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
957 |
set x [expr {$x + $xspc2 - $xspc1($ln)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
958 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
959 |
return $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
960 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
961 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
962 |
# it seems Tk can't draw arrows on the end of diagonal line segments... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
963 |
proc trimdiagend {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
964 |
while {[llength $line] > 4} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
965 |
set x1 [lindex $line end-3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
966 |
set y1 [lindex $line end-2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
967 |
set x2 [lindex $line end-1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
968 |
set y2 [lindex $line end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
969 |
if {($x1 == $x2) != ($y1 == $y2)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
970 |
set line [lreplace $line end-1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
971 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
972 |
return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
973 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
974 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
975 |
proc trimdiagstart {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
976 |
while {[llength $line] > 4} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
977 |
set x1 [lindex $line 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
978 |
set y1 [lindex $line 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
979 |
set x2 [lindex $line 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
980 |
set y2 [lindex $line 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
981 |
if {($x1 == $x2) != ($y1 == $y2)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
982 |
set line [lreplace $line 0 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
983 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
984 |
return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
985 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
986 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
987 |
proc drawslants {id needonscreen nohs} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
988 |
global canv mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
989 |
global canvx0 canvy xspc1 xspc2 lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
990 |
global currentparents dupparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
991 |
global lthickness linespc canvy colormap lineno geometry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
992 |
global maxgraphpct maxwidth |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
993 |
global displist onscreen lastuse |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
994 |
global parents commitlisted |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
995 |
global oldnlines olddlevel olddisplist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
996 |
global nhyperspace numcommits nnewparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
997 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
998 |
if {$lineno < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
999 |
lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1000 |
set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1001 |
return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1002 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1003 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1004 |
set y1 [expr {$canvy - $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1005 |
set y2 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1006 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1007 |
# work out what we need to get back on screen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1008 |
set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1009 |
if {$onscreen($id) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1010 |
# next to do isn't displayed, better get it on screen... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1011 |
lappend reins [list $id 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1012 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1013 |
# make sure all the previous commits's parents are on the screen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1014 |
foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1015 |
if {$onscreen($p) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1016 |
lappend reins [list $p 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1017 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1018 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1019 |
# bring back anything requested by caller |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1020 |
if {$needonscreen ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1021 |
lappend reins $needonscreen |
267 | 1022 |
} |
1023 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1024 |
# try the shortcut |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1025 |
if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1026 |
set dlevel $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1027 |
set x [xcoord $dlevel $dlevel $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1028 |
set mainline($id) [list $x $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1029 |
set mainlinearrow($id) none |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1030 |
set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1031 |
set displist [lreplace $displist $dlevel $dlevel $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1032 |
set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1033 |
set xspc1([expr {$lineno + 1}]) $xspc1($lineno) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1034 |
return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1035 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1036 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1037 |
# update displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1038 |
set displist [lreplace $displist $olddlevel $olddlevel] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1039 |
set j $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1040 |
foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1041 |
set lastuse($p) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1042 |
if {$onscreen($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1043 |
set displist [linsert $displist $j $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1044 |
set onscreen($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1045 |
incr j |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1046 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1047 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1048 |
if {$onscreen($id) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1049 |
lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1050 |
set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1051 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1052 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1053 |
# remove the null entry if present |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1054 |
set nullentry [lsearch -exact $displist {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1055 |
if {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1056 |
set displist [lreplace $displist $nullentry $nullentry] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1057 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1058 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1059 |
# bring back the ones we need now (if we did it earlier |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1060 |
# it would change displist and invalidate olddlevel) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1061 |
foreach pi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1062 |
# test again in case of duplicates in reins |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1063 |
set p [lindex $pi 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1064 |
if {$onscreen($p) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1065 |
set onscreen($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1066 |
set lastuse($p) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1067 |
set displist [linsert $displist [lindex $pi 1] $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1068 |
incr nhyperspace -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1069 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1070 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1071 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1072 |
set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1073 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1074 |
# see if we need to make any lines jump off into hyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1075 |
set displ [llength $displist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1076 |
if {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1077 |
set ages {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1078 |
foreach x $displist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1079 |
lappend ages [list $lastuse($x) $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1080 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1081 |
set ages [lsort -integer -index 0 $ages] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1082 |
set k 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1083 |
while {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1084 |
set use [lindex $ages $k 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1085 |
set victim [lindex $ages $k 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1086 |
if {$use >= $lineno - 5} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1087 |
incr k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1088 |
if {[lsearch -exact $nohs $victim] >= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1089 |
set i [lsearch -exact $displist $victim] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1090 |
set displist [lreplace $displist $i $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1091 |
set onscreen($victim) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1092 |
incr nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1093 |
incr displ -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1094 |
if {$i < $nullentry} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1095 |
incr nullentry -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1096 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1097 |
set x [lindex $mainline($victim) end-1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1098 |
lappend mainline($victim) $x $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1099 |
set line [trimdiagend $mainline($victim)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1100 |
set arrow "last" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1101 |
if {$mainlinearrow($victim) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1102 |
set line [trimdiagstart $line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1103 |
set arrow "both" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1104 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1105 |
lappend sidelines($victim) [list $line 1 $arrow] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1106 |
unset mainline($victim) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1107 |
} |
267 | 1108 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1109 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1110 |
set dlevel [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1111 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1112 |
# If we are reducing, put in a null entry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1113 |
if {$displ < $oldnlines} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1114 |
# does the next line look like a merge? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1115 |
# i.e. does it have > 1 new parent? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1116 |
if {$nnewparents($id) > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1117 |
set i [expr {$dlevel + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1118 |
} elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1119 |
set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1120 |
if {$nullentry >= 0 && $nullentry < $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1121 |
incr i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1122 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1123 |
} elseif {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1124 |
set i $nullentry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1125 |
while {$i < $displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1126 |
&& [lindex $olddisplist $i] == [lindex $displist $i]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1127 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1128 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1129 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1130 |
set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1131 |
if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1132 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1133 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1134 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1135 |
if {$i < $displ} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1136 |
set displist [linsert $displist $i {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1137 |
incr displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1138 |
if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1139 |
incr dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1140 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1141 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1142 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1143 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1144 |
# decide on the line spacing for the next line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1145 |
set lj [expr {$lineno + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1146 |
set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1147 |
if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1148 |
set xspc1($lj) $xspc2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1149 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1150 |
set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1151 |
if {$xspc1($lj) < $lthickness} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1152 |
set xspc1($lj) $lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1153 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1154 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1155 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1156 |
foreach idi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1157 |
set id [lindex $idi 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1158 |
set j [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1159 |
set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1160 |
set mainline($id) [list $xj $y2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1161 |
set mainlinearrow($id) first |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1162 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1163 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1164 |
set i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1165 |
foreach id $olddisplist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1166 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1167 |
if {$id == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1168 |
if {$onscreen($id) <= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1169 |
set xi [xcoord $i $olddlevel $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1170 |
if {$i == $olddlevel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1171 |
foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1172 |
set j [lsearch -exact $displist $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1173 |
set coords [list $xi $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1174 |
set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1175 |
if {$xj < $xi - $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1176 |
lappend coords [expr {$xj + $linespc}] $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1177 |
notecrossings $p $j $i [expr {$j + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1178 |
} elseif {$xj > $xi + $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1179 |
lappend coords [expr {$xj - $linespc}] $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1180 |
notecrossings $p $i $j [expr {$j - 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1181 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1182 |
if {[lsearch -exact $dupparents $p] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1183 |
# draw a double-width line to indicate the doubled parent |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1184 |
lappend coords $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1185 |
lappend sidelines($p) [list $coords 2 none] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1186 |
if {![info exists mainline($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1187 |
set mainline($p) [list $xj $y2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1188 |
set mainlinearrow($p) none |
267 | 1189 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1190 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1191 |
# normal case, no parent duplicated |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1192 |
set yb $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1193 |
set dx [expr {abs($xi - $xj)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1194 |
if {0 && $dx < $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1195 |
set yb [expr {$y1 + $dx}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1196 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1197 |
if {![info exists mainline($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1198 |
if {$xi != $xj} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1199 |
lappend coords $xj $yb |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1200 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1201 |
set mainline($p) $coords |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1202 |
set mainlinearrow($p) none |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1203 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1204 |
lappend coords $xj $yb |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1205 |
if {$yb < $y2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1206 |
lappend coords $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1207 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1208 |
lappend sidelines($p) [list $coords 1 none] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1209 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1210 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1211 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1212 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1213 |
set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1214 |
if {[lindex $displist $i] != $id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1215 |
set j [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1216 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1217 |
if {$j != $i || $xspc1($lineno) != $xspc1($lj) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1218 |
|| ($olddlevel < $i && $i < $dlevel) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1219 |
|| ($dlevel < $i && $i < $olddlevel)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1220 |
set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1221 |
lappend mainline($id) $xi $y1 $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1222 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1223 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1224 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1225 |
return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1226 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1227 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1228 |
# search for x in a list of lists |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1229 |
proc llsearch {llist x} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1230 |
set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1231 |
foreach l $llist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1232 |
if {$l == $x || [lsearch -exact $l $x] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1233 |
return $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1234 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1235 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1236 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1237 |
return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1238 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1239 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1240 |
proc drawmore {reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1241 |
global displayorder numcommits ncmupdate nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1242 |
global stopped nhyperspace parents commitlisted |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1243 |
global maxwidth onscreen displist currentparents olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1244 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1245 |
set n [llength $displayorder] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1246 |
while {$numcommits < $n} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1247 |
set id [lindex $displayorder $numcommits] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1248 |
set ctxend [expr {$numcommits + 10}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1249 |
if {!$reading && $ctxend > $n} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1250 |
set ctxend $n |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1251 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1252 |
set dlist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1253 |
if {$numcommits > 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1254 |
set dlist [lreplace $displist $olddlevel $olddlevel] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1255 |
set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1256 |
foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1257 |
if {$onscreen($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1258 |
set dlist [linsert $dlist $i $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1259 |
incr i |
267 | 1260 |
} |
1261 |
} |
|
1262 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1263 |
set nohs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1264 |
set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1265 |
set isfat [expr {[llength $dlist] > $maxwidth}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1266 |
if {$nhyperspace > 0 || $isfat} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1267 |
if {$ctxend > $n} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1268 |
# work out what to bring back and |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1269 |
# what we want to don't want to send into hyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1270 |
set room 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1271 |
for {set k $numcommits} {$k < $ctxend} {incr k} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1272 |
set x [lindex $displayorder $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1273 |
set i [llsearch $dlist $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1274 |
if {$i < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1275 |
set i [llength $dlist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1276 |
lappend dlist $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1277 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1278 |
if {[lsearch -exact $nohs $x] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1279 |
lappend nohs $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1280 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1281 |
if {$reins eq {} && $onscreen($x) < 0 && $room} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1282 |
set reins [list $x $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1283 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1284 |
set newp {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1285 |
if {[info exists commitlisted($x)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1286 |
set right 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1287 |
foreach p $parents($x) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1288 |
if {[llsearch $dlist $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1289 |
lappend newp $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1290 |
if {[lsearch -exact $nohs $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1291 |
lappend nohs $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1292 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1293 |
if {$reins eq {} && $onscreen($p) < 0 && $room} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1294 |
set reins [list $p [expr {$i + $right}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1295 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1296 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1297 |
set right 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1298 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1299 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1300 |
set l [lindex $dlist $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1301 |
if {[llength $l] == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1302 |
set l $newp |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1303 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1304 |
set j [lsearch -exact $l $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1305 |
set l [concat [lreplace $l $j $j] $newp] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1306 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1307 |
set dlist [lreplace $dlist $i $i $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1308 |
if {$room && $isfat && [llength $newp] <= 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1309 |
set room 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1310 |
} |
267 | 1311 |
} |
1312 |
} |
|
1313 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1314 |
set dlevel [drawslants $id $reins $nohs] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1315 |
drawcommitline $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1316 |
if {[clock clicks -milliseconds] >= $nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1317 |
&& $numcommits >= $ncmupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1318 |
doupdate $reading |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1319 |
if {$stopped} break |
267 | 1320 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1321 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1322 |
} |
267 | 1323 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1324 |
# level here is an index in todo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1325 |
proc updatetodo {level noshortcut} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1326 |
global ncleft todo nnewparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1327 |
global commitlisted parents onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1328 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1329 |
set id [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1330 |
set olds {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1331 |
if {[info exists commitlisted($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1332 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1333 |
if {[lsearch -exact $olds $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1334 |
lappend olds $p |
267 | 1335 |
} |
1336 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1337 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1338 |
if {!$noshortcut && [llength $olds] == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1339 |
set p [lindex $olds 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1340 |
if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1341 |
set ncleft($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1342 |
set todo [lreplace $todo $level $level $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1343 |
set onscreen($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1344 |
set nnewparents($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1345 |
return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1346 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1347 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1348 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1349 |
set todo [lreplace $todo $level $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1350 |
set i $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1351 |
set n 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1352 |
foreach p $olds { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1353 |
incr ncleft($p) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1354 |
set k [lsearch -exact $todo $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1355 |
if {$k < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1356 |
set todo [linsert $todo $i $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1357 |
set onscreen($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1358 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1359 |
incr n |
267 | 1360 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1361 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1362 |
set nnewparents($id) $n |
267 | 1363 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1364 |
return 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1365 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1366 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1367 |
proc decidenext {{noread 0}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1368 |
global ncleft todo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1369 |
global datemode cdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1370 |
global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1371 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1372 |
# choose which one to do next time around |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1373 |
set todol [llength $todo] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1374 |
set level -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1375 |
set latest {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1376 |
for {set k $todol} {[incr k -1] >= 0} {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1377 |
set p [lindex $todo $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1378 |
if {$ncleft($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1379 |
if {$datemode} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1380 |
if {![info exists commitinfo($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1381 |
if {$noread} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1382 |
return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1383 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1384 |
readcommit $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1385 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1386 |
if {$latest == {} || $cdate($p) > $latest} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1387 |
set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1388 |
set latest $cdate($p) |
267 | 1389 |
} |
1390 |
} else { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1391 |
set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1392 |
break |
267 | 1393 |
} |
1394 |
} |
|
1395 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1396 |
if {$level < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1397 |
if {$todo != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1398 |
puts "ERROR: none of the pending commits can be done yet:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1399 |
foreach p $todo { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1400 |
puts " $p ($ncleft($p))" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1401 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1402 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1403 |
return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1404 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1405 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1406 |
return $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1407 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1408 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1409 |
proc drawcommit {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1410 |
global phase todo nchildren datemode nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1411 |
global numcommits ncmupdate displayorder todo onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1412 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1413 |
if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1414 |
set phase incrdraw |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1415 |
set displayorder {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1416 |
set todo {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1417 |
initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1418 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1419 |
if {$nchildren($id) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1420 |
lappend todo $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1421 |
set onscreen($id) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1422 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1423 |
set level [decidenext 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1424 |
if {$level == {} || $id != [lindex $todo $level]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1425 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1426 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1427 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1428 |
lappend displayorder [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1429 |
if {[updatetodo $level $datemode]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1430 |
set level [decidenext 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1431 |
if {$level == {}} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1432 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1433 |
set id [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1434 |
if {![info exists commitlisted($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1435 |
break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1436 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1437 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1438 |
drawmore 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1439 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1440 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1441 |
proc finishcommits {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1442 |
global phase |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1443 |
global canv mainfont ctext maincursor textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1444 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1445 |
if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1446 |
$canv delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1447 |
$canv create text 3 3 -anchor nw -text "No commits selected" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1448 |
-font $mainfont -tags textitems |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1449 |
set phase {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1450 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1451 |
drawrest |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1452 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1453 |
. config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1454 |
settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1455 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1456 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1457 |
# Don't change the text pane cursor if it is currently the hand cursor, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1458 |
# showing that we are over a sha1 ID link. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1459 |
proc settextcursor {c} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1460 |
global ctext curtextcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1461 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1462 |
if {[$ctext cget -cursor] == $curtextcursor} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1463 |
$ctext config -cursor $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1464 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1465 |
set curtextcursor $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1466 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1467 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1468 |
proc drawgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1469 |
global nextupdate startmsecs ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1470 |
global displayorder onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1471 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1472 |
if {$displayorder == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1473 |
set startmsecs [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1474 |
set nextupdate [expr $startmsecs + 100] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1475 |
set ncmupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1476 |
initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1477 |
foreach id $displayorder { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1478 |
set onscreen($id) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1479 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1480 |
drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1481 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1482 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1483 |
proc drawrest {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1484 |
global phase stopped redisplaying selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1485 |
global datemode todo displayorder |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1486 |
global numcommits ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1487 |
global nextupdate startmsecs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1488 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1489 |
set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1490 |
if {$level >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1491 |
set phase drawgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1492 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1493 |
lappend displayorder [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1494 |
set hard [updatetodo $level $datemode] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1495 |
if {$hard} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1496 |
set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1497 |
if {$level < 0} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1498 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1499 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1500 |
drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1501 |
} |
267 | 1502 |
set phase {} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1503 |
set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1504 |
#puts "overall $drawmsecs ms for $numcommits commits" |
267 | 1505 |
if {$redisplaying} { |
1506 |
if {$stopped == 0 && [info exists selectedline]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1507 |
selectline $selectedline 0 |
267 | 1508 |
} |
1509 |
if {$stopped == 1} { |
|
1510 |
set stopped 0 |
|
1511 |
after idle drawgraph |
|
1512 |
} else { |
|
1513 |
set redisplaying 0 |
|
1514 |
} |
|
1515 |
} |
|
1516 |
} |
|
1517 |
||
1518 |
proc findmatches {f} { |
|
1519 |
global findtype foundstring foundstrlen |
|
1520 |
if {$findtype == "Regexp"} { |
|
1521 |
set matches [regexp -indices -all -inline $foundstring $f] |
|
1522 |
} else { |
|
1523 |
if {$findtype == "IgnCase"} { |
|
1524 |
set str [string tolower $f] |
|
1525 |
} else { |
|
1526 |
set str $f |
|
1527 |
} |
|
1528 |
set matches {} |
|
1529 |
set i 0 |
|
1530 |
while {[set j [string first $foundstring $str $i]] >= 0} { |
|
1531 |
lappend matches [list $j [expr $j+$foundstrlen-1]] |
|
1532 |
set i [expr $j + $foundstrlen] |
|
1533 |
} |
|
1534 |
} |
|
1535 |
return $matches |
|
1536 |
} |
|
1537 |
||
1538 |
proc dofind {} { |
|
1539 |
global findtype findloc findstring markedmatches commitinfo |
|
1540 |
global numcommits lineid linehtag linentag linedtag |
|
1541 |
global mainfont namefont canv canv2 canv3 selectedline |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1542 |
global matchinglines foundstring foundstrlen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1543 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1544 |
stopfindproc |
267 | 1545 |
unmarkmatches |
1546 |
focus . |
|
1547 |
set matchinglines {} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1548 |
if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1549 |
findpatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1550 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1551 |
} |
267 | 1552 |
if {$findtype == "IgnCase"} { |
1553 |
set foundstring [string tolower $findstring] |
|
1554 |
} else { |
|
1555 |
set foundstring $findstring |
|
1556 |
} |
|
1557 |
set foundstrlen [string length $findstring] |
|
1558 |
if {$foundstrlen == 0} return |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1559 |
if {$findloc == "Files"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1560 |
findfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1561 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1562 |
} |
267 | 1563 |
if {![info exists selectedline]} { |
1564 |
set oldsel -1 |
|
1565 |
} else { |
|
1566 |
set oldsel $selectedline |
|
1567 |
} |
|
1568 |
set didsel 0 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1569 |
set fldtypes {Headline Author Date Committer CDate Comment} |
267 | 1570 |
for {set l 0} {$l < $numcommits} {incr l} { |
1571 |
set id $lineid($l) |
|
1572 |
set info $commitinfo($id) |
|
1573 |
set doesmatch 0 |
|
1574 |
foreach f $info ty $fldtypes { |
|
1575 |
if {$findloc != "All fields" && $findloc != $ty} { |
|
1576 |
continue |
|
1577 |
} |
|
1578 |
set matches [findmatches $f] |
|
1579 |
if {$matches == {}} continue |
|
1580 |
set doesmatch 1 |
|
1581 |
if {$ty == "Headline"} { |
|
1582 |
markmatches $canv $l $f $linehtag($l) $matches $mainfont |
|
1583 |
} elseif {$ty == "Author"} { |
|
1584 |
markmatches $canv2 $l $f $linentag($l) $matches $namefont |
|
1585 |
} elseif {$ty == "Date"} { |
|
1586 |
markmatches $canv3 $l $f $linedtag($l) $matches $mainfont |
|
1587 |
} |
|
1588 |
} |
|
1589 |
if {$doesmatch} { |
|
1590 |
lappend matchinglines $l |
|
1591 |
if {!$didsel && $l > $oldsel} { |
|
1592 |
findselectline $l |
|
1593 |
set didsel 1 |
|
1594 |
} |
|
1595 |
} |
|
1596 |
} |
|
1597 |
if {$matchinglines == {}} { |
|
1598 |
bell |
|
1599 |
} elseif {!$didsel} { |
|
1600 |
findselectline [lindex $matchinglines 0] |
|
1601 |
} |
|
1602 |
} |
|
1603 |
||
1604 |
proc findselectline {l} { |
|
1605 |
global findloc commentend ctext |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1606 |
selectline $l 1 |
267 | 1607 |
if {$findloc == "All fields" || $findloc == "Comments"} { |
1608 |
# highlight the matches in the comments |
|
1609 |
set f [$ctext get 1.0 $commentend] |
|
1610 |
set matches [findmatches $f] |
|
1611 |
foreach match $matches { |
|
1612 |
set start [lindex $match 0] |
|
1613 |
set end [expr [lindex $match 1] + 1] |
|
1614 |
$ctext tag add found "1.0 + $start c" "1.0 + $end c" |
|
1615 |
} |
|
1616 |
} |
|
1617 |
} |
|
1618 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1619 |
proc findnext {restart} { |
267 | 1620 |
global matchinglines selectedline |
1621 |
if {![info exists matchinglines]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1622 |
if {$restart} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1623 |
dofind |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1624 |
} |
267 | 1625 |
return |
1626 |
} |
|
1627 |
if {![info exists selectedline]} return |
|
1628 |
foreach l $matchinglines { |
|
1629 |
if {$l > $selectedline} { |
|
1630 |
findselectline $l |
|
1631 |
return |
|
1632 |
} |
|
1633 |
} |
|
1634 |
bell |
|
1635 |
} |
|
1636 |
||
1637 |
proc findprev {} { |
|
1638 |
global matchinglines selectedline |
|
1639 |
if {![info exists matchinglines]} { |
|
1640 |
dofind |
|
1641 |
return |
|
1642 |
} |
|
1643 |
if {![info exists selectedline]} return |
|
1644 |
set prev {} |
|
1645 |
foreach l $matchinglines { |
|
1646 |
if {$l >= $selectedline} break |
|
1647 |
set prev $l |
|
1648 |
} |
|
1649 |
if {$prev != {}} { |
|
1650 |
findselectline $prev |
|
1651 |
} else { |
|
1652 |
bell |
|
1653 |
} |
|
1654 |
} |
|
1655 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1656 |
proc findlocchange {name ix op} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1657 |
global findloc findtype findtypemenu |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1658 |
if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1659 |
set findtype Exact |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1660 |
set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1661 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1662 |
set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1663 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1664 |
$findtypemenu entryconf 1 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1665 |
$findtypemenu entryconf 2 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1666 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1667 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1668 |
proc stopfindproc {{done 0}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1669 |
global findprocpid findprocfile findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1670 |
global ctext findoldcursor phase maincursor textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1671 |
global findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1672 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1673 |
catch {unset findids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1674 |
if {[info exists findprocpid]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1675 |
if {!$done} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1676 |
catch {exec kill $findprocpid} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1677 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1678 |
catch {close $findprocfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1679 |
unset findprocpid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1680 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1681 |
if {[info exists findinprogress]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1682 |
unset findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1683 |
if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1684 |
. config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1685 |
settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1686 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1687 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1688 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1689 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1690 |
proc findpatches {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1691 |
global findstring selectedline numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1692 |
global findprocpid findprocfile |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1693 |
global finddidsel ctext lineid findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1694 |
global findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1695 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1696 |
if {$numcommits == 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1697 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1698 |
# make a list of all the ids to search, starting at the one |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1699 |
# after the selected line (if any) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1700 |
if {[info exists selectedline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1701 |
set l $selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1702 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1703 |
set l -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1704 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1705 |
set inputids {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1706 |
for {set i 0} {$i < $numcommits} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1707 |
if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1708 |
set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1709 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1710 |
append inputids $lineid($l) "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1711 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1712 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1713 |
if {[catch { |
1278 | 1714 |
set f [open [list | hg debug-diff-tree --stdin -s -r -S$findstring \ |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1715 |
<< $inputids] r] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1716 |
} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1717 |
error_popup "Error starting search process: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1718 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1719 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1720 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1721 |
set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1722 |
set findprocfile $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1723 |
set findprocpid [pid $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1724 |
fconfigure $f -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1725 |
fileevent $f readable readfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1726 |
set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1727 |
. config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1728 |
settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1729 |
set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1730 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1731 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1732 |
proc readfindproc {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1733 |
global findprocfile finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1734 |
global idline matchinglines findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1735 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1736 |
set n [gets $findprocfile line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1737 |
if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1738 |
if {[eof $findprocfile]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1739 |
stopfindproc 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1740 |
if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1741 |
bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1742 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1743 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1744 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1745 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1746 |
if {![regexp {^[0-9a-f]{40}} $line id]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1747 |
error_popup "Can't parse git-diff-tree output: $line" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1748 |
stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1749 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1750 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1751 |
if {![info exists idline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1752 |
puts stderr "spurious id: $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1753 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1754 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1755 |
set l $idline($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1756 |
insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1757 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1758 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1759 |
proc insertmatch {l id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1760 |
global matchinglines findinsertpos finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1761 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1762 |
if {$findinsertpos == "end"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1763 |
if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1764 |
set matchinglines [linsert $matchinglines 0 $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1765 |
set findinsertpos 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1766 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1767 |
lappend matchinglines $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1768 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1769 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1770 |
set matchinglines [linsert $matchinglines $findinsertpos $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1771 |
incr findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1772 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1773 |
markheadline $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1774 |
if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1775 |
findselectline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1776 |
set finddidsel 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1777 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1778 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1779 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1780 |
proc findfiles {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1781 |
global selectedline numcommits lineid ctext |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1782 |
global ffileline finddidsel parents nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1783 |
global findinprogress findstartline findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1784 |
global treediffs fdiffids fdiffsneeded fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1785 |
global findmergefiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1786 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1787 |
if {$numcommits == 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1788 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1789 |
if {[info exists selectedline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1790 |
set l [expr {$selectedline + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1791 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1792 |
set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1793 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1794 |
set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1795 |
set findstartline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1796 |
set diffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1797 |
set fdiffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1798 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1799 |
set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1800 |
if {$findmergefiles || $nparents($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1801 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1802 |
if {![info exists treediffs([list $id $p])]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1803 |
append diffsneeded "$id $p\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1804 |
lappend fdiffsneeded [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1805 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1806 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1807 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1808 |
if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1809 |
set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1810 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1811 |
if {$l == $findstartline} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1812 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1813 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1814 |
# start off a git-diff-tree process if needed |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1815 |
if {$diffsneeded ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1816 |
if {[catch { |
1278 | 1817 |
set df [open [list | hg debug-diff-tree -r --stdin << $diffsneeded] r] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1818 |
} err ]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1819 |
error_popup "Error starting search process: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1820 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1821 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1822 |
catch {unset fdiffids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1823 |
set fdiffpos 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1824 |
fconfigure $df -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1825 |
fileevent $df readable [list readfilediffs $df] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1826 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1827 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1828 |
set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1829 |
set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1830 |
set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1831 |
set p [lindex $parents($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1832 |
. config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1833 |
settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1834 |
set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1835 |
findcont [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1836 |
update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1837 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1838 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1839 |
proc readfilediffs {df} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1840 |
global findids fdiffids fdiffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1841 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1842 |
set n [gets $df line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1843 |
if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1844 |
if {[eof $df]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1845 |
donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1846 |
if {[catch {close $df} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1847 |
stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1848 |
bell |
1278 | 1849 |
error_popup "Error in hg debug-diff-tree: $err" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1850 |
} elseif {[info exists findids]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1851 |
set ids $findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1852 |
stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1853 |
bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1854 |
error_popup "Couldn't find diffs for {$ids}" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1855 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1856 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1857 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1858 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1859 |
if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1860 |
# start of a new string of diffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1861 |
donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1862 |
set fdiffids [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1863 |
set fdiffs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1864 |
} elseif {[string match ":*" $line]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1865 |
lappend fdiffs [lindex $line 5] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1866 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1867 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1868 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1869 |
proc donefilediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1870 |
global fdiffids fdiffs treediffs findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1871 |
global fdiffsneeded fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1872 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1873 |
if {[info exists fdiffids]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1874 |
while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1875 |
&& $fdiffpos < [llength $fdiffsneeded]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1876 |
# git-diff-tree doesn't output anything for a commit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1877 |
# which doesn't change anything |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1878 |
set nullids [lindex $fdiffsneeded $fdiffpos] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1879 |
set treediffs($nullids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1880 |
if {[info exists findids] && $nullids eq $findids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1881 |
unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1882 |
findcont $nullids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1883 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1884 |
incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1885 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1886 |
incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1887 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1888 |
if {![info exists treediffs($fdiffids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1889 |
set treediffs($fdiffids) $fdiffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1890 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1891 |
if {[info exists findids] && $fdiffids eq $findids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1892 |
unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1893 |
findcont $fdiffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1894 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1895 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1896 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1897 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1898 |
proc findcont {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1899 |
global findids treediffs parents nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1900 |
global ffileline findstartline finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1901 |
global lineid numcommits matchinglines findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1902 |
global findmergefiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1903 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1904 |
set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1905 |
set p [lindex $ids 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1906 |
set pi [lsearch -exact $parents($id) $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1907 |
set l $ffileline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1908 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1909 |
if {$findmergefiles || $nparents($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1910 |
if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1911 |
set findids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1912 |
set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1913 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1914 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1915 |
set doesmatch 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1916 |
foreach f $treediffs($ids) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1917 |
set x [findmatches $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1918 |
if {$x != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1919 |
set doesmatch 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1920 |
break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1921 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1922 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1923 |
if {$doesmatch} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1924 |
insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1925 |
set pi $nparents($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1926 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1927 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1928 |
set pi $nparents($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1929 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1930 |
if {[incr pi] >= $nparents($id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1931 |
set pi 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1932 |
if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1933 |
set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1934 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1935 |
if {$l == $findstartline} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1936 |
set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1937 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1938 |
set p [lindex $parents($id) $pi] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1939 |
set ids [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1940 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1941 |
stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1942 |
if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1943 |
bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1944 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1945 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1946 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1947 |
# mark a commit as matching by putting a yellow background |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1948 |
# behind the headline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1949 |
proc markheadline {l id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1950 |
global canv mainfont linehtag commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1951 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1952 |
set bbox [$canv bbox $linehtag($l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1953 |
set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1954 |
$canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1955 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1956 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1957 |
# mark the bits of a headline, author or date that match a find string |
267 | 1958 |
proc markmatches {canv l str tag matches font} { |
1959 |
set bbox [$canv bbox $tag] |
|
1960 |
set x0 [lindex $bbox 0] |
|
1961 |
set y0 [lindex $bbox 1] |
|
1962 |
set y1 [lindex $bbox 3] |
|
1963 |
foreach match $matches { |
|
1964 |
set start [lindex $match 0] |
|
1965 |
set end [lindex $match 1] |
|
1966 |
if {$start > $end} continue |
|
1967 |
set xoff [font measure $font [string range $str 0 [expr $start-1]]] |
|
1968 |
set xlen [font measure $font [string range $str 0 [expr $end]]] |
|
1969 |
set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ |
|
1970 |
-outline {} -tags matches -fill yellow] |
|
1971 |
$canv lower $t |
|
1972 |
} |
|
1973 |
} |
|
1974 |
||
1975 |
proc unmarkmatches {} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1976 |
global matchinglines findids |
267 | 1977 |
allcanvs delete matches |
1978 |
catch {unset matchinglines} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1979 |
catch {unset findids} |
267 | 1980 |
} |
1981 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1982 |
proc selcanvline {w x y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1983 |
global canv canvy0 ctext linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1984 |
global lineid linehtag linentag linedtag rowtextx |
267 | 1985 |
set ymax [lindex [$canv cget -scrollregion] 3] |
1986 |
if {$ymax == {}} return |
|
1987 |
set yfrac [lindex [$canv yview] 0] |
|
1988 |
set y [expr {$y + $yfrac * $ymax}] |
|
1989 |
set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] |
|
1990 |
if {$l < 0} { |
|
1991 |
set l 0 |
|
1992 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1993 |
if {$w eq $canv} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1994 |
if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1995 |
} |
267 | 1996 |
unmarkmatches |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1997 |
selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1998 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1999 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2000 |
proc commit_descriptor {p} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2001 |
global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2002 |
set l "..." |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2003 |
if {[info exists commitinfo($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2004 |
set l [lindex $commitinfo($p) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2005 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2006 |
return "$p ($l)" |
267 | 2007 |
} |
2008 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2009 |
# append some text to the ctext widget, and make any SHA1 ID |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2010 |
# that we know about be a clickable link. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2011 |
proc appendwithlinks {text} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2012 |
global ctext idline linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2013 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2014 |
set start [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2015 |
$ctext insert end $text |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2016 |
$ctext insert end "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2017 |
set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2018 |
foreach l $links { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2019 |
set s [lindex $l 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2020 |
set e [lindex $l 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2021 |
set linkid [string range $text $s $e] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2022 |
if {![info exists idline($linkid)]} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2023 |
incr e |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2024 |
$ctext tag add link "$start + $s c" "$start + $e c" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2025 |
$ctext tag add link$linknum "$start + $s c" "$start + $e c" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2026 |
$ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2027 |
incr linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2028 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2029 |
$ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2030 |
$ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2031 |
$ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2032 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2033 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2034 |
proc selectline {l isnew} { |
267 | 2035 |
global canv canv2 canv3 ctext commitinfo selectedline |
2036 |
global lineid linehtag linentag linedtag |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2037 |
global canvy0 linespc parents nparents children |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2038 |
global cflist currentid sha1entry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2039 |
global commentend idtags idline linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2040 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2041 |
$canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2042 |
normalline |
267 | 2043 |
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
2044 |
$canv delete secsel |
|
2045 |
set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ |
|
2046 |
-tags secsel -fill [$canv cget -selectbackground]] |
|
2047 |
$canv lower $t |
|
2048 |
$canv2 delete secsel |
|
2049 |
set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ |
|
2050 |
-tags secsel -fill [$canv2 cget -selectbackground]] |
|
2051 |
$canv2 lower $t |
|
2052 |
$canv3 delete secsel |
|
2053 |
set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ |
|
2054 |
-tags secsel -fill [$canv3 cget -selectbackground]] |
|
2055 |
$canv3 lower $t |
|
2056 |
set y [expr {$canvy0 + $l * $linespc}] |
|
2057 |
set ymax [lindex [$canv cget -scrollregion] 3] |
|
2058 |
set ytop [expr {$y - $linespc - 1}] |
|
2059 |
set ybot [expr {$y + $linespc + 1}] |
|
2060 |
set wnow [$canv yview] |
|
2061 |
set wtop [expr [lindex $wnow 0] * $ymax] |
|
2062 |
set wbot [expr [lindex $wnow 1] * $ymax] |
|
2063 |
set wh [expr {$wbot - $wtop}] |
|
2064 |
set newtop $wtop |
|
2065 |
if {$ytop < $wtop} { |
|
2066 |
if {$ybot < $wtop} { |
|
2067 |
set newtop [expr {$y - $wh / 2.0}] |
|
2068 |
} else { |
|
2069 |
set newtop $ytop |
|
2070 |
if {$newtop > $wtop - $linespc} { |
|
2071 |
set newtop [expr {$wtop - $linespc}] |
|
2072 |
} |
|
2073 |
} |
|
2074 |
} elseif {$ybot > $wbot} { |
|
2075 |
if {$ytop > $wbot} { |
|
2076 |
set newtop [expr {$y - $wh / 2.0}] |
|
2077 |
} else { |
|
2078 |
set newtop [expr {$ybot - $wh}] |
|
2079 |
if {$newtop < $wtop + $linespc} { |
|
2080 |
set newtop [expr {$wtop + $linespc}] |
|
2081 |
} |
|
2082 |
} |
|
2083 |
} |
|
2084 |
if {$newtop != $wtop} { |
|
2085 |
if {$newtop < 0} { |
|
2086 |
set newtop 0 |
|
2087 |
} |
|
2088 |
allcanvs yview moveto [expr $newtop * 1.0 / $ymax] |
|
2089 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2090 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2091 |
if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2092 |
addtohistory [list selectline $l 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2093 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2094 |
|
267 | 2095 |
set selectedline $l |
2096 |
||
2097 |
set id $lineid($l) |
|
2098 |
set currentid $id |
|
2099 |
$sha1entry delete 0 end |
|
2100 |
$sha1entry insert 0 $id |
|
2101 |
$sha1entry selection from 0 |
|
2102 |
$sha1entry selection to end |
|
2103 |
||
2104 |
$ctext conf -state normal |
|
2105 |
$ctext delete 0.0 end |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2106 |
set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2107 |
$ctext mark set fmark.0 0.0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2108 |
$ctext mark gravity fmark.0 left |
267 | 2109 |
set info $commitinfo($id) |
2110 |
$ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" |
|
2111 |
$ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" |
|
2112 |
if {[info exists idtags($id)]} { |
|
2113 |
$ctext insert end "Tags:" |
|
2114 |
foreach tag $idtags($id) { |
|
2115 |
$ctext insert end " $tag" |
|
2116 |
} |
|
2117 |
$ctext insert end "\n" |
|
2118 |
} |
|
1308
2073e5a71008
Cleanup of tabs and trailing spaces.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
1278
diff
changeset
|
2119 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2120 |
set comment {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2121 |
if {[info exists parents($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2122 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2123 |
append comment "Parent: [commit_descriptor $p]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2124 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2125 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2126 |
if {[info exists children($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2127 |
foreach c $children($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2128 |
append comment "Child: [commit_descriptor $c]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2129 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2130 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2131 |
append comment "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2132 |
append comment [lindex $info 5] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2133 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2134 |
# make anything that looks like a SHA1 ID be a clickable link |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2135 |
appendwithlinks $comment |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2136 |
|
267 | 2137 |
$ctext tag delete Comments |
2138 |
$ctext tag remove found 1.0 end |
|
2139 |
$ctext conf -state disabled |
|
2140 |
set commentend [$ctext index "end - 1c"] |
|
2141 |
||
2142 |
$cflist delete 0 end |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2143 |
$cflist insert end "Comments" |
267 | 2144 |
if {$nparents($id) == 1} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2145 |
startdiff [concat $id $parents($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2146 |
} elseif {$nparents($id) > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2147 |
mergediff $id |
267 | 2148 |
} |
2149 |
} |
|
2150 |
||
2151 |
proc selnextline {dir} { |
|
2152 |
global selectedline |
|
2153 |
if {![info exists selectedline]} return |
|
2154 |
set l [expr $selectedline + $dir] |
|
2155 |
unmarkmatches |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2156 |
selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2157 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2158 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2159 |
proc unselectline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2160 |
global selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2161 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2162 |
catch {unset selectedline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2163 |
allcanvs delete secsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2164 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2165 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2166 |
proc addtohistory {cmd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2167 |
global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2168 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2169 |
if {$historyindex > 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2170 |
&& [lindex $history [expr {$historyindex - 1}]] == $cmd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2171 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2172 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2173 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2174 |
if {$historyindex < [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2175 |
set history [lreplace $history $historyindex end $cmd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2176 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2177 |
lappend history $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2178 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2179 |
incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2180 |
if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2181 |
.ctop.top.bar.leftbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2182 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2183 |
.ctop.top.bar.leftbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2184 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2185 |
.ctop.top.bar.rightbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2186 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2187 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2188 |
proc goback {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2189 |
global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2190 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2191 |
if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2192 |
incr historyindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2193 |
set cmd [lindex $history [expr {$historyindex - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2194 |
eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2195 |
.ctop.top.bar.rightbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2196 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2197 |
if {$historyindex <= 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2198 |
.ctop.top.bar.leftbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2199 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2200 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2201 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2202 |
proc goforw {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2203 |
global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2204 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2205 |
if {$historyindex < [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2206 |
set cmd [lindex $history $historyindex] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2207 |
incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2208 |
eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2209 |
.ctop.top.bar.leftbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2210 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2211 |
if {$historyindex >= [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2212 |
.ctop.top.bar.rightbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2213 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2214 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2215 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2216 |
proc mergediff {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2217 |
global parents diffmergeid diffmergegca mergefilelist diffpindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2218 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2219 |
set diffmergeid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2220 |
set diffpindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2221 |
set diffmergegca [findgca $parents($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2222 |
if {[info exists mergefilelist($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2223 |
if {$mergefilelist($id) ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2224 |
showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2225 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2226 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2227 |
contmergediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2228 |
} |
267 | 2229 |
} |
2230 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2231 |
proc findgca {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2232 |
set gca {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2233 |
foreach id $ids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2234 |
if {$gca eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2235 |
set gca $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2236 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2237 |
if {[catch { |
1278 | 2238 |
set gca [exec hg debug-merge-base $gca $id] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2239 |
} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2240 |
return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2241 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2242 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2243 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2244 |
return $gca |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2245 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2246 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2247 |
proc contmergediff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2248 |
global diffmergeid diffpindex parents nparents diffmergegca |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2249 |
global treediffs mergefilelist diffids treepending |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2250 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2251 |
# diff the child against each of the parents, and diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2252 |
# each of the parents against the GCA. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2253 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2254 |
if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2255 |
set ids [list [lindex $ids 1] $diffmergegca] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2256 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2257 |
if {[incr diffpindex] >= $nparents($diffmergeid)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2258 |
set p [lindex $parents($diffmergeid) $diffpindex] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2259 |
set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2260 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2261 |
if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2262 |
set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2263 |
if {![info exists treepending]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2264 |
gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2265 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2266 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2267 |
} |
267 | 2268 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2269 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2270 |
# If a file in some parent is different from the child and also |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2271 |
# different from the GCA, then it's interesting. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2272 |
# If we don't have a GCA, then a file is interesting if it is |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2273 |
# different from the child in all the parents. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2274 |
if {$diffmergegca ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2275 |
set files {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2276 |
foreach p $parents($diffmergeid) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2277 |
set gcadiffs $treediffs([list $p $diffmergegca]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2278 |
foreach f $treediffs([list $diffmergeid $p]) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2279 |
if {[lsearch -exact $files $f] < 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2280 |
&& [lsearch -exact $gcadiffs $f] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2281 |
lappend files $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2282 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2283 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2284 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2285 |
set files [lsort $files] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2286 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2287 |
set p [lindex $parents($diffmergeid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2288 |
set files $treediffs([list $diffmergeid $p]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2289 |
for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2290 |
set p [lindex $parents($diffmergeid) $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2291 |
set df $treediffs([list $diffmergeid $p]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2292 |
set nf {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2293 |
foreach f $files { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2294 |
if {[lsearch -exact $df $f] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2295 |
lappend nf $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2296 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2297 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2298 |
set files $nf |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2299 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2300 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2301 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2302 |
set mergefilelist($diffmergeid) $files |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2303 |
if {$files ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2304 |
showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2305 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2306 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2307 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2308 |
proc showmergediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2309 |
global cflist diffmergeid mergefilelist parents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2310 |
global diffopts diffinhunk currentfile currenthunk filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2311 |
global diffblocked groupfilelast mergefds groupfilenum grouphunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2312 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2313 |
set files $mergefilelist($diffmergeid) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2314 |
foreach f $files { |
267 | 2315 |
$cflist insert end $f |
2316 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2317 |
set env(GIT_DIFF_OPTS) $diffopts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2318 |
set flist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2319 |
catch {unset currentfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2320 |
catch {unset currenthunk} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2321 |
catch {unset filelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2322 |
catch {unset groupfilenum} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2323 |
catch {unset grouphunks} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2324 |
set groupfilelast -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2325 |
foreach p $parents($diffmergeid) { |
1278 | 2326 |
set cmd [list | hg debug-diff-tree -p $p $diffmergeid] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2327 |
set cmd [concat $cmd $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2328 |
if {[catch {set f [open $cmd r]} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2329 |
error_popup "Error getting diffs: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2330 |
foreach f $flist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2331 |
catch {close $f} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2332 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2333 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2334 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2335 |
lappend flist $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2336 |
set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2337 |
set mergefds($ids) $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2338 |
set diffinhunk($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2339 |
set diffblocked($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2340 |
fconfigure $f -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2341 |
fileevent $f readable [list getmergediffline $f $ids $diffmergeid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2342 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2343 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2344 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2345 |
proc getmergediffline {f ids id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2346 |
global diffmergeid diffinhunk diffoldlines diffnewlines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2347 |
global currentfile currenthunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2348 |
global diffoldstart diffnewstart diffoldlno diffnewlno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2349 |
global diffblocked mergefilelist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2350 |
global noldlines nnewlines difflcounts filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2351 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2352 |
set n [gets $f line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2353 |
if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2354 |
if {![eof $f]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2355 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2356 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2357 |
if {!([info exists diffmergeid] && $diffmergeid == $id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2358 |
if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2359 |
close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2360 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2361 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2362 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2363 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2364 |
if {$diffinhunk($ids) != 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2365 |
set fi $currentfile($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2366 |
if {$n > 0 && [regexp {^[-+ \\]} $line match]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2367 |
# continuing an existing hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2368 |
set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2369 |
set p [lindex $ids 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2370 |
if {$match eq "-" || $match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2371 |
set filelines($p,$fi,$diffoldlno($ids)) $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2372 |
incr diffoldlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2373 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2374 |
if {$match eq "+" || $match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2375 |
set filelines($id,$fi,$diffnewlno($ids)) $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2376 |
incr diffnewlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2377 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2378 |
if {$match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2379 |
if {$diffinhunk($ids) == 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2380 |
lappend difflcounts($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2381 |
[list $noldlines($ids) $nnewlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2382 |
set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2383 |
set diffinhunk($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2384 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2385 |
incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2386 |
} elseif {$match eq "-" || $match eq "+"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2387 |
if {$diffinhunk($ids) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2388 |
lappend difflcounts($ids) [list $noldlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2389 |
set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2390 |
set nnewlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2391 |
set diffinhunk($ids) 2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2392 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2393 |
if {$match eq "-"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2394 |
incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2395 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2396 |
incr nnewlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2397 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2398 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2399 |
# and if it's \ No newline at end of line, then what? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2400 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2401 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2402 |
# end of a hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2403 |
if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2404 |
lappend difflcounts($ids) [list $noldlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2405 |
} elseif {$diffinhunk($ids) == 2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2406 |
&& ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2407 |
lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2408 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2409 |
set currenthunk($ids) [list $currentfile($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2410 |
$diffoldstart($ids) $diffnewstart($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2411 |
$diffoldlno($ids) $diffnewlno($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2412 |
$difflcounts($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2413 |
set diffinhunk($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2414 |
# -1 = need to block, 0 = unblocked, 1 = is blocked |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2415 |
set diffblocked($ids) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2416 |
processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2417 |
if {$diffblocked($ids) == -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2418 |
fileevent $f readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2419 |
set diffblocked($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2420 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2421 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2422 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2423 |
if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2424 |
# eof |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2425 |
if {!$diffblocked($ids)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2426 |
close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2427 |
set currentfile($ids) [llength $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2428 |
set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2429 |
processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2430 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2431 |
} elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2432 |
# start of a new file |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2433 |
set currentfile($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2434 |
[lsearch -exact $mergefilelist($diffmergeid) $fname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2435 |
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2436 |
$line match f1l f1c f2l f2c rest]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2437 |
if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2438 |
# start of a new hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2439 |
if {$f1l == 0 && $f1c == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2440 |
set f1l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2441 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2442 |
if {$f2l == 0 && $f2c == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2443 |
set f2l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2444 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2445 |
set diffinhunk($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2446 |
set diffoldstart($ids) $f1l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2447 |
set diffnewstart($ids) $f2l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2448 |
set diffoldlno($ids) $f1l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2449 |
set diffnewlno($ids) $f2l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2450 |
set difflcounts($ids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2451 |
set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2452 |
set nnewlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2453 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2454 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2455 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2456 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2457 |
proc processhunks {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2458 |
global diffmergeid parents nparents currenthunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2459 |
global mergefilelist diffblocked mergefds |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2460 |
global grouphunks grouplinestart grouplineend groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2461 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2462 |
set nfiles [llength $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2463 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2464 |
set fi $nfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2465 |
set lno 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2466 |
# look for the earliest hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2467 |
foreach p $parents($diffmergeid) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2468 |
set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2469 |
if {![info exists currenthunk($ids)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2470 |
set i [lindex $currenthunk($ids) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2471 |
set l [lindex $currenthunk($ids) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2472 |
if {$i < $fi || ($i == $fi && $l < $lno)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2473 |
set fi $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2474 |
set lno $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2475 |
set pi $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2476 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2477 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2478 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2479 |
if {$fi < $nfiles} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2480 |
set ids [list $diffmergeid $pi] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2481 |
set hunk $currenthunk($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2482 |
unset currenthunk($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2483 |
if {$diffblocked($ids) > 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2484 |
fileevent $mergefds($ids) readable \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2485 |
[list getmergediffline $mergefds($ids) $ids $diffmergeid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2486 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2487 |
set diffblocked($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2488 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2489 |
if {[info exists groupfilenum] && $groupfilenum == $fi |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2490 |
&& $lno <= $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2491 |
# add this hunk to the pending group |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2492 |
lappend grouphunks($pi) $hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2493 |
set endln [lindex $hunk 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2494 |
if {$endln > $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2495 |
set grouplineend $endln |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2496 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2497 |
continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2498 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2499 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2500 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2501 |
# succeeding stuff doesn't belong in this group, so |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2502 |
# process the group now |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2503 |
if {[info exists groupfilenum]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2504 |
processgroup |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2505 |
unset groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2506 |
unset grouphunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2507 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2508 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2509 |
if {$fi >= $nfiles} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2510 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2511 |
# start a new group |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2512 |
set groupfilenum $fi |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2513 |
set grouphunks($pi) [list $hunk] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2514 |
set grouplinestart $lno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2515 |
set grouplineend [lindex $hunk 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2516 |
} |
267 | 2517 |
} |
2518 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2519 |
proc processgroup {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2520 |
global groupfilelast groupfilenum difffilestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2521 |
global mergefilelist diffmergeid ctext filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2522 |
global parents diffmergeid diffoffset |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2523 |
global grouphunks grouplinestart grouplineend nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2524 |
global mergemax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2525 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2526 |
$ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2527 |
set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2528 |
set f $groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2529 |
if {$groupfilelast != $f} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2530 |
$ctext insert end "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2531 |
set here [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2532 |
set difffilestart($f) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2533 |
set mark fmark.[expr {$f + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2534 |
$ctext mark set $mark $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2535 |
$ctext mark gravity $mark left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2536 |
set header [lindex $mergefilelist($id) $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2537 |
set l [expr {(78 - [string length $header]) / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2538 |
set pad [string range "----------------------------------------" 1 $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2539 |
$ctext insert end "$pad $header $pad\n" filesep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2540 |
set groupfilelast $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2541 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2542 |
set diffoffset($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2543 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2544 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2545 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2546 |
$ctext insert end "@@" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2547 |
set nlines [expr {$grouplineend - $grouplinestart}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2548 |
set events {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2549 |
set pnum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2550 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2551 |
set startline [expr {$grouplinestart + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2552 |
set ol $startline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2553 |
set nl $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2554 |
if {[info exists grouphunks($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2555 |
foreach h $grouphunks($p) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2556 |
set l [lindex $h 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2557 |
if {$nl < $l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2558 |
for {} {$nl < $l} {incr nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2559 |
set filelines($p,$f,$ol) $filelines($id,$f,$nl) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2560 |
incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2561 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2562 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2563 |
foreach chunk [lindex $h 5] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2564 |
if {[llength $chunk] == 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2565 |
set olc [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2566 |
set nlc [lindex $chunk 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2567 |
set nnl [expr {$nl + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2568 |
lappend events [list $nl $nnl $pnum $olc $nlc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2569 |
incr ol $olc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2570 |
set nl $nnl |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2571 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2572 |
incr ol [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2573 |
incr nl [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2574 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2575 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2576 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2577 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2578 |
if {$nl < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2579 |
for {} {$nl < $grouplineend} {incr nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2580 |
set filelines($p,$f,$ol) $filelines($id,$f,$nl) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2581 |
incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2582 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2583 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2584 |
set nlines [expr {$ol - $startline}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2585 |
$ctext insert end " -$startline,$nlines" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2586 |
incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2587 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2588 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2589 |
set nlines [expr {$grouplineend - $grouplinestart}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2590 |
$ctext insert end " +$grouplinestart,$nlines @@\n" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2591 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2592 |
set events [lsort -integer -index 0 $events] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2593 |
set nevents [llength $events] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2594 |
set nmerge $nparents($diffmergeid) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2595 |
set l $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2596 |
for {set i 0} {$i < $nevents} {set i $j} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2597 |
set nl [lindex $events $i 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2598 |
while {$l < $nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2599 |
$ctext insert end " $filelines($id,$f,$l)\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2600 |
incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2601 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2602 |
set e [lindex $events $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2603 |
set enl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2604 |
set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2605 |
set active {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2606 |
while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2607 |
set pnum [lindex $e 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2608 |
set olc [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2609 |
set nlc [lindex $e 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2610 |
if {![info exists delta($pnum)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2611 |
set delta($pnum) [expr {$olc - $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2612 |
lappend active $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2613 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2614 |
incr delta($pnum) [expr {$olc - $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2615 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2616 |
if {[incr j] >= $nevents} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2617 |
set e [lindex $events $j] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2618 |
if {[lindex $e 0] >= $enl} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2619 |
if {[lindex $e 1] > $enl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2620 |
set enl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2621 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2622 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2623 |
set nlc [expr {$enl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2624 |
set ncol mresult |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2625 |
set bestpn -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2626 |
if {[llength $active] == $nmerge - 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2627 |
# no diff for one of the parents, i.e. it's identical |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2628 |
for {set pnum 0} {$pnum < $nmerge} {incr pnum} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2629 |
if {![info exists delta($pnum)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2630 |
if {$pnum < $mergemax} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2631 |
lappend ncol m$pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2632 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2633 |
lappend ncol mmax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2634 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2635 |
break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2636 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2637 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2638 |
} elseif {[llength $active] == $nmerge} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2639 |
# all parents are different, see if one is very similar |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2640 |
set bestsim 30 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2641 |
for {set pnum 0} {$pnum < $nmerge} {incr pnum} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2642 |
set sim [similarity $pnum $l $nlc $f \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2643 |
[lrange $events $i [expr {$j-1}]]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2644 |
if {$sim > $bestsim} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2645 |
set bestsim $sim |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2646 |
set bestpn $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2647 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2648 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2649 |
if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2650 |
lappend ncol m$bestpn |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2651 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2652 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2653 |
set pnum -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2654 |
foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2655 |
incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2656 |
if {![info exists delta($pnum)] || $pnum == $bestpn} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2657 |
set olc [expr {$nlc + $delta($pnum)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2658 |
set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2659 |
incr diffoffset($p) $delta($pnum) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2660 |
unset delta($pnum) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2661 |
for {} {$olc > 0} {incr olc -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2662 |
$ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2663 |
incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2664 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2665 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2666 |
set endl [expr {$l + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2667 |
if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2668 |
# show this pretty much as a normal diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2669 |
set p [lindex $parents($id) $bestpn] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2670 |
set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2671 |
incr diffoffset($p) $delta($bestpn) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2672 |
unset delta($bestpn) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2673 |
for {set k $i} {$k < $j} {incr k} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2674 |
set e [lindex $events $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2675 |
if {[lindex $e 2] != $bestpn} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2676 |
set nl [lindex $e 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2677 |
set ol [expr {$ol + $nl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2678 |
for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2679 |
$ctext insert end "+$filelines($id,$f,$l)\n" $ncol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2680 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2681 |
set c [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2682 |
for {} {$c > 0} {incr c -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2683 |
$ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2684 |
incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2685 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2686 |
set nl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2687 |
for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2688 |
$ctext insert end "+$filelines($id,$f,$l)\n" mresult |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2689 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2690 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2691 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2692 |
for {} {$l < $endl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2693 |
$ctext insert end "+$filelines($id,$f,$l)\n" $ncol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2694 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2695 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2696 |
while {$l < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2697 |
$ctext insert end " $filelines($id,$f,$l)\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2698 |
incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2699 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2700 |
$ctext conf -state disabled |
267 | 2701 |
} |
2702 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2703 |
proc similarity {pnum l nlc f events} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2704 |
global diffmergeid parents diffoffset filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2705 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2706 |
set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2707 |
set p [lindex $parents($id) $pnum] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2708 |
set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2709 |
set endl [expr {$l + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2710 |
set same 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2711 |
set diff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2712 |
foreach e $events { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2713 |
if {[lindex $e 2] != $pnum} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2714 |
set nl [lindex $e 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2715 |
set ol [expr {$ol + $nl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2716 |
for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2717 |
incr same [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2718 |
incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2719 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2720 |
set oc [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2721 |
for {} {$oc > 0} {incr oc -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2722 |
incr diff [string length $filelines($p,$f,$ol)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2723 |
incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2724 |
incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2725 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2726 |
set nl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2727 |
for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2728 |
incr diff [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2729 |
incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2730 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2731 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2732 |
for {} {$l < $endl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2733 |
incr same [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2734 |
incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2735 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2736 |
if {$same == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2737 |
return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2738 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2739 |
return [expr {200 * $same / (2 * $same + $diff)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2740 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2741 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2742 |
proc startdiff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2743 |
global treediffs diffids treepending diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2744 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2745 |
set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2746 |
catch {unset diffmergeid} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2747 |
if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2748 |
if {![info exists treepending]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2749 |
gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2750 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2751 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2752 |
addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2753 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2754 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2755 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2756 |
proc addtocflist {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2757 |
global treediffs cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2758 |
foreach f $treediffs($ids) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2759 |
$cflist insert end $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2760 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2761 |
getblobdiffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2762 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2763 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2764 |
proc gettreediffs {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2765 |
global treediff parents treepending |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2766 |
set treepending $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2767 |
set treediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2768 |
set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2769 |
set p [lindex $ids 1] |
1278 | 2770 |
if [catch {set gdtf [open "|hg debug-diff-tree -r $p $id" r]}] return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2771 |
fconfigure $gdtf -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2772 |
fileevent $gdtf readable [list gettreediffline $gdtf $ids] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2773 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2774 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2775 |
proc gettreediffline {gdtf ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2776 |
global treediff treediffs treepending diffids diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2777 |
|
267 | 2778 |
set n [gets $gdtf line] |
2779 |
if {$n < 0} { |
|
2780 |
if {![eof $gdtf]} return |
|
2781 |
close $gdtf |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2782 |
set treediffs($ids) $treediff |
267 | 2783 |
unset treepending |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2784 |
if {$ids != $diffids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2785 |
gettreediffs $diffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2786 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2787 |
if {[info exists diffmergeid]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2788 |
contmergediff $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2789 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2790 |
addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2791 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2792 |
} |
267 | 2793 |
return |
2794 |
} |
|
2795 |
set file [lindex $line 5] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2796 |
lappend treediff $file |
267 | 2797 |
} |
2798 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2799 |
proc getblobdiffs {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2800 |
global diffopts blobdifffd diffids env curdifftag curtagstart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2801 |
global difffilestart nextupdate diffinhdr treediffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2802 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2803 |
set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2804 |
set p [lindex $ids 1] |
267 | 2805 |
set env(GIT_DIFF_OPTS) $diffopts |
1278 | 2806 |
set cmd [list | hg debug-diff-tree -r -p -C $p $id] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2807 |
if {[catch {set bdf [open $cmd r]} err]} { |
267 | 2808 |
puts "error getting diffs: $err" |
2809 |
return |
|
2810 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2811 |
set diffinhdr 0 |
267 | 2812 |
fconfigure $bdf -blocking 0 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2813 |
set blobdifffd($ids) $bdf |
267 | 2814 |
set curdifftag Comments |
2815 |
set curtagstart 0.0 |
|
2816 |
catch {unset difffilestart} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2817 |
fileevent $bdf readable [list getblobdiffline $bdf $diffids] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2818 |
set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
267 | 2819 |
} |
2820 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2821 |
proc getblobdiffline {bdf ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2822 |
global diffids blobdifffd ctext curdifftag curtagstart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2823 |
global diffnexthead diffnextnote difffilestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2824 |
global nextupdate diffinhdr treediffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2825 |
global gaudydiff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2826 |
|
267 | 2827 |
set n [gets $bdf line] |
2828 |
if {$n < 0} { |
|
2829 |
if {[eof $bdf]} { |
|
2830 |
close $bdf |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2831 |
if {$ids == $diffids && $bdf == $blobdifffd($ids)} { |
267 | 2832 |
$ctext tag add $curdifftag $curtagstart end |
2833 |
} |
|
2834 |
} |
|
2835 |
return |
|
2836 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2837 |
if {$ids != $diffids || $bdf != $blobdifffd($ids)} { |
267 | 2838 |
return |
2839 |
} |
|
2840 |
$ctext conf -state normal |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2841 |
if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { |
267 | 2842 |
# start of a new file |
2843 |
$ctext insert end "\n" |
|
2844 |
$ctext tag add $curdifftag $curtagstart end |
|
2845 |
set curtagstart [$ctext index "end - 1c"] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2846 |
set header $newname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2847 |
set here [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2848 |
set i [lsearch -exact $treediffs($diffids) $fname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2849 |
if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2850 |
set difffilestart($i) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2851 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2852 |
$ctext mark set fmark.$i $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2853 |
$ctext mark gravity fmark.$i left |
267 | 2854 |
} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2855 |
if {$newname != $fname} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2856 |
set i [lsearch -exact $treediffs($diffids) $newname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2857 |
if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2858 |
set difffilestart($i) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2859 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2860 |
$ctext mark set fmark.$i $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2861 |
$ctext mark gravity fmark.$i left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2862 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2863 |
} |
267 | 2864 |
set curdifftag "f:$fname" |
2865 |
$ctext tag delete $curdifftag |
|
2866 |
set l [expr {(78 - [string length $header]) / 2}] |
|
2867 |
set pad [string range "----------------------------------------" 1 $l] |
|
2868 |
$ctext insert end "$pad $header $pad\n" filesep |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2869 |
set diffinhdr 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2870 |
} elseif {[regexp {^(---|\+\+\+)} $line]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2871 |
set diffinhdr 0 |
267 | 2872 |
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
2873 |
$line match f1l f1c f2l f2c rest]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2874 |
if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2875 |
$ctext insert end "\t" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2876 |
$ctext insert end " $f1l " d0 " $f2l " d1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2877 |
$ctext insert end " $rest \n" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2878 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2879 |
$ctext insert end "$line\n" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2880 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2881 |
set diffinhdr 0 |
267 | 2882 |
} else { |
2883 |
set x [string range $line 0 0] |
|
2884 |
if {$x == "-" || $x == "+"} { |
|
2885 |
set tag [expr {$x == "+"}] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2886 |
if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2887 |
set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2888 |
} |
267 | 2889 |
$ctext insert end "$line\n" d$tag |
2890 |
} elseif {$x == " "} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2891 |
if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2892 |
set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2893 |
} |
267 | 2894 |
$ctext insert end "$line\n" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2895 |
} elseif {$diffinhdr || $x == "\\"} { |
267 | 2896 |
# e.g. "\ No newline at end of file" |
2897 |
$ctext insert end "$line\n" filesep |
|
2898 |
} else { |
|
2899 |
# Something else we don't recognize |
|
2900 |
if {$curdifftag != "Comments"} { |
|
2901 |
$ctext insert end "\n" |
|
2902 |
$ctext tag add $curdifftag $curtagstart end |
|
2903 |
set curtagstart [$ctext index "end - 1c"] |
|
2904 |
set curdifftag Comments |
|
2905 |
} |
|
2906 |
$ctext insert end "$line\n" filesep |
|
2907 |
} |
|
2908 |
} |
|
2909 |
$ctext conf -state disabled |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2910 |
if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2911 |
incr nextupdate 100 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2912 |
fileevent $bdf readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2913 |
update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2914 |
fileevent $bdf readable "getblobdiffline $bdf {$ids}" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2915 |
} |
267 | 2916 |
} |
2917 |
||
2918 |
proc nextfile {} { |
|
2919 |
global difffilestart ctext |
|
2920 |
set here [$ctext index @0,0] |
|
2921 |
for {set i 0} {[info exists difffilestart($i)]} {incr i} { |
|
2922 |
if {[$ctext compare $difffilestart($i) > $here]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2923 |
if {![info exists pos] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2924 |
|| [$ctext compare $difffilestart($i) < $pos]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2925 |
set pos $difffilestart($i) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2926 |
} |
267 | 2927 |
} |
2928 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2929 |
if {[info exists pos]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2930 |
$ctext yview $pos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2931 |
} |
267 | 2932 |
} |
2933 |
||
2934 |
proc listboxsel {} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2935 |
global ctext cflist currentid |
267 | 2936 |
if {![info exists currentid]} return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2937 |
set sel [lsort [$cflist curselection]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2938 |
if {$sel eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2939 |
set first [lindex $sel 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2940 |
catch {$ctext yview fmark.$first} |
267 | 2941 |
} |
2942 |
||
2943 |
proc setcoords {} { |
|
2944 |
global linespc charspc canvx0 canvy0 mainfont |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2945 |
global xspc1 xspc2 lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2946 |
|
267 | 2947 |
set linespc [font metrics $mainfont -linespace] |
2948 |
set charspc [font measure $mainfont "m"] |
|
2949 |
set canvy0 [expr 3 + 0.5 * $linespc] |
|
2950 |
set canvx0 [expr 3 + 0.5 * $linespc] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2951 |
set lthickness [expr {int($linespc / 9) + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2952 |
set xspc1(0) $linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2953 |
set xspc2 $linespc |
267 | 2954 |
} |
2955 |
||
2956 |
proc redisplay {} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2957 |
global stopped redisplaying phase |
267 | 2958 |
if {$stopped > 1} return |
2959 |
if {$phase == "getcommits"} return |
|
2960 |
set redisplaying 1 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2961 |
if {$phase == "drawgraph" || $phase == "incrdraw"} { |
267 | 2962 |
set stopped 1 |
2963 |
} else { |
|
2964 |
drawgraph |
|
2965 |
} |
|
2966 |
} |
|
2967 |
||
2968 |
proc incrfont {inc} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2969 |
global mainfont namefont textfont ctext canv phase |
267 | 2970 |
global stopped entries |
2971 |
unmarkmatches |
|
2972 |
set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] |
|
2973 |
set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] |
|
2974 |
set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] |
|
2975 |
setcoords |
|
2976 |
$ctext conf -font $textfont |
|
2977 |
$ctext tag conf filesep -font [concat $textfont bold] |
|
2978 |
foreach e $entries { |
|
2979 |
$e conf -font $mainfont |
|
2980 |
} |
|
2981 |
if {$phase == "getcommits"} { |
|
2982 |
$canv itemconf textitems -font $mainfont |
|
2983 |
} |
|
2984 |
redisplay |
|
2985 |
} |
|
2986 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2987 |
proc clearsha1 {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2988 |
global sha1entry sha1string |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2989 |
if {[string length $sha1string] == 40} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2990 |
$sha1entry delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2991 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2992 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2993 |
|
267 | 2994 |
proc sha1change {n1 n2 op} { |
2995 |
global sha1string currentid sha1but |
|
2996 |
if {$sha1string == {} |
|
2997 |
|| ([info exists currentid] && $sha1string == $currentid)} { |
|
2998 |
set state disabled |
|
2999 |
} else { |
|
3000 |
set state normal |
|
3001 |
} |
|
3002 |
if {[$sha1but cget -state] == $state} return |
|
3003 |
if {$state == "normal"} { |
|
3004 |
$sha1but conf -state normal -relief raised -text "Goto: " |
|
3005 |
} else { |
|
3006 |
$sha1but conf -state disabled -relief flat -text "SHA1 ID: " |
|
3007 |
} |
|
3008 |
} |
|
3009 |
||
3010 |
proc gotocommit {} { |
|
3011 |
global sha1string currentid idline tagids |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3012 |
global lineid numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3013 |
|
267 | 3014 |
if {$sha1string == {} |
3015 |
|| ([info exists currentid] && $sha1string == $currentid)} return |
|
3016 |
if {[info exists tagids($sha1string)]} { |
|
3017 |
set id $tagids($sha1string) |
|
3018 |
} else { |
|
3019 |
set id [string tolower $sha1string] |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3020 |
if {[regexp {^[0-9a-f]{4,39}$} $id]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3021 |
set matches {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3022 |
for {set l 0} {$l < $numcommits} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3023 |
if {[string match $id* $lineid($l)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3024 |
lappend matches $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3025 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3026 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3027 |
if {$matches ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3028 |
if {[llength $matches] > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3029 |
error_popup "Short SHA1 id $id is ambiguous" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3030 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3031 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3032 |
set id [lindex $matches 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3033 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3034 |
} |
267 | 3035 |
} |
3036 |
if {[info exists idline($id)]} { |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3037 |
selectline $idline($id) 1 |
267 | 3038 |
return |
3039 |
} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3040 |
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { |
267 | 3041 |
set type "SHA1 id" |
3042 |
} else { |
|
3043 |
set type "Tag" |
|
3044 |
} |
|
3045 |
error_popup "$type $sha1string is not known" |
|
3046 |
} |
|
3047 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3048 |
proc lineenter {x y id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3049 |
global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3050 |
global commitinfo canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3051 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3052 |
if {![info exists commitinfo($id)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3053 |
set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3054 |
set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3055 |
set hoverid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3056 |
if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3057 |
after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3058 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3059 |
set hovertimer [after 500 linehover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3060 |
$canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3061 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3062 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3063 |
proc linemotion {x y id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3064 |
global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3065 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3066 |
if {[info exists hoverid] && $id == $hoverid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3067 |
set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3068 |
set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3069 |
if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3070 |
after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3071 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3072 |
set hovertimer [after 500 linehover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3073 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3074 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3075 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3076 |
proc lineleave {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3077 |
global hoverid hovertimer canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3078 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3079 |
if {[info exists hoverid] && $id == $hoverid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3080 |
$canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3081 |
if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3082 |
after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3083 |
unset hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3084 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3085 |
unset hoverid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3086 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3087 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3088 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3089 |
proc linehover {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3090 |
global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3091 |
global canv linespc lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3092 |
global commitinfo mainfont |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3093 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3094 |
set text [lindex $commitinfo($hoverid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3095 |
set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3096 |
if {$ymax == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3097 |
set yfrac [lindex [$canv yview] 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3098 |
set x [expr {$hoverx + 2 * $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3099 |
set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3100 |
set x0 [expr {$x - 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3101 |
set y0 [expr {$y - 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3102 |
set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3103 |
set y1 [expr {$y + $linespc + 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3104 |
set t [$canv create rectangle $x0 $y0 $x1 $y1 \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3105 |
-fill \#ffff80 -outline black -width 1 -tags hover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3106 |
$canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3107 |
set t [$canv create text $x $y -anchor nw -text $text -tags hover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3108 |
$canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3109 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3110 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3111 |
proc clickisonarrow {id y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3112 |
global mainline mainlinearrow sidelines lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3113 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3114 |
set thresh [expr {2 * $lthickness + 6}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3115 |
if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3116 |
if {$mainlinearrow($id) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3117 |
if {abs([lindex $mainline($id) 1] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3118 |
return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3119 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3120 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3121 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3122 |
if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3123 |
foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3124 |
set coords [lindex $ls 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3125 |
set arrow [lindex $ls 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3126 |
if {$arrow eq "first" || $arrow eq "both"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3127 |
if {abs([lindex $coords 1] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3128 |
return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3129 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3130 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3131 |
if {$arrow eq "last" || $arrow eq "both"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3132 |
if {abs([lindex $coords end] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3133 |
return "down" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3134 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3135 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3136 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3137 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3138 |
return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3139 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3140 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3141 |
proc arrowjump {id dirn y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3142 |
global mainline sidelines canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3143 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3144 |
set yt {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3145 |
if {$dirn eq "down"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3146 |
if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3147 |
set y1 [lindex $mainline($id) 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3148 |
if {$y1 > $y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3149 |
set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3150 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3151 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3152 |
if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3153 |
foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3154 |
set y1 [lindex $ls 0 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3155 |
if {$y1 > $y && ($yt eq {} || $y1 < $yt)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3156 |
set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3157 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3158 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3159 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3160 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3161 |
if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3162 |
foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3163 |
set y1 [lindex $ls 0 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3164 |
if {$y1 < $y && ($yt eq {} || $y1 > $yt)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3165 |
set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3166 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3167 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3168 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3169 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3170 |
if {$yt eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3171 |
set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3172 |
if {$ymax eq {} || $ymax <= 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3173 |
set view [$canv yview] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3174 |
set yspan [expr {[lindex $view 1] - [lindex $view 0]}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3175 |
set yfrac [expr {$yt / $ymax - $yspan / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3176 |
if {$yfrac < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3177 |
set yfrac 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3178 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3179 |
$canv yview moveto $yfrac |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3180 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3181 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3182 |
proc lineclick {x y id isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3183 |
global ctext commitinfo children cflist canv thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3184 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3185 |
unmarkmatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3186 |
unselectline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3187 |
normalline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3188 |
$canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3189 |
# draw this line thicker than normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3190 |
drawlines $id 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3191 |
set thickerline $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3192 |
if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3193 |
set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3194 |
if {$ymax eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3195 |
set yfrac [lindex [$canv yview] 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3196 |
set y [expr {$y + $yfrac * $ymax}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3197 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3198 |
set dirn [clickisonarrow $id $y] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3199 |
if {$dirn ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3200 |
arrowjump $id $dirn $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3201 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3202 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3203 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3204 |
if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3205 |
addtohistory [list lineclick $x $y $id 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3206 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3207 |
# fill the details pane with info about this line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3208 |
$ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3209 |
$ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3210 |
$ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3211 |
$ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3212 |
$ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3213 |
$ctext insert end "Parent:\t" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3214 |
$ctext insert end $id [list link link0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3215 |
$ctext tag bind link0 <1> [list selbyid $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3216 |
set info $commitinfo($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3217 |
$ctext insert end "\n\t[lindex $info 0]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3218 |
$ctext insert end "\tAuthor:\t[lindex $info 1]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3219 |
$ctext insert end "\tDate:\t[lindex $info 2]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3220 |
if {[info exists children($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3221 |
$ctext insert end "\nChildren:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3222 |
set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3223 |
foreach child $children($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3224 |
incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3225 |
set info $commitinfo($child) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3226 |
$ctext insert end "\n\t" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3227 |
$ctext insert end $child [list link link$i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3228 |
$ctext tag bind link$i <1> [list selbyid $child] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3229 |
$ctext insert end "\n\t[lindex $info 0]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3230 |
$ctext insert end "\n\tAuthor:\t[lindex $info 1]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3231 |
$ctext insert end "\n\tDate:\t[lindex $info 2]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3232 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3233 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3234 |
$ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3235 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3236 |
$cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3237 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3238 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3239 |
proc normalline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3240 |
global thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3241 |
if {[info exists thickerline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3242 |
drawlines $thickerline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3243 |
unset thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3244 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3245 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3246 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3247 |
proc selbyid {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3248 |
global idline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3249 |
if {[info exists idline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3250 |
selectline $idline($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3251 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3252 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3253 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3254 |
proc mstime {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3255 |
global startmstime |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3256 |
if {![info exists startmstime]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3257 |
set startmstime [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3258 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3259 |
return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3260 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3261 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3262 |
proc rowmenu {x y id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3263 |
global rowctxmenu idline selectedline rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3264 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3265 |
if {![info exists selectedline] || $idline($id) eq $selectedline} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3266 |
set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3267 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3268 |
set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3269 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3270 |
$rowctxmenu entryconfigure 0 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3271 |
$rowctxmenu entryconfigure 1 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3272 |
$rowctxmenu entryconfigure 2 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3273 |
set rowmenuid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3274 |
tk_popup $rowctxmenu $x $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3275 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3276 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3277 |
proc diffvssel {dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3278 |
global rowmenuid selectedline lineid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3279 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3280 |
if {![info exists selectedline]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3281 |
if {$dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3282 |
set oldid $lineid($selectedline) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3283 |
set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3284 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3285 |
set oldid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3286 |
set newid $lineid($selectedline) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3287 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3288 |
addtohistory [list doseldiff $oldid $newid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3289 |
doseldiff $oldid $newid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3290 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3291 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3292 |
proc doseldiff {oldid newid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3293 |
global ctext cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3294 |
global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3295 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3296 |
$ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3297 |
$ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3298 |
$ctext mark set fmark.0 0.0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3299 |
$ctext mark gravity fmark.0 left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3300 |
$cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3301 |
$cflist insert end "Top" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3302 |
$ctext insert end "From " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3303 |
$ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3304 |
$ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3305 |
$ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3306 |
$ctext tag bind link0 <1> [list selbyid $oldid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3307 |
$ctext insert end $oldid [list link link0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3308 |
$ctext insert end "\n " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3309 |
$ctext insert end [lindex $commitinfo($oldid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3310 |
$ctext insert end "\n\nTo " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3311 |
$ctext tag bind link1 <1> [list selbyid $newid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3312 |
$ctext insert end $newid [list link link1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3313 |
$ctext insert end "\n " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3314 |
$ctext insert end [lindex $commitinfo($newid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3315 |
$ctext insert end "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3316 |
$ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3317 |
$ctext tag delete Comments |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3318 |
$ctext tag remove found 1.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3319 |
startdiff [list $newid $oldid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3320 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3321 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3322 |
proc mkpatch {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3323 |
global rowmenuid currentid commitinfo patchtop patchnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3324 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3325 |
if {![info exists currentid]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3326 |
set oldid $currentid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3327 |
set oldhead [lindex $commitinfo($oldid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3328 |
set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3329 |
set newhead [lindex $commitinfo($newid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3330 |
set top .patch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3331 |
set patchtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3332 |
catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3333 |
toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3334 |
label $top.title -text "Generate patch" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3335 |
grid $top.title - -pady 10 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3336 |
label $top.from -text "From:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3337 |
entry $top.fromsha1 -width 40 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3338 |
$top.fromsha1 insert 0 $oldid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3339 |
$top.fromsha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3340 |
grid $top.from $top.fromsha1 -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3341 |
entry $top.fromhead -width 60 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3342 |
$top.fromhead insert 0 $oldhead |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3343 |
$top.fromhead conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3344 |
grid x $top.fromhead -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3345 |
label $top.to -text "To:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3346 |
entry $top.tosha1 -width 40 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3347 |
$top.tosha1 insert 0 $newid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3348 |
$top.tosha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3349 |
grid $top.to $top.tosha1 -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3350 |
entry $top.tohead -width 60 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3351 |
$top.tohead insert 0 $newhead |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3352 |
$top.tohead conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3353 |
grid x $top.tohead -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3354 |
button $top.rev -text "Reverse" -command mkpatchrev -padx 5 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3355 |
grid $top.rev x -pady 10 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3356 |
label $top.flab -text "Output file:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3357 |
entry $top.fname -width 60 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3358 |
$top.fname insert 0 [file normalize "patch$patchnum.patch"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3359 |
incr patchnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3360 |
grid $top.flab $top.fname -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3361 |
frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3362 |
button $top.buts.gen -text "Generate" -command mkpatchgo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3363 |
button $top.buts.can -text "Cancel" -command mkpatchcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3364 |
grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3365 |
grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3366 |
grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3367 |
grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3368 |
focus $top.fname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3369 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3370 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3371 |
proc mkpatchrev {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3372 |
global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3373 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3374 |
set oldid [$patchtop.fromsha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3375 |
set oldhead [$patchtop.fromhead get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3376 |
set newid [$patchtop.tosha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3377 |
set newhead [$patchtop.tohead get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3378 |
foreach e [list fromsha1 fromhead tosha1 tohead] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3379 |
v [list $newid $newhead $oldid $oldhead] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3380 |
$patchtop.$e conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3381 |
$patchtop.$e delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3382 |
$patchtop.$e insert 0 $v |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3383 |
$patchtop.$e conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3384 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3385 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3386 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3387 |
proc mkpatchgo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3388 |
global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3389 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3390 |
set oldid [$patchtop.fromsha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3391 |
set newid [$patchtop.tosha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3392 |
set fname [$patchtop.fname get] |
1278 | 3393 |
if {[catch {exec hg debug-diff-tree -p $oldid $newid >$fname &} err]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3394 |
error_popup "Error creating patch: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3395 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3396 |
catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3397 |
unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3398 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3399 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3400 |
proc mkpatchcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3401 |
global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3402 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3403 |
catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3404 |
unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3405 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3406 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3407 |
proc mktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3408 |
global rowmenuid mktagtop commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3409 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3410 |
set top .maketag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3411 |
set mktagtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3412 |
catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3413 |
toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3414 |
label $top.title -text "Create tag" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3415 |
grid $top.title - -pady 10 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3416 |
label $top.id -text "ID:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3417 |
entry $top.sha1 -width 40 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3418 |
$top.sha1 insert 0 $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3419 |
$top.sha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3420 |
grid $top.id $top.sha1 -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3421 |
entry $top.head -width 60 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3422 |
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3423 |
$top.head conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3424 |
grid x $top.head -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3425 |
label $top.tlab -text "Tag name:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3426 |
entry $top.tag -width 60 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3427 |
grid $top.tlab $top.tag -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3428 |
frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3429 |
button $top.buts.gen -text "Create" -command mktaggo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3430 |
button $top.buts.can -text "Cancel" -command mktagcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3431 |
grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3432 |
grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3433 |
grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3434 |
grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3435 |
focus $top.tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3436 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3437 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3438 |
proc domktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3439 |
global mktagtop env tagids idtags |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3440 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3441 |
set id [$mktagtop.sha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3442 |
set tag [$mktagtop.tag get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3443 |
if {$tag == {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3444 |
error_popup "No tag name specified" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3445 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3446 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3447 |
if {[info exists tagids($tag)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3448 |
error_popup "Tag \"$tag\" already exists" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3449 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3450 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3451 |
if {[catch { |
2058
7e0dd64b0718
Use the new format of setting tags in view extension (Debian bug #361897)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
1430
diff
changeset
|
3452 |
set out [exec hg tag -r $id $tag] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3453 |
} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3454 |
error_popup "Error creating tag: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3455 |
return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3456 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3457 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3458 |
set tagids($tag) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3459 |
lappend idtags($id) $tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3460 |
redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3461 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3462 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3463 |
proc redrawtags {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3464 |
global canv linehtag idline idpos selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3465 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3466 |
if {![info exists idline($id)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3467 |
$canv delete tag.$id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3468 |
set xt [eval drawtags $id $idpos($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3469 |
$canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3470 |
if {[info exists selectedline] && $selectedline == $idline($id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3471 |
selectline $selectedline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3472 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3473 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3474 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3475 |
proc mktagcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3476 |
global mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3477 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3478 |
catch {destroy $mktagtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3479 |
unset mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3480 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3481 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3482 |
proc mktaggo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3483 |
domktag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3484 |
mktagcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3485 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3486 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3487 |
proc writecommit {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3488 |
global rowmenuid wrcomtop commitinfo wrcomcmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3489 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3490 |
set top .writecommit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3491 |
set wrcomtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3492 |
catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3493 |
toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3494 |
label $top.title -text "Write commit to file" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3495 |
grid $top.title - -pady 10 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3496 |
label $top.id -text "ID:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3497 |
entry $top.sha1 -width 40 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3498 |
$top.sha1 insert 0 $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3499 |
$top.sha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3500 |
grid $top.id $top.sha1 -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3501 |
entry $top.head -width 60 -relief flat |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3502 |
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3503 |
$top.head conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3504 |
grid x $top.head -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3505 |
label $top.clab -text "Command:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3506 |
entry $top.cmd -width 60 -textvariable wrcomcmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3507 |
grid $top.clab $top.cmd -sticky w -pady 10 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3508 |
label $top.flab -text "Output file:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3509 |
entry $top.fname -width 60 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3510 |
$top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3511 |
grid $top.flab $top.fname -sticky w |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3512 |
frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3513 |
button $top.buts.gen -text "Write" -command wrcomgo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3514 |
button $top.buts.can -text "Cancel" -command wrcomcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3515 |
grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3516 |
grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3517 |
grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3518 |
grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3519 |
focus $top.fname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3520 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3521 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3522 |
proc wrcomgo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3523 |
global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3524 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3525 |
set id [$wrcomtop.sha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3526 |
set cmd "echo $id | [$wrcomtop.cmd get]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3527 |
set fname [$wrcomtop.fname get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3528 |
if {[catch {exec sh -c $cmd >$fname &} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3529 |
error_popup "Error writing commit: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3530 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3531 |
catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3532 |
unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3533 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3534 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3535 |
proc wrcomcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3536 |
global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3537 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3538 |
catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3539 |
unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3540 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3541 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3542 |
proc listrefs {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3543 |
global idtags idheads idotherrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3544 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3545 |
set x {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3546 |
if {[info exists idtags($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3547 |
set x $idtags($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3548 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3549 |
set y {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3550 |
if {[info exists idheads($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3551 |
set y $idheads($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3552 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3553 |
set z {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3554 |
if {[info exists idotherrefs($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3555 |
set z $idotherrefs($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3556 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3557 |
return [list $x $y $z] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3558 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3559 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3560 |
proc rereadrefs {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3561 |
global idtags idheads idotherrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3562 |
global tagids headids otherrefids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3563 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3564 |
set refids [concat [array names idtags] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3565 |
[array names idheads] [array names idotherrefs]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3566 |
foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3567 |
if {![info exists ref($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3568 |
set ref($id) [listrefs $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3569 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3570 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3571 |
foreach v {tagids idtags headids idheads otherrefids idotherrefs} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3572 |
catch {unset $v} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3573 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3574 |
readrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3575 |
set refids [lsort -unique [concat $refids [array names idtags] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3576 |
[array names idheads] [array names idotherrefs]]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3577 |
foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3578 |
set v [listrefs $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3579 |
if {![info exists ref($id)] || $ref($id) != $v} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3580 |
redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3581 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3582 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3583 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3584 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3585 |
proc showtag {tag isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3586 |
global ctext cflist tagcontents tagids linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3587 |
|
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3588 |
if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3589 |
addtohistory [list showtag $tag 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3590 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3591 |
$ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3592 |
$ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3593 |
set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3594 |
if {[info exists tagcontents($tag)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3595 |
set text $tagcontents($tag) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3596 |
} else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3597 |
set text "Tag: $tag\nId: $tagids($tag)" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3598 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3599 |
appendwithlinks $text |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3600 |
$ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3601 |
$cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3602 |
} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3603 |
|
267 | 3604 |
proc doquit {} { |
3605 |
global stopped |
|
3606 |
set stopped 100 |
|
3607 |
destroy . |
|
3608 |
} |
|
3609 |
||
3610 |
# defaults... |
|
3611 |
set datemode 0 |
|
3612 |
set boldnames 0 |
|
3613 |
set diffopts "-U 5 -p" |
|
1278 | 3614 |
set wrcomcmd "hg debug-diff-tree --stdin -p --pretty" |
267 | 3615 |
|
3616 |
set mainfont {Helvetica 9} |
|
3617 |
set textfont {Courier 9} |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3618 |
set findmergefiles 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3619 |
set gaudydiff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3620 |
set maxgraphpct 50 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3621 |
set maxwidth 16 |
267 | 3622 |
|
3623 |
set colors {green red blue magenta darkgrey brown orange} |
|
3624 |
||
3625 |
catch {source ~/.gitk} |
|
3626 |
||
3627 |
set namefont $mainfont |
|
3628 |
if {$boldnames} { |
|
3629 |
lappend namefont bold |
|
3630 |
} |
|
3631 |
||
3632 |
set revtreeargs {} |
|
3633 |
foreach arg $argv { |
|
3634 |
switch -regexp -- $arg { |
|
3635 |
"^$" { } |
|
3636 |
"^-b" { set boldnames 1 } |
|
3637 |
"^-d" { set datemode 1 } |
|
3638 |
default { |
|
3639 |
lappend revtreeargs $arg |
|
3640 |
} |
|
3641 |
} |
|
3642 |
} |
|
3643 |
||
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3644 |
set history {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3645 |
set historyindex 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3646 |
|
267 | 3647 |
set stopped 0 |
3648 |
set redisplaying 0 |
|
3649 |
set stuffsaved 0 |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3650 |
set patchnum 0 |
267 | 3651 |
setcoords |
3652 |
makewindow |
|
3653 |
readrefs |
|
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3654 |
getcommits $revtreeargs |