Mercurial > hg > mercurial-crew-with-dirclash
annotate contrib/hgk @ 2129:e5f5c21f4169
cached data was wrong: rev is different from self.rev(node) in bundlerepo.py
author | Benoit Boissinot <benoit.boissinot@ens-lyon.org> |
---|---|
date | Tue, 25 Apr 2006 23:28:40 +0200 |
parents | 7e0dd64b0718 |
children | 936b615eb44e |
rev | line source |
---|---|
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} { | |
199 if {$line == {}} { | |
200 set inhdr 0 | |
201 } else { | |
202 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
|
203 if {$tag == "author"} { |
267 | 204 set x [expr {[llength $line] - 2}] |
205 set audate [lindex $line $x] | |
206 set auname [lrange $line 1 [expr {$x - 1}]] | |
207 } elseif {$tag == "committer"} { | |
208 set x [expr {[llength $line] - 2}] | |
209 set comdate [lindex $line $x] | |
210 set comname [lrange $line 1 [expr {$x - 1}]] | |
211 } | |
212 } | |
213 } else { | |
214 if {$comment == {}} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
215 set headline [string trim $line] |
267 | 216 } else { |
217 append comment "\n" | |
218 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
219 if {!$listed} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
220 # 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
|
221 # 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
|
222 append comment " " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
223 } |
267 | 224 append comment $line |
225 } | |
226 } | |
227 if {$audate != {}} { | |
228 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] | |
229 } | |
230 if {$comdate != {}} { | |
231 set cdate($id) $comdate | |
232 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] | |
233 } | |
234 set commitinfo($id) [list $headline $auname $audate \ | |
235 $comname $comdate $comment] | |
236 } | |
237 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
238 proc readrefs {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
239 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
|
240 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
241 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
|
242 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
|
243 foreach f $lines { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
244 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
|
245 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
|
246 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
|
247 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
|
248 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
|
249 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
|
250 lappend idtags($tag) $direct |
267 | 251 } |
252 } | |
253 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
254 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
|
255 global otherrefids idotherrefs |
267 | 256 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
257 set git [gitdir] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
258 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
|
259 foreach f $files { |
267 | 260 catch { |
261 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
|
262 set line [read $fd 40] |
267 | 263 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
|
264 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
|
265 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
|
266 lappend idotherrefs($id) $name |
267 | 267 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
268 close $fd |
267 | 269 } |
270 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
271 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
|
272 foreach d $dirs { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
273 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
|
274 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
|
275 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
|
276 } |
267 | 277 } |
278 | |
279 proc error_popup msg { | |
280 set w .error | |
281 toplevel $w | |
282 wm transient $w . | |
283 message $w.m -text $msg -justify center -aspect 400 | |
284 pack $w.m -side top -fill x -padx 20 -pady 20 | |
285 button $w.ok -text OK -command "destroy $w" | |
286 pack $w.ok -side bottom -fill x | |
287 bind $w <Visibility> "grab $w; focus $w" | |
288 tkwait window $w | |
289 } | |
290 | |
291 proc makewindow {} { | |
292 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
|
293 global findtype findtypemenu findloc findstring fstring geometry |
267 | 294 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
|
295 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
|
296 global rowctxmenu gaudydiff mergemax |
267 | 297 |
298 menu .bar | |
299 .bar add cascade -label "File" -menu .bar.file | |
300 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
|
301 .bar.file add command -label "Reread references" -command rereadrefs |
267 | 302 .bar.file add command -label "Quit" -command doquit |
303 menu .bar.help | |
304 .bar add cascade -label "Help" -menu .bar.help | |
305 .bar.help add command -label "About gitk" -command about | |
306 . configure -menu .bar | |
307 | |
308 if {![info exists geometry(canv1)]} { | |
309 set geometry(canv1) [expr 45 * $charspc] | |
310 set geometry(canv2) [expr 30 * $charspc] | |
311 set geometry(canv3) [expr 15 * $charspc] | |
312 set geometry(canvh) [expr 25 * $linespc + 4] | |
313 set geometry(ctextw) 80 | |
314 set geometry(ctexth) 30 | |
315 set geometry(cflistw) 30 | |
316 } | |
317 panedwindow .ctop -orient vertical | |
318 if {[info exists geometry(width)]} { | |
319 .ctop conf -width $geometry(width) -height $geometry(height) | |
320 set texth [expr {$geometry(height) - $geometry(canvh) - 56}] | |
321 set geometry(ctexth) [expr {($texth - 8) / | |
322 [font metrics $textfont -linespace]}] | |
323 } | |
324 frame .ctop.top | |
325 frame .ctop.top.bar | |
326 pack .ctop.top.bar -side bottom -fill x | |
327 set cscroll .ctop.top.csb | |
328 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 | |
329 pack $cscroll -side right -fill y | |
330 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 | |
331 pack .ctop.top.clist -side top -fill both -expand 1 | |
332 .ctop add .ctop.top | |
333 set canv .ctop.top.clist.canv | |
334 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ | |
335 -bg white -bd 0 \ | |
336 -yscrollincr $linespc -yscrollcommand "$cscroll set" | |
337 .ctop.top.clist add $canv | |
338 set canv2 .ctop.top.clist.canv2 | |
339 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ | |
340 -bg white -bd 0 -yscrollincr $linespc | |
341 .ctop.top.clist add $canv2 | |
342 set canv3 .ctop.top.clist.canv3 | |
343 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ | |
344 -bg white -bd 0 -yscrollincr $linespc | |
345 .ctop.top.clist add $canv3 | |
346 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} | |
347 | |
348 set sha1entry .ctop.top.bar.sha1 | |
349 set entries $sha1entry | |
350 set sha1but .ctop.top.bar.sha1label | |
351 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ | |
352 -command gotocommit -width 8 | |
353 $sha1but conf -disabledforeground [$sha1but cget -foreground] | |
354 pack .ctop.top.bar.sha1label -side left | |
355 entry $sha1entry -width 40 -font $textfont -textvariable sha1string | |
356 trace add variable sha1string write sha1change | |
357 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
|
358 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
359 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
|
360 #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
|
361 #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
|
362 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
|
363 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
|
364 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
|
365 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
|
366 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
367 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
|
368 #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
|
369 #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
|
370 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
|
371 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
|
372 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
|
373 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
|
374 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
375 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
|
376 -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
|
377 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
|
378 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
|
379 -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
|
380 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
|
381 |
267 | 382 button .ctop.top.bar.findbut -text "Find" -command dofind |
383 pack .ctop.top.bar.findbut -side left | |
384 set findstring {} | |
385 set fstring .ctop.top.bar.findstring | |
386 lappend entries $fstring | |
387 entry $fstring -width 30 -font $textfont -textvariable findstring | |
388 pack $fstring -side left -expand 1 -fill x | |
389 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
|
390 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
|
391 findtype Exact IgnCase Regexp] |
267 | 392 set findloc "All fields" |
393 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
|
394 Comments Author Committer Files Pickaxe |
267 | 395 pack .ctop.top.bar.findloc -side right |
396 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
|
397 # 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
|
398 trace add variable findloc write findlocchange |
267 | 399 |
400 panedwindow .ctop.cdet -orient horizontal | |
401 .ctop add .ctop.cdet | |
402 frame .ctop.cdet.left | |
403 set ctext .ctop.cdet.left.ctext | |
404 text $ctext -bg white -state disabled -font $textfont \ | |
405 -width $geometry(ctextw) -height $geometry(ctexth) \ | |
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
406 -yscrollcommand ".ctop.cdet.left.sb set" \ |
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
407 -xscrollcommand ".ctop.cdet.left.hb set" -wrap none |
267 | 408 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
|
409 scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview" |
267 | 410 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
|
411 pack .ctop.cdet.left.hb -side bottom -fill x |
267 | 412 pack $ctext -side left -fill both -expand 1 |
413 .ctop.cdet add .ctop.cdet.left | |
414 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
415 $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
|
416 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
417 $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
|
418 $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
|
419 $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
|
420 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
421 $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
|
422 $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
|
423 $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
|
424 $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
|
425 $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
|
426 $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
|
427 $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
|
428 $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
|
429 $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
|
430 set mergemax 5 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
431 $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
|
432 $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
|
433 $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
|
434 } |
267 | 435 |
436 frame .ctop.cdet.right | |
437 set cflist .ctop.cdet.right.cfiles | |
438 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ | |
439 -yscrollcommand ".ctop.cdet.right.sb set" | |
440 scrollbar .ctop.cdet.right.sb -command "$cflist yview" | |
441 pack .ctop.cdet.right.sb -side right -fill y | |
442 pack $cflist -side left -fill both -expand 1 | |
443 .ctop.cdet add .ctop.cdet.right | |
444 bind .ctop.cdet <Configure> {resizecdetpanes %W %w} | |
445 | |
446 pack .ctop -side top -fill both -expand 1 | |
447 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
448 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
|
449 #bindall <B1-Motion> {selcanvline %W %x %y} |
267 | 450 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
451 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
452 bindall <2> "allcanvs scan mark 0 %y" | |
453 bindall <B2-Motion> "allcanvs scan dragto 0 %y" | |
454 bind . <Key-Up> "selnextline -1" | |
455 bind . <Key-Down> "selnextline 1" | |
456 bind . <Key-Prior> "allcanvs yview scroll -1 pages" | |
457 bind . <Key-Next> "allcanvs yview scroll 1 pages" | |
458 bindkey <Key-Delete> "$ctext yview scroll -1 pages" | |
459 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |
460 bindkey <Key-space> "$ctext yview scroll 1 pages" | |
461 bindkey p "selnextline -1" | |
462 bindkey n "selnextline 1" | |
463 bindkey b "$ctext yview scroll -1 pages" | |
464 bindkey d "$ctext yview scroll 18 units" | |
465 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
|
466 bindkey / {findnext 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
467 bindkey <Key-Return> {findnext 0} |
267 | 468 bindkey ? findprev |
469 bindkey f nextfile | |
470 bind . <Control-q> doquit | |
1429
45bd7925dceb
Add control-w key binding to quit hgk.
Eric Bloodworth <ergosys@gmail.com>
parents:
1361
diff
changeset
|
471 bind . <Control-w> doquit |
267 | 472 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
|
473 bind . <Control-g> {findnext 0} |
267 | 474 bind . <Control-r> findprev |
475 bind . <Control-equal> {incrfont 1} | |
476 bind . <Control-KP_Add> {incrfont 1} | |
477 bind . <Control-minus> {incrfont -1} | |
478 bind . <Control-KP_Subtract> {incrfont -1} | |
479 bind $cflist <<ListboxSelect>> listboxsel | |
480 bind . <Destroy> {savestuff %W} | |
481 bind . <Button-1> "click %W" | |
482 bind $fstring <Key-Return> dofind | |
483 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
|
484 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
|
485 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
486 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
|
487 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
|
488 set curtextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
489 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
490 set rowctxmenu .rowctxmenu |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
491 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
|
492 $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
|
493 -command {diffvssel 0} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
494 $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
|
495 -command {diffvssel 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
496 $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
|
497 $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
|
498 $rowctxmenu add command -label "Write commit to file" -command writecommit |
267 | 499 } |
500 | |
501 # when we make a key binding for the toplevel, make sure | |
502 # it doesn't get triggered when that key is pressed in the | |
503 # find string entry widget. | |
504 proc bindkey {ev script} { | |
505 global entries | |
506 bind . $ev $script | |
507 set escript [bind Entry $ev] | |
508 if {$escript == {}} { | |
509 set escript [bind Entry <Key>] | |
510 } | |
511 foreach e $entries { | |
512 bind $e $ev "$escript; break" | |
513 } | |
514 } | |
515 | |
516 # set the focus back to the toplevel for any click outside | |
517 # the entry widgets | |
518 proc click {w} { | |
519 global entries | |
520 foreach e $entries { | |
521 if {$w == $e} return | |
522 } | |
523 focus . | |
524 } | |
525 | |
526 proc savestuff {w} { | |
527 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
|
528 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
|
529 global maxwidth |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
530 |
267 | 531 if {$stuffsaved} return |
532 if {![winfo viewable .]} return | |
533 catch { | |
534 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
|
535 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
|
536 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
|
537 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
|
538 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
|
539 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
|
540 puts $f [list set maxwidth $maxwidth] |
267 | 541 puts $f "set geometry(width) [winfo width .ctop]" |
542 puts $f "set geometry(height) [winfo height .ctop]" | |
543 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" | |
544 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" | |
545 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" | |
546 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" | |
547 set wid [expr {([winfo width $ctext] - 8) \ | |
548 / [font measure $textfont "0"]}] | |
549 puts $f "set geometry(ctextw) $wid" | |
550 set wid [expr {([winfo width $cflist] - 11) \ | |
551 / [font measure [$cflist cget -font] "0"]}] | |
552 puts $f "set geometry(cflistw) $wid" | |
553 close $f | |
554 file rename -force "~/.gitk-new" "~/.gitk" | |
555 } | |
556 set stuffsaved 1 | |
557 } | |
558 | |
559 proc resizeclistpanes {win w} { | |
560 global oldwidth | |
561 if [info exists oldwidth($win)] { | |
562 set s0 [$win sash coord 0] | |
563 set s1 [$win sash coord 1] | |
564 if {$w < 60} { | |
565 set sash0 [expr {int($w/2 - 2)}] | |
566 set sash1 [expr {int($w*5/6 - 2)}] | |
567 } else { | |
568 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
569 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
570 set sash1 [expr {int($factor * [lindex $s1 0])}] | |
571 if {$sash0 < 30} { | |
572 set sash0 30 | |
573 } | |
574 if {$sash1 < $sash0 + 20} { | |
575 set sash1 [expr $sash0 + 20] | |
576 } | |
577 if {$sash1 > $w - 10} { | |
578 set sash1 [expr $w - 10] | |
579 if {$sash0 > $sash1 - 20} { | |
580 set sash0 [expr $sash1 - 20] | |
581 } | |
582 } | |
583 } | |
584 $win sash place 0 $sash0 [lindex $s0 1] | |
585 $win sash place 1 $sash1 [lindex $s1 1] | |
586 } | |
587 set oldwidth($win) $w | |
588 } | |
589 | |
590 proc resizecdetpanes {win w} { | |
591 global oldwidth | |
592 if [info exists oldwidth($win)] { | |
593 set s0 [$win sash coord 0] | |
594 if {$w < 60} { | |
595 set sash0 [expr {int($w*3/4 - 2)}] | |
596 } else { | |
597 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
598 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
599 if {$sash0 < 45} { | |
600 set sash0 45 | |
601 } | |
602 if {$sash0 > $w - 15} { | |
603 set sash0 [expr $w - 15] | |
604 } | |
605 } | |
606 $win sash place 0 $sash0 [lindex $s0 1] | |
607 } | |
608 set oldwidth($win) $w | |
609 } | |
610 | |
611 proc allcanvs args { | |
612 global canv canv2 canv3 | |
613 eval $canv $args | |
614 eval $canv2 $args | |
615 eval $canv3 $args | |
616 } | |
617 | |
618 proc bindall {event action} { | |
619 global canv canv2 canv3 | |
620 bind $canv $event $action | |
621 bind $canv2 $event $action | |
622 bind $canv3 $event $action | |
623 } | |
624 | |
625 proc about {} { | |
626 set w .about | |
627 if {[winfo exists $w]} { | |
628 raise $w | |
629 return | |
630 } | |
631 toplevel $w | |
632 wm title $w "About gitk" | |
633 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
|
634 Gitk version 1.2 |
267 | 635 |
636 Copyright © 2005 Paul Mackerras | |
637 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
638 Use and redistribute under the terms of the GNU General Public License} \ |
267 | 639 -justify center -aspect 400 |
640 pack $w.m -side top -fill x -padx 20 -pady 20 | |
641 button $w.ok -text Close -command "destroy $w" | |
642 pack $w.ok -side bottom | |
643 } | |
644 | |
645 proc assigncolor {id} { | |
646 global commitinfo colormap commcolors colors nextcolor | |
647 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
|
648 global cornercrossings crossings |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
649 |
267 | 650 if [info exists colormap($id)] return |
651 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
|
652 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
|
653 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
|
654 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
|
655 && $nparents($child) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
656 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
|
657 return |
267 | 658 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
659 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
660 set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
661 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
|
662 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
|
663 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
|
664 && [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
|
665 lappend badcolors $colormap($x) |
267 | 666 } |
667 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
668 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
|
669 set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
670 } |
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 set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
673 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
|
674 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
|
675 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
|
676 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
|
677 && [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
|
678 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
|
679 } |
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 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
|
682 set badcolors $origbad |
267 | 683 } |
684 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
685 set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
686 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
687 if {[llength $badcolors] < $ncolors - 1} { |
267 | 688 foreach child $children($id) { |
689 if {[info exists colormap($child)] | |
690 && [lsearch -exact $badcolors $colormap($child)] < 0} { | |
691 lappend badcolors $colormap($child) | |
692 } | |
693 if {[info exists parents($child)]} { | |
694 foreach p $parents($child) { | |
695 if {[info exists colormap($p)] | |
696 && [lsearch -exact $badcolors $colormap($p)] < 0} { | |
697 lappend badcolors $colormap($p) | |
698 } | |
699 } | |
700 } | |
701 } | |
702 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
|
703 set badcolors $origbad |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
704 } |
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 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
|
707 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
|
708 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
|
709 set nextcolor 0 |
267 | 710 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
711 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
|
712 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
713 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
|
714 } |
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 proc initgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
717 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
|
718 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
|
719 global nchildren ncleft |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
720 global displist nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
721 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
722 allcanvs delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
723 set nextcolor 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
724 set canvy $canvy0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
725 set lineno -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
726 set numcommits 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
727 catch {unset mainline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
728 catch {unset mainlinearrow} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
729 catch {unset sidelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
730 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
|
731 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
|
732 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
733 set displist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
734 set nhyperspace 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
735 } |
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 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
|
738 global canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
739 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
740 $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
|
741 $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
|
742 $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
|
743 $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
|
744 } |
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 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
|
747 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
|
748 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
749 $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
|
750 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
|
751 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
|
752 -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
|
753 -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
|
754 -arrow $mainlinearrow($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
755 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
756 bindline $t $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
757 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
758 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
|
759 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
|
760 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
|
761 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
|
762 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
|
763 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
|
764 -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
|
765 -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
|
766 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
767 bindline $t $id |
267 | 768 } |
769 } | |
770 } | |
771 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
772 # 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
|
773 proc drawcommitline {level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
774 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
|
775 global canv canv2 canv3 mainfont namefont canvy linespc |
267 | 776 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
|
777 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
|
778 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
|
779 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
|
780 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
|
781 global oldnlines olddlevel olddisplist |
267 | 782 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
783 incr numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
784 incr lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
785 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
|
786 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
|
787 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
|
788 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
|
789 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
|
790 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
|
791 readcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
792 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
|
793 set commitinfo($id) {"No commit information available"} |
267 | 794 set nparents($id) 0 |
795 } | |
796 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
797 assigncolor $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
798 set currentparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
799 set dupparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
800 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
|
801 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
|
802 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
|
803 lappend currentparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
804 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
805 # 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
|
806 lappend dupparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
807 } |
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 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
|
811 set y1 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
812 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
|
813 allcanvs conf -scrollregion \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
814 [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
|
815 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
|
816 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
|
817 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
|
818 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
|
819 } |
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 drawlines $id 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
822 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
|
823 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
|
824 [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
|
825 -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
|
826 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
827 $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
|
828 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
|
829 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
|
830 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
|
831 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
832 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
|
833 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
|
834 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
|
835 || [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
|
836 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
|
837 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
838 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
|
839 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
|
840 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
|
841 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
|
842 -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
|
843 $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
|
844 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
|
845 -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
|
846 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
|
847 -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
|
848 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
849 set olddlevel $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
850 set olddisplist $displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
851 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
|
852 } |
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 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
|
855 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
|
856 global linespc lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
857 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
|
858 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
859 set marks {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
860 set ntags 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
861 set nheads 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
862 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
|
863 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
|
864 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
|
865 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
866 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
|
867 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
|
868 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
|
869 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
870 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
|
871 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
|
872 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
873 if {$marks eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
874 return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
875 } |
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 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
|
878 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
|
879 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
|
880 set xvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
881 set wvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
882 foreach tag $marks { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
883 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
|
884 lappend xvals $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
885 lappend wvals $wid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
886 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
|
887 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
888 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
|
889 -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
|
890 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
891 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
|
892 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
|
893 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
|
894 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
|
895 # draw a tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
896 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
|
897 $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
|
898 -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
|
899 $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
|
900 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
|
901 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
902 # 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
|
903 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
|
904 set col green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
905 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
906 set col "#ddddff" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
907 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
908 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
|
909 $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
|
910 -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
|
911 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
912 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
|
913 -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
|
914 if {$ntags >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
915 $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
|
916 } |
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 return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
919 } |
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 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
|
922 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
|
923 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
924 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
|
925 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
|
926 if {$p == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
927 if {$i == $corner} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
928 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
|
929 || [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
|
930 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
|
931 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
932 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
|
933 || [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
|
934 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
|
935 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
936 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
937 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
|
938 || [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
|
939 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
|
940 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
941 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
|
942 || [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
|
943 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
|
944 } |
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 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
|
950 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
|
951 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
952 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
|
953 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
|
954 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
|
955 } elseif {$i > $level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
956 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
|
957 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
958 return $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
959 } |
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 # 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
|
962 proc trimdiagend {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
963 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
|
964 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
|
965 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
|
966 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
|
967 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
|
968 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
|
969 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
|
970 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
971 return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
972 } |
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 proc trimdiagstart {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
975 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
|
976 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
|
977 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
|
978 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
|
979 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
|
980 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
|
981 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
|
982 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
983 return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
984 } |
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 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
|
987 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
|
988 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
|
989 global currentparents dupparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
990 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
|
991 global maxgraphpct maxwidth |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
992 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
|
993 global parents commitlisted |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
994 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
|
995 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
|
996 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
997 if {$lineno < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
998 lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
999 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
|
1000 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1001 } |
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 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
|
1004 set y2 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1005 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1006 # 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
|
1007 set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1008 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
|
1009 # 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
|
1010 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
|
1011 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1012 # 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
|
1013 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1014 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
|
1015 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
|
1016 } |
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 # 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
|
1019 if {$needonscreen ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1020 lappend reins $needonscreen |
267 | 1021 } |
1022 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1023 # try the shortcut |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1024 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
|
1025 set dlevel $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1026 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
|
1027 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
|
1028 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
|
1029 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
|
1030 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
|
1031 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
|
1032 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
|
1033 return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1034 } |
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 # update displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1037 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
|
1038 set j $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1039 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1040 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
|
1041 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
|
1042 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
|
1043 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
|
1044 incr j |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1045 } |
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 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
|
1048 lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1049 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
|
1050 } |
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 # 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
|
1053 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
|
1054 if {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1055 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
|
1056 } |
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 # 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
|
1059 # 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
|
1060 foreach pi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1061 # 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
|
1062 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
|
1063 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
|
1064 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
|
1065 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
|
1066 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
|
1067 incr nhyperspace -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1068 } |
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 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
|
1072 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1073 # 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
|
1074 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
|
1075 if {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1076 set ages {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1077 foreach x $displist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1078 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
|
1079 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1080 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
|
1081 set k 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1082 while {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1083 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
|
1084 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
|
1085 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
|
1086 incr k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1087 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
|
1088 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
|
1089 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
|
1090 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
|
1091 incr nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1092 incr displ -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1093 if {$i < $nullentry} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1094 incr nullentry -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1095 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1096 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
|
1097 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
|
1098 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
|
1099 set arrow "last" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1100 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
|
1101 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
|
1102 set arrow "both" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1103 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1104 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
|
1105 unset mainline($victim) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1106 } |
267 | 1107 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1108 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1109 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
|
1110 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1111 # 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
|
1112 if {$displ < $oldnlines} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1113 # 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
|
1114 # 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
|
1115 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
|
1116 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
|
1117 } 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
|
1118 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1119 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
|
1120 incr i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1121 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1122 } elseif {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1123 set i $nullentry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1124 while {$i < $displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1125 && [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
|
1126 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1127 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1128 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1129 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1130 if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1131 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1132 } |
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 if {$i < $displ} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1135 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
|
1136 incr displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1137 if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1138 incr dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1139 } |
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 # 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
|
1144 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
|
1145 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
|
1146 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
|
1147 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
|
1148 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1149 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
|
1150 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
|
1151 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
|
1152 } |
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 foreach idi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1156 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
|
1157 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
|
1158 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
|
1159 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
|
1160 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
|
1161 } |
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 set i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1164 foreach id $olddisplist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1165 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1166 if {$id == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1167 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
|
1168 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
|
1169 if {$i == $olddlevel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1170 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1171 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
|
1172 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
|
1173 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
|
1174 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
|
1175 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
|
1176 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
|
1177 } 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
|
1178 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
|
1179 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
|
1180 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1181 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
|
1182 # 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
|
1183 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
|
1184 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
|
1185 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
|
1186 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
|
1187 set mainlinearrow($p) none |
267 | 1188 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1189 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1190 # 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
|
1191 set yb $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1192 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
|
1193 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
|
1194 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
|
1195 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1196 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
|
1197 if {$xi != $xj} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1198 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
|
1199 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1200 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
|
1201 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
|
1202 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1203 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
|
1204 if {$yb < $y2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1205 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
|
1206 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1207 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
|
1208 } |
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 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1212 set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1213 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
|
1214 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
|
1215 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1216 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
|
1217 || ($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
|
1218 || ($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
|
1219 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
|
1220 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
|
1221 } |
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 return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1225 } |
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 # 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
|
1228 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
|
1229 set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1230 foreach l $llist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1231 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
|
1232 return $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1233 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1234 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1235 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1236 return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1237 } |
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 proc drawmore {reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1240 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
|
1241 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
|
1242 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
|
1243 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1244 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
|
1245 while {$numcommits < $n} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1246 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
|
1247 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
|
1248 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
|
1249 set ctxend $n |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1250 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1251 set dlist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1252 if {$numcommits > 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1253 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
|
1254 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1255 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1256 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
|
1257 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
|
1258 incr i |
267 | 1259 } |
1260 } | |
1261 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1262 set nohs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1263 set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1264 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
|
1265 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
|
1266 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
|
1267 # 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
|
1268 # 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
|
1269 set room 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1270 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
|
1271 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
|
1272 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
|
1273 if {$i < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1274 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
|
1275 lappend dlist $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1276 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1277 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
|
1278 lappend nohs $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1279 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1280 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
|
1281 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
|
1282 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1283 set newp {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1284 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
|
1285 set right 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1286 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
|
1287 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
|
1288 lappend newp $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1289 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
|
1290 lappend nohs $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1291 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1292 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
|
1293 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
|
1294 } |
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 set right 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1297 } |
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 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
|
1300 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
|
1301 set l $newp |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1302 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1303 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
|
1304 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
|
1305 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1306 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
|
1307 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
|
1308 set room 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1309 } |
267 | 1310 } |
1311 } | |
1312 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1313 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
|
1314 drawcommitline $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1315 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
|
1316 && $numcommits >= $ncmupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1317 doupdate $reading |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1318 if {$stopped} break |
267 | 1319 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1320 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1321 } |
267 | 1322 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1323 # 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
|
1324 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
|
1325 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
|
1326 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
|
1327 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1328 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
|
1329 set olds {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1330 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
|
1331 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
|
1332 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
|
1333 lappend olds $p |
267 | 1334 } |
1335 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1336 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1337 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
|
1338 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
|
1339 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
|
1340 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
|
1341 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
|
1342 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
|
1343 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
|
1344 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1345 } |
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 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
|
1349 set i $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1350 set n 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1351 foreach p $olds { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1352 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
|
1353 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
|
1354 if {$k < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1355 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
|
1356 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
|
1357 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1358 incr n |
267 | 1359 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1360 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1361 set nnewparents($id) $n |
267 | 1362 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1363 return 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1364 } |
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 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
|
1367 global ncleft todo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1368 global datemode cdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1369 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1370 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1371 # 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
|
1372 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
|
1373 set level -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1374 set latest {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1375 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
|
1376 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
|
1377 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
|
1378 if {$datemode} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1379 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
|
1380 if {$noread} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1381 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1382 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1383 readcommit $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1384 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1385 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
|
1386 set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1387 set latest $cdate($p) |
267 | 1388 } |
1389 } else { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1390 set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1391 break |
267 | 1392 } |
1393 } | |
1394 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1395 if {$level < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1396 if {$todo != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1397 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
|
1398 foreach p $todo { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1399 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
|
1400 } |
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 return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1403 } |
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 return $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1406 } |
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 proc drawcommit {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1409 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
|
1410 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
|
1411 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1412 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1413 set 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 displayorder {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1415 set todo {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1416 initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1417 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1418 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
|
1419 lappend todo $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1420 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
|
1421 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1422 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
|
1423 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
|
1424 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1425 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1426 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1427 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
|
1428 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
|
1429 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
|
1430 if {$level == {}} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1431 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1432 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
|
1433 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
|
1434 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1435 } |
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 drawmore 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1438 } |
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 proc finishcommits {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1441 global phase |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1442 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
|
1443 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1444 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1445 $canv delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1446 $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
|
1447 -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
|
1448 set phase {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1449 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1450 drawrest |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1451 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1452 . config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1453 settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1454 } |
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 # 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
|
1457 # 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
|
1458 proc settextcursor {c} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1459 global ctext curtextcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1460 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1461 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
|
1462 $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
|
1463 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1464 set curtextcursor $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1465 } |
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 proc drawgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1468 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
|
1469 global displayorder onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1470 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1471 if {$displayorder == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1472 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
|
1473 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
|
1474 set ncmupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1475 initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1476 foreach id $displayorder { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1477 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
|
1478 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1479 drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1480 } |
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 proc drawrest {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1483 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
|
1484 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
|
1485 global numcommits ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1486 global nextupdate startmsecs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1487 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1488 set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1489 if {$level >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1490 set phase drawgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1491 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1492 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
|
1493 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
|
1494 if {$hard} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1495 set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1496 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
|
1497 } |
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 drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1500 } |
267 | 1501 set phase {} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1502 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
|
1503 #puts "overall $drawmsecs ms for $numcommits commits" |
267 | 1504 if {$redisplaying} { |
1505 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
|
1506 selectline $selectedline 0 |
267 | 1507 } |
1508 if {$stopped == 1} { | |
1509 set stopped 0 | |
1510 after idle drawgraph | |
1511 } else { | |
1512 set redisplaying 0 | |
1513 } | |
1514 } | |
1515 } | |
1516 | |
1517 proc findmatches {f} { | |
1518 global findtype foundstring foundstrlen | |
1519 if {$findtype == "Regexp"} { | |
1520 set matches [regexp -indices -all -inline $foundstring $f] | |
1521 } else { | |
1522 if {$findtype == "IgnCase"} { | |
1523 set str [string tolower $f] | |
1524 } else { | |
1525 set str $f | |
1526 } | |
1527 set matches {} | |
1528 set i 0 | |
1529 while {[set j [string first $foundstring $str $i]] >= 0} { | |
1530 lappend matches [list $j [expr $j+$foundstrlen-1]] | |
1531 set i [expr $j + $foundstrlen] | |
1532 } | |
1533 } | |
1534 return $matches | |
1535 } | |
1536 | |
1537 proc dofind {} { | |
1538 global findtype findloc findstring markedmatches commitinfo | |
1539 global numcommits lineid linehtag linentag linedtag | |
1540 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
|
1541 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
|
1542 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1543 stopfindproc |
267 | 1544 unmarkmatches |
1545 focus . | |
1546 set matchinglines {} | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1547 if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1548 findpatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1549 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1550 } |
267 | 1551 if {$findtype == "IgnCase"} { |
1552 set foundstring [string tolower $findstring] | |
1553 } else { | |
1554 set foundstring $findstring | |
1555 } | |
1556 set foundstrlen [string length $findstring] | |
1557 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
|
1558 if {$findloc == "Files"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1559 findfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1560 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1561 } |
267 | 1562 if {![info exists selectedline]} { |
1563 set oldsel -1 | |
1564 } else { | |
1565 set oldsel $selectedline | |
1566 } | |
1567 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
|
1568 set fldtypes {Headline Author Date Committer CDate Comment} |
267 | 1569 for {set l 0} {$l < $numcommits} {incr l} { |
1570 set id $lineid($l) | |
1571 set info $commitinfo($id) | |
1572 set doesmatch 0 | |
1573 foreach f $info ty $fldtypes { | |
1574 if {$findloc != "All fields" && $findloc != $ty} { | |
1575 continue | |
1576 } | |
1577 set matches [findmatches $f] | |
1578 if {$matches == {}} continue | |
1579 set doesmatch 1 | |
1580 if {$ty == "Headline"} { | |
1581 markmatches $canv $l $f $linehtag($l) $matches $mainfont | |
1582 } elseif {$ty == "Author"} { | |
1583 markmatches $canv2 $l $f $linentag($l) $matches $namefont | |
1584 } elseif {$ty == "Date"} { | |
1585 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont | |
1586 } | |
1587 } | |
1588 if {$doesmatch} { | |
1589 lappend matchinglines $l | |
1590 if {!$didsel && $l > $oldsel} { | |
1591 findselectline $l | |
1592 set didsel 1 | |
1593 } | |
1594 } | |
1595 } | |
1596 if {$matchinglines == {}} { | |
1597 bell | |
1598 } elseif {!$didsel} { | |
1599 findselectline [lindex $matchinglines 0] | |
1600 } | |
1601 } | |
1602 | |
1603 proc findselectline {l} { | |
1604 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
|
1605 selectline $l 1 |
267 | 1606 if {$findloc == "All fields" || $findloc == "Comments"} { |
1607 # highlight the matches in the comments | |
1608 set f [$ctext get 1.0 $commentend] | |
1609 set matches [findmatches $f] | |
1610 foreach match $matches { | |
1611 set start [lindex $match 0] | |
1612 set end [expr [lindex $match 1] + 1] | |
1613 $ctext tag add found "1.0 + $start c" "1.0 + $end c" | |
1614 } | |
1615 } | |
1616 } | |
1617 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1618 proc findnext {restart} { |
267 | 1619 global matchinglines selectedline |
1620 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
|
1621 if {$restart} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1622 dofind |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1623 } |
267 | 1624 return |
1625 } | |
1626 if {![info exists selectedline]} return | |
1627 foreach l $matchinglines { | |
1628 if {$l > $selectedline} { | |
1629 findselectline $l | |
1630 return | |
1631 } | |
1632 } | |
1633 bell | |
1634 } | |
1635 | |
1636 proc findprev {} { | |
1637 global matchinglines selectedline | |
1638 if {![info exists matchinglines]} { | |
1639 dofind | |
1640 return | |
1641 } | |
1642 if {![info exists selectedline]} return | |
1643 set prev {} | |
1644 foreach l $matchinglines { | |
1645 if {$l >= $selectedline} break | |
1646 set prev $l | |
1647 } | |
1648 if {$prev != {}} { | |
1649 findselectline $prev | |
1650 } else { | |
1651 bell | |
1652 } | |
1653 } | |
1654 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1655 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
|
1656 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
|
1657 if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1658 set findtype Exact |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1659 set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1660 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1661 set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1662 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1663 $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
|
1664 $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
|
1665 } |
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 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
|
1668 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
|
1669 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
|
1670 global findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1671 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1672 catch {unset findids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1673 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
|
1674 if {!$done} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1675 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
|
1676 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1677 catch {close $findprocfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1678 unset findprocpid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1679 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1680 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
|
1681 unset findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1682 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1683 . config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1684 settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1685 } |
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 proc findpatches {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1690 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
|
1691 global findprocpid findprocfile |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1692 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
|
1693 global findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1694 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1695 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
|
1696 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1697 # 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
|
1698 # 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
|
1699 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
|
1700 set l $selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1701 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1702 set l -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1703 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1704 set inputids {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1705 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
|
1706 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
|
1707 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1708 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1709 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
|
1710 } |
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 if {[catch { |
1278 | 1713 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
|
1714 << $inputids] r] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1715 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1716 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
|
1717 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1718 } |
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 set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1721 set findprocfile $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1722 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
|
1723 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
|
1724 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
|
1725 set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1726 . config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1727 settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1728 set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1729 } |
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 proc readfindproc {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1732 global findprocfile finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1733 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
|
1734 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1735 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
|
1736 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1737 if {[eof $findprocfile]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1738 stopfindproc 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1739 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1740 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1741 } |
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 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1744 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1745 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
|
1746 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
|
1747 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1748 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1749 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1750 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
|
1751 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
|
1752 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1753 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1754 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
|
1755 insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1756 } |
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 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
|
1759 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
|
1760 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1761 if {$findinsertpos == "end"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1762 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
|
1763 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
|
1764 set findinsertpos 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1765 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1766 lappend matchinglines $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1767 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1768 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1769 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
|
1770 incr findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1771 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1772 markheadline $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1773 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1774 findselectline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1775 set finddidsel 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1776 } |
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 proc findfiles {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1780 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
|
1781 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
|
1782 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
|
1783 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
|
1784 global findmergefiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1785 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1786 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
|
1787 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1788 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
|
1789 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
|
1790 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1791 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1792 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1793 set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1794 set findstartline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1795 set diffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1796 set fdiffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1797 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1798 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
|
1799 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
|
1800 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
|
1801 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
|
1802 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
|
1803 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
|
1804 } |
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 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
|
1808 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1809 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1810 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
|
1811 } |
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 # 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
|
1814 if {$diffsneeded ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1815 if {[catch { |
1278 | 1816 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
|
1817 } err ]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1818 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
|
1819 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1820 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1821 catch {unset fdiffids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1822 set fdiffpos 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1823 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
|
1824 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
|
1825 } |
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 set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1828 set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1829 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
|
1830 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
|
1831 . config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1832 settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1833 set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1834 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
|
1835 update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1836 } |
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 proc readfilediffs {df} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1839 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
|
1840 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1841 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
|
1842 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1843 if {[eof $df]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1844 donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1845 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
|
1846 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1847 bell |
1278 | 1848 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
|
1849 } 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
|
1850 set ids $findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1851 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1852 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1853 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
|
1854 } |
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 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1857 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1858 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
|
1859 # 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
|
1860 donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1861 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
|
1862 set fdiffs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1863 } 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
|
1864 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
|
1865 } |
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 proc donefilediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1869 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
|
1870 global fdiffsneeded fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1871 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1872 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
|
1873 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
|
1874 && $fdiffpos < [llength $fdiffsneeded]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1875 # 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
|
1876 # 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
|
1877 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
|
1878 set treediffs($nullids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1879 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
|
1880 unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1881 findcont $nullids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1882 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1883 incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1884 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1885 incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1886 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1887 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
|
1888 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
|
1889 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1890 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
|
1891 unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1892 findcont $fdiffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1893 } |
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 proc findcont {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1898 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
|
1899 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
|
1900 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
|
1901 global findmergefiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1902 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1903 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
|
1904 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
|
1905 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
|
1906 set l $ffileline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1907 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1908 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
|
1909 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
|
1910 set findids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1911 set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1912 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1913 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1914 set doesmatch 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1915 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
|
1916 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
|
1917 if {$x != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1918 set doesmatch 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1919 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1920 } |
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 if {$doesmatch} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1923 insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1924 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
|
1925 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1926 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1927 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
|
1928 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1929 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
|
1930 set pi 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1931 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
|
1932 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1933 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1934 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
|
1935 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
|
1936 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1937 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
|
1938 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
|
1939 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1940 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1941 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1942 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1943 } |
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 # 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
|
1947 # behind the headline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1948 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
|
1949 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
|
1950 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1951 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
|
1952 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
|
1953 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1954 } |
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 # mark the bits of a headline, author or date that match a find string |
267 | 1957 proc markmatches {canv l str tag matches font} { |
1958 set bbox [$canv bbox $tag] | |
1959 set x0 [lindex $bbox 0] | |
1960 set y0 [lindex $bbox 1] | |
1961 set y1 [lindex $bbox 3] | |
1962 foreach match $matches { | |
1963 set start [lindex $match 0] | |
1964 set end [lindex $match 1] | |
1965 if {$start > $end} continue | |
1966 set xoff [font measure $font [string range $str 0 [expr $start-1]]] | |
1967 set xlen [font measure $font [string range $str 0 [expr $end]]] | |
1968 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ | |
1969 -outline {} -tags matches -fill yellow] | |
1970 $canv lower $t | |
1971 } | |
1972 } | |
1973 | |
1974 proc unmarkmatches {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1975 global matchinglines findids |
267 | 1976 allcanvs delete matches |
1977 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
|
1978 catch {unset findids} |
267 | 1979 } |
1980 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1981 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
|
1982 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
|
1983 global lineid linehtag linentag linedtag rowtextx |
267 | 1984 set ymax [lindex [$canv cget -scrollregion] 3] |
1985 if {$ymax == {}} return | |
1986 set yfrac [lindex [$canv yview] 0] | |
1987 set y [expr {$y + $yfrac * $ymax}] | |
1988 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] | |
1989 if {$l < 0} { | |
1990 set l 0 | |
1991 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1992 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
|
1993 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
|
1994 } |
267 | 1995 unmarkmatches |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1996 selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1997 } |
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 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
|
2000 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2001 set l "..." |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2002 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
|
2003 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
|
2004 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2005 return "$p ($l)" |
267 | 2006 } |
2007 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2008 # 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
|
2009 # 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
|
2010 proc appendwithlinks {text} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2011 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
|
2012 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2013 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
|
2014 $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
|
2015 $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
|
2016 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
|
2017 foreach l $links { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2018 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
|
2019 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
|
2020 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
|
2021 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
|
2022 incr e |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2023 $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
|
2024 $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
|
2025 $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
|
2026 incr linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2027 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2028 $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
|
2029 $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
|
2030 $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
|
2031 } |
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 proc selectline {l isnew} { |
267 | 2034 global canv canv2 canv3 ctext commitinfo selectedline |
2035 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
|
2036 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
|
2037 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
|
2038 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
|
2039 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2040 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2041 normalline |
267 | 2042 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
2043 $canv delete secsel | |
2044 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ | |
2045 -tags secsel -fill [$canv cget -selectbackground]] | |
2046 $canv lower $t | |
2047 $canv2 delete secsel | |
2048 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ | |
2049 -tags secsel -fill [$canv2 cget -selectbackground]] | |
2050 $canv2 lower $t | |
2051 $canv3 delete secsel | |
2052 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ | |
2053 -tags secsel -fill [$canv3 cget -selectbackground]] | |
2054 $canv3 lower $t | |
2055 set y [expr {$canvy0 + $l * $linespc}] | |
2056 set ymax [lindex [$canv cget -scrollregion] 3] | |
2057 set ytop [expr {$y - $linespc - 1}] | |
2058 set ybot [expr {$y + $linespc + 1}] | |
2059 set wnow [$canv yview] | |
2060 set wtop [expr [lindex $wnow 0] * $ymax] | |
2061 set wbot [expr [lindex $wnow 1] * $ymax] | |
2062 set wh [expr {$wbot - $wtop}] | |
2063 set newtop $wtop | |
2064 if {$ytop < $wtop} { | |
2065 if {$ybot < $wtop} { | |
2066 set newtop [expr {$y - $wh / 2.0}] | |
2067 } else { | |
2068 set newtop $ytop | |
2069 if {$newtop > $wtop - $linespc} { | |
2070 set newtop [expr {$wtop - $linespc}] | |
2071 } | |
2072 } | |
2073 } elseif {$ybot > $wbot} { | |
2074 if {$ytop > $wbot} { | |
2075 set newtop [expr {$y - $wh / 2.0}] | |
2076 } else { | |
2077 set newtop [expr {$ybot - $wh}] | |
2078 if {$newtop < $wtop + $linespc} { | |
2079 set newtop [expr {$wtop + $linespc}] | |
2080 } | |
2081 } | |
2082 } | |
2083 if {$newtop != $wtop} { | |
2084 if {$newtop < 0} { | |
2085 set newtop 0 | |
2086 } | |
2087 allcanvs yview moveto [expr $newtop * 1.0 / $ymax] | |
2088 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2089 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2090 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2091 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
|
2092 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2093 |
267 | 2094 set selectedline $l |
2095 | |
2096 set id $lineid($l) | |
2097 set currentid $id | |
2098 $sha1entry delete 0 end | |
2099 $sha1entry insert 0 $id | |
2100 $sha1entry selection from 0 | |
2101 $sha1entry selection to end | |
2102 | |
2103 $ctext conf -state normal | |
2104 $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
|
2105 set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2106 $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
|
2107 $ctext mark gravity fmark.0 left |
267 | 2108 set info $commitinfo($id) |
2109 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" | |
2110 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" | |
2111 if {[info exists idtags($id)]} { | |
2112 $ctext insert end "Tags:" | |
2113 foreach tag $idtags($id) { | |
2114 $ctext insert end " $tag" | |
2115 } | |
2116 $ctext insert end "\n" | |
2117 } | |
1308
2073e5a71008
Cleanup of tabs and trailing spaces.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
1278
diff
changeset
|
2118 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2119 set comment {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2120 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
|
2121 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
|
2122 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
|
2123 } |
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 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
|
2126 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
|
2127 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
|
2128 } |
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 append comment "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2131 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
|
2132 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2133 # 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
|
2134 appendwithlinks $comment |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2135 |
267 | 2136 $ctext tag delete Comments |
2137 $ctext tag remove found 1.0 end | |
2138 $ctext conf -state disabled | |
2139 set commentend [$ctext index "end - 1c"] | |
2140 | |
2141 $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
|
2142 $cflist insert end "Comments" |
267 | 2143 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
|
2144 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
|
2145 } 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
|
2146 mergediff $id |
267 | 2147 } |
2148 } | |
2149 | |
2150 proc selnextline {dir} { | |
2151 global selectedline | |
2152 if {![info exists selectedline]} return | |
2153 set l [expr $selectedline + $dir] | |
2154 unmarkmatches | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2155 selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2156 } |
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 proc unselectline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2159 global selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2160 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2161 catch {unset selectedline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2162 allcanvs delete secsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2163 } |
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 proc addtohistory {cmd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2166 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2167 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2168 if {$historyindex > 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2169 && [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
|
2170 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2171 } |
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 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
|
2174 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
|
2175 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2176 lappend history $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2177 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2178 incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2179 if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2180 .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
|
2181 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2182 .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
|
2183 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2184 .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
|
2185 } |
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 proc goback {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2188 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2189 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2190 if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2191 incr historyindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2192 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
|
2193 eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2194 .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
|
2195 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2196 if {$historyindex <= 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2197 .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
|
2198 } |
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 proc goforw {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2202 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2203 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2204 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
|
2205 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
|
2206 incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2207 eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2208 .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
|
2209 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2210 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
|
2211 .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
|
2212 } |
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 proc mergediff {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2216 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
|
2217 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2218 set diffmergeid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2219 set diffpindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2220 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
|
2221 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
|
2222 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
|
2223 showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2224 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2225 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2226 contmergediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2227 } |
267 | 2228 } |
2229 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2230 proc findgca {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2231 set gca {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2232 foreach id $ids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2233 if {$gca eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2234 set gca $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2235 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2236 if {[catch { |
1278 | 2237 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
|
2238 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2239 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2240 } |
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 return $gca |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2244 } |
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 proc contmergediff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2247 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
|
2248 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
|
2249 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2250 # 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
|
2251 # 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
|
2252 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2253 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
|
2254 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
|
2255 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2256 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
|
2257 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
|
2258 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
|
2259 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2260 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
|
2261 set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2262 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
|
2263 gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2264 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2265 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2266 } |
267 | 2267 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2268 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2269 # 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
|
2270 # 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
|
2271 # 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
|
2272 # 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
|
2273 if {$diffmergegca ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2274 set files {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2275 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
|
2276 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
|
2277 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
|
2278 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
|
2279 && [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
|
2280 lappend files $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2281 } |
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 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
|
2285 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2286 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
|
2287 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
|
2288 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
|
2289 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
|
2290 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
|
2291 set nf {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2292 foreach f $files { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2293 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
|
2294 lappend nf $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2295 } |
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 set files $nf |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2298 } |
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 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
|
2302 if {$files ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2303 showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2304 } |
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 proc showmergediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2308 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
|
2309 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
|
2310 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
|
2311 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2312 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
|
2313 foreach f $files { |
267 | 2314 $cflist insert end $f |
2315 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2316 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
|
2317 set flist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2318 catch {unset currentfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2319 catch {unset currenthunk} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2320 catch {unset filelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2321 catch {unset groupfilenum} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2322 catch {unset grouphunks} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2323 set groupfilelast -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2324 foreach p $parents($diffmergeid) { |
1278 | 2325 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
|
2326 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
|
2327 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
|
2328 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
|
2329 foreach f $flist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2330 catch {close $f} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2331 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2332 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2333 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2334 lappend flist $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2335 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
|
2336 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
|
2337 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
|
2338 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
|
2339 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
|
2340 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
|
2341 } |
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 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
|
2345 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
|
2346 global currentfile currenthunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2347 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
|
2348 global diffblocked mergefilelist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2349 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
|
2350 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2351 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
|
2352 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2353 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
|
2354 } |
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 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
|
2357 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2358 close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2359 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2360 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2361 } |
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 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
|
2364 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
|
2365 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
|
2366 # 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
|
2367 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
|
2368 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
|
2369 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
|
2370 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
|
2371 incr diffoldlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2372 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2373 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
|
2374 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
|
2375 incr diffnewlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2376 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2377 if {$match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2378 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
|
2379 lappend difflcounts($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2380 [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
|
2381 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
|
2382 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
|
2383 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2384 incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2385 } 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
|
2386 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
|
2387 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
|
2388 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
|
2389 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
|
2390 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
|
2391 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2392 if {$match eq "-"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2393 incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2394 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2395 incr nnewlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2396 } |
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 # 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
|
2399 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2400 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2401 # 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
|
2402 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
|
2403 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
|
2404 } 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
|
2405 && ($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
|
2406 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
|
2407 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2408 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
|
2409 $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
|
2410 $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
|
2411 $difflcounts($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2412 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
|
2413 # -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
|
2414 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
|
2415 processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2416 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
|
2417 fileevent $f readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2418 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
|
2419 } |
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 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2423 # eof |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2424 if {!$diffblocked($ids)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2425 close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2426 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
|
2427 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
|
2428 processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2429 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2430 } 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
|
2431 # 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
|
2432 set currentfile($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2433 [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
|
2434 } 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
|
2435 $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
|
2436 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
|
2437 # 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
|
2438 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
|
2439 set f1l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2440 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2441 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
|
2442 set f2l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2443 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2444 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
|
2445 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
|
2446 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
|
2447 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
|
2448 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
|
2449 set difflcounts($ids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2450 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
|
2451 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
|
2452 } |
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 proc processhunks {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2457 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
|
2458 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
|
2459 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
|
2460 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2461 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
|
2462 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2463 set fi $nfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2464 set lno 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2465 # 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
|
2466 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
|
2467 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
|
2468 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
|
2469 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
|
2470 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
|
2471 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
|
2472 set fi $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2473 set lno $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2474 set pi $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2475 } |
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 if {$fi < $nfiles} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2479 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
|
2480 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
|
2481 unset currenthunk($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2482 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
|
2483 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
|
2484 [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
|
2485 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2486 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
|
2487 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2488 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
|
2489 && $lno <= $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2490 # 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
|
2491 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
|
2492 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
|
2493 if {$endln > $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2494 set grouplineend $endln |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2495 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2496 continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2497 } |
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 # 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
|
2501 # 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
|
2502 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
|
2503 processgroup |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2504 unset groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2505 unset grouphunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2506 } |
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 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
|
2509 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2510 # 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
|
2511 set groupfilenum $fi |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2512 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
|
2513 set grouplinestart $lno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2514 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
|
2515 } |
267 | 2516 } |
2517 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2518 proc processgroup {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2519 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
|
2520 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
|
2521 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
|
2522 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
|
2523 global mergemax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2524 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2525 $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
|
2526 set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2527 set f $groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2528 if {$groupfilelast != $f} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2529 $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
|
2530 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
|
2531 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
|
2532 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
|
2533 $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
|
2534 $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
|
2535 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
|
2536 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
|
2537 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
|
2538 $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
|
2539 set groupfilelast $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2540 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
|
2541 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
|
2542 } |
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 $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
|
2546 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
|
2547 set events {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2548 set pnum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2549 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
|
2550 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
|
2551 set ol $startline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2552 set nl $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2553 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
|
2554 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
|
2555 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
|
2556 if {$nl < $l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2557 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
|
2558 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
|
2559 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2560 } |
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 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
|
2563 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
|
2564 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
|
2565 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
|
2566 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
|
2567 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
|
2568 incr ol $olc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2569 set nl $nnl |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2570 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2571 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
|
2572 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
|
2573 } |
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 if {$nl < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2578 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
|
2579 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
|
2580 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2581 } |
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 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
|
2584 $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
|
2585 incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2586 } |
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 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
|
2589 $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
|
2590 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2591 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
|
2592 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
|
2593 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
|
2594 set l $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2595 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
|
2596 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
|
2597 while {$l < $nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2598 $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
|
2599 incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2600 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2601 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
|
2602 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
|
2603 set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2604 set active {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2605 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2606 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
|
2607 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
|
2608 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
|
2609 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
|
2610 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
|
2611 lappend active $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2612 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2613 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
|
2614 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2615 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
|
2616 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
|
2617 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
|
2618 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
|
2619 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
|
2620 } |
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 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
|
2623 set ncol mresult |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2624 set bestpn -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2625 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
|
2626 # 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
|
2627 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
|
2628 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
|
2629 if {$pnum < $mergemax} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2630 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
|
2631 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2632 lappend ncol mmax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2633 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2634 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2635 } |
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 } 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
|
2638 # 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
|
2639 set bestsim 30 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2640 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
|
2641 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
|
2642 [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
|
2643 if {$sim > $bestsim} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2644 set bestsim $sim |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2645 set bestpn $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2646 } |
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 if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2649 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
|
2650 } |
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 set pnum -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2653 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
|
2654 incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2655 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
|
2656 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
|
2657 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
|
2658 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
|
2659 unset delta($pnum) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2660 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
|
2661 $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
|
2662 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2663 } |
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 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
|
2666 if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2667 # 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
|
2668 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
|
2669 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
|
2670 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
|
2671 unset delta($bestpn) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2672 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
|
2673 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
|
2674 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
|
2675 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
|
2676 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
|
2677 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
|
2678 $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
|
2679 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2680 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
|
2681 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
|
2682 $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
|
2683 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2684 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2685 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
|
2686 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
|
2687 $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
|
2688 } |
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 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
|
2692 $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
|
2693 } |
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 while {$l < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2696 $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
|
2697 incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2698 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2699 $ctext conf -state disabled |
267 | 2700 } |
2701 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2702 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
|
2703 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
|
2704 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2705 set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2706 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
|
2707 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
|
2708 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
|
2709 set same 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2710 set diff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2711 foreach e $events { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2712 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
|
2713 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
|
2714 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
|
2715 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
|
2716 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
|
2717 incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2718 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2719 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
|
2720 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
|
2721 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
|
2722 incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2723 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2724 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2725 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
|
2726 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
|
2727 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
|
2728 incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2729 } |
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 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
|
2732 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
|
2733 incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2734 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2735 if {$same == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2736 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2737 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2738 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
|
2739 } |
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 proc startdiff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2742 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
|
2743 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2744 set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2745 catch {unset diffmergeid} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2746 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
|
2747 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
|
2748 gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2749 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2750 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2751 addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2752 } |
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 proc addtocflist {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2756 global treediffs cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2757 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
|
2758 $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
|
2759 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2760 getblobdiffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2761 } |
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 proc gettreediffs {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2764 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
|
2765 set treepending $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2766 set treediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2767 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
|
2768 set p [lindex $ids 1] |
1278 | 2769 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
|
2770 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
|
2771 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
|
2772 } |
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 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
|
2775 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
|
2776 |
267 | 2777 set n [gets $gdtf line] |
2778 if {$n < 0} { | |
2779 if {![eof $gdtf]} return | |
2780 close $gdtf | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2781 set treediffs($ids) $treediff |
267 | 2782 unset treepending |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2783 if {$ids != $diffids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2784 gettreediffs $diffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2785 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2786 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
|
2787 contmergediff $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2788 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2789 addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2790 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2791 } |
267 | 2792 return |
2793 } | |
2794 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
|
2795 lappend treediff $file |
267 | 2796 } |
2797 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2798 proc getblobdiffs {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2799 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
|
2800 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
|
2801 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2802 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
|
2803 set p [lindex $ids 1] |
267 | 2804 set env(GIT_DIFF_OPTS) $diffopts |
1278 | 2805 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
|
2806 if {[catch {set bdf [open $cmd r]} err]} { |
267 | 2807 puts "error getting diffs: $err" |
2808 return | |
2809 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2810 set diffinhdr 0 |
267 | 2811 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
|
2812 set blobdifffd($ids) $bdf |
267 | 2813 set curdifftag Comments |
2814 set curtagstart 0.0 | |
2815 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
|
2816 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
|
2817 set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
267 | 2818 } |
2819 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2820 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
|
2821 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
|
2822 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
|
2823 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
|
2824 global gaudydiff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2825 |
267 | 2826 set n [gets $bdf line] |
2827 if {$n < 0} { | |
2828 if {[eof $bdf]} { | |
2829 close $bdf | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2830 if {$ids == $diffids && $bdf == $blobdifffd($ids)} { |
267 | 2831 $ctext tag add $curdifftag $curtagstart end |
2832 } | |
2833 } | |
2834 return | |
2835 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2836 if {$ids != $diffids || $bdf != $blobdifffd($ids)} { |
267 | 2837 return |
2838 } | |
2839 $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
|
2840 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { |
267 | 2841 # start of a new file |
2842 $ctext insert end "\n" | |
2843 $ctext tag add $curdifftag $curtagstart end | |
2844 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
|
2845 set header $newname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2846 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
|
2847 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
|
2848 if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2849 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
|
2850 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2851 $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
|
2852 $ctext mark gravity fmark.$i left |
267 | 2853 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2854 if {$newname != $fname} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2855 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
|
2856 if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2857 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
|
2858 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2859 $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
|
2860 $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
|
2861 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2862 } |
267 | 2863 set curdifftag "f:$fname" |
2864 $ctext tag delete $curdifftag | |
2865 set l [expr {(78 - [string length $header]) / 2}] | |
2866 set pad [string range "----------------------------------------" 1 $l] | |
2867 $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
|
2868 set diffinhdr 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2869 } elseif {[regexp {^(---|\+\+\+)} $line]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2870 set diffinhdr 0 |
267 | 2871 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
2872 $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
|
2873 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2874 $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
|
2875 $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
|
2876 $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
|
2877 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2878 $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
|
2879 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2880 set diffinhdr 0 |
267 | 2881 } else { |
2882 set x [string range $line 0 0] | |
2883 if {$x == "-" || $x == "+"} { | |
2884 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
|
2885 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2886 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
|
2887 } |
267 | 2888 $ctext insert end "$line\n" d$tag |
2889 } elseif {$x == " "} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2890 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2891 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
|
2892 } |
267 | 2893 $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
|
2894 } elseif {$diffinhdr || $x == "\\"} { |
267 | 2895 # e.g. "\ No newline at end of file" |
2896 $ctext insert end "$line\n" filesep | |
2897 } else { | |
2898 # Something else we don't recognize | |
2899 if {$curdifftag != "Comments"} { | |
2900 $ctext insert end "\n" | |
2901 $ctext tag add $curdifftag $curtagstart end | |
2902 set curtagstart [$ctext index "end - 1c"] | |
2903 set curdifftag Comments | |
2904 } | |
2905 $ctext insert end "$line\n" filesep | |
2906 } | |
2907 } | |
2908 $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
|
2909 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
|
2910 incr nextupdate 100 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2911 fileevent $bdf readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2912 update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2913 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
|
2914 } |
267 | 2915 } |
2916 | |
2917 proc nextfile {} { | |
2918 global difffilestart ctext | |
2919 set here [$ctext index @0,0] | |
2920 for {set i 0} {[info exists difffilestart($i)]} {incr i} { | |
2921 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
|
2922 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
|
2923 || [$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
|
2924 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
|
2925 } |
267 | 2926 } |
2927 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2928 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
|
2929 $ctext yview $pos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2930 } |
267 | 2931 } |
2932 | |
2933 proc listboxsel {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2934 global ctext cflist currentid |
267 | 2935 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
|
2936 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
|
2937 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
|
2938 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
|
2939 catch {$ctext yview fmark.$first} |
267 | 2940 } |
2941 | |
2942 proc setcoords {} { | |
2943 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
|
2944 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
|
2945 |
267 | 2946 set linespc [font metrics $mainfont -linespace] |
2947 set charspc [font measure $mainfont "m"] | |
2948 set canvy0 [expr 3 + 0.5 * $linespc] | |
2949 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
|
2950 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
|
2951 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
|
2952 set xspc2 $linespc |
267 | 2953 } |
2954 | |
2955 proc redisplay {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2956 global stopped redisplaying phase |
267 | 2957 if {$stopped > 1} return |
2958 if {$phase == "getcommits"} return | |
2959 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
|
2960 if {$phase == "drawgraph" || $phase == "incrdraw"} { |
267 | 2961 set stopped 1 |
2962 } else { | |
2963 drawgraph | |
2964 } | |
2965 } | |
2966 | |
2967 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
|
2968 global mainfont namefont textfont ctext canv phase |
267 | 2969 global stopped entries |
2970 unmarkmatches | |
2971 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] | |
2972 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] | |
2973 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] | |
2974 setcoords | |
2975 $ctext conf -font $textfont | |
2976 $ctext tag conf filesep -font [concat $textfont bold] | |
2977 foreach e $entries { | |
2978 $e conf -font $mainfont | |
2979 } | |
2980 if {$phase == "getcommits"} { | |
2981 $canv itemconf textitems -font $mainfont | |
2982 } | |
2983 redisplay | |
2984 } | |
2985 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2986 proc clearsha1 {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2987 global sha1entry sha1string |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2988 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
|
2989 $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
|
2990 } |
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 |
267 | 2993 proc sha1change {n1 n2 op} { |
2994 global sha1string currentid sha1but | |
2995 if {$sha1string == {} | |
2996 || ([info exists currentid] && $sha1string == $currentid)} { | |
2997 set state disabled | |
2998 } else { | |
2999 set state normal | |
3000 } | |
3001 if {[$sha1but cget -state] == $state} return | |
3002 if {$state == "normal"} { | |
3003 $sha1but conf -state normal -relief raised -text "Goto: " | |
3004 } else { | |
3005 $sha1but conf -state disabled -relief flat -text "SHA1 ID: " | |
3006 } | |
3007 } | |
3008 | |
3009 proc gotocommit {} { | |
3010 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
|
3011 global lineid numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3012 |
267 | 3013 if {$sha1string == {} |
3014 || ([info exists currentid] && $sha1string == $currentid)} return | |
3015 if {[info exists tagids($sha1string)]} { | |
3016 set id $tagids($sha1string) | |
3017 } else { | |
3018 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
|
3019 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
|
3020 set matches {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3021 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
|
3022 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
|
3023 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
|
3024 } |
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 if {$matches ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3027 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
|
3028 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
|
3029 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3030 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3031 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
|
3032 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3033 } |
267 | 3034 } |
3035 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
|
3036 selectline $idline($id) 1 |
267 | 3037 return |
3038 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3039 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { |
267 | 3040 set type "SHA1 id" |
3041 } else { | |
3042 set type "Tag" | |
3043 } | |
3044 error_popup "$type $sha1string is not known" | |
3045 } | |
3046 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3047 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
|
3048 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
|
3049 global commitinfo canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3050 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3051 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
|
3052 set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3053 set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3054 set hoverid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3055 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
|
3056 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3057 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3058 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
|
3059 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3060 } |
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 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
|
3063 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
|
3064 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3065 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
|
3066 set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3067 set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3068 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
|
3069 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3070 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3071 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
|
3072 } |
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 proc lineleave {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3076 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
|
3077 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3078 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
|
3079 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3080 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
|
3081 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3082 unset hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3083 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3084 unset hoverid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3085 } |
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 proc linehover {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3089 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
|
3090 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
|
3091 global commitinfo mainfont |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3092 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3093 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
|
3094 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
|
3095 if {$ymax == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3096 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
|
3097 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
|
3098 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
|
3099 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
|
3100 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
|
3101 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
|
3102 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
|
3103 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
|
3104 -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
|
3105 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3106 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
|
3107 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3108 } |
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 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
|
3111 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
|
3112 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3113 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
|
3114 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
|
3115 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
|
3116 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
|
3117 return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3118 } |
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 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
|
3122 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
|
3123 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
|
3124 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
|
3125 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
|
3126 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
|
3127 return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3128 } |
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 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
|
3131 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
|
3132 return "down" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3133 } |
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 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3138 } |
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 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
|
3141 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
|
3142 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3143 set yt {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3144 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
|
3145 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
|
3146 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
|
3147 if {$y1 > $y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3148 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3149 } |
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 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
|
3152 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
|
3153 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
|
3154 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
|
3155 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3156 } |
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 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3160 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
|
3161 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
|
3162 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
|
3163 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
|
3164 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3165 } |
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 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
|
3170 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
|
3171 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
|
3172 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
|
3173 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
|
3174 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
|
3175 if {$yfrac < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3176 set yfrac 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3177 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3178 $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
|
3179 } |
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 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
|
3182 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
|
3183 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3184 unmarkmatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3185 unselectline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3186 normalline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3187 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3188 # 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
|
3189 drawlines $id 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3190 set thickerline $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3191 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3192 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
|
3193 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
|
3194 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
|
3195 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
|
3196 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3197 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
|
3198 if {$dirn ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3199 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
|
3200 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3201 } |
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 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3204 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
|
3205 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3206 # 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
|
3207 $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
|
3208 $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
|
3209 $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
|
3210 $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
|
3211 $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
|
3212 $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
|
3213 $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
|
3214 $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
|
3215 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
|
3216 $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
|
3217 $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
|
3218 $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
|
3219 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
|
3220 $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
|
3221 set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3222 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
|
3223 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3224 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
|
3225 $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
|
3226 $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
|
3227 $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
|
3228 $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
|
3229 $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
|
3230 $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
|
3231 } |
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 $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
|
3234 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3235 $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
|
3236 } |
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 proc normalline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3239 global thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3240 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
|
3241 drawlines $thickerline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3242 unset thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3243 } |
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 proc selbyid {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3247 global idline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3248 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
|
3249 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
|
3250 } |
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 proc mstime {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3254 global startmstime |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3255 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
|
3256 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
|
3257 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3258 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
|
3259 } |
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 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
|
3262 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
|
3263 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3264 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
|
3265 set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3266 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3267 set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3268 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3269 $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
|
3270 $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
|
3271 $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
|
3272 set rowmenuid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3273 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
|
3274 } |
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 proc diffvssel {dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3277 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
|
3278 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3279 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
|
3280 if {$dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3281 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
|
3282 set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3283 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3284 set oldid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3285 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
|
3286 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3287 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
|
3288 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 } |
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 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
|
3292 global ctext cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3293 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3294 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3295 $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
|
3296 $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
|
3297 $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
|
3298 $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
|
3299 $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
|
3300 $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
|
3301 $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
|
3302 $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
|
3303 $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
|
3304 $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
|
3305 $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
|
3306 $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
|
3307 $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
|
3308 $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
|
3309 $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
|
3310 $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
|
3311 $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
|
3312 $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
|
3313 $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
|
3314 $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
|
3315 $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
|
3316 $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
|
3317 $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
|
3318 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
|
3319 } |
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 proc mkpatch {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3322 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
|
3323 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3324 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
|
3325 set oldid $currentid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3326 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
|
3327 set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3328 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
|
3329 set top .patch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3330 set patchtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3331 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3332 toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3333 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
|
3334 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
|
3335 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
|
3336 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
|
3337 $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
|
3338 $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
|
3339 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
|
3340 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
|
3341 $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
|
3342 $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
|
3343 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
|
3344 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
|
3345 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
|
3346 $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
|
3347 $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
|
3348 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
|
3349 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
|
3350 $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
|
3351 $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
|
3352 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
|
3353 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
|
3354 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
|
3355 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
|
3356 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
|
3357 $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
|
3358 incr patchnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3359 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
|
3360 frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3361 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
|
3362 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
|
3363 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
|
3364 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
|
3365 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
|
3366 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
|
3367 focus $top.fname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3368 } |
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 proc mkpatchrev {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3371 global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3372 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3373 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
|
3374 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
|
3375 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
|
3376 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
|
3377 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
|
3378 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
|
3379 $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
|
3380 $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
|
3381 $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
|
3382 $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
|
3383 } |
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 proc mkpatchgo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3387 global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3388 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3389 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
|
3390 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
|
3391 set fname [$patchtop.fname get] |
1278 | 3392 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
|
3393 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
|
3394 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3395 catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3396 unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3397 } |
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 proc mkpatchcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3400 global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3401 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3402 catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3403 unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3404 } |
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 proc mktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3407 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
|
3408 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3409 set top .maketag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3410 set mktagtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3411 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3412 toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3413 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
|
3414 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
|
3415 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
|
3416 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
|
3417 $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
|
3418 $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
|
3419 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
|
3420 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
|
3421 $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
|
3422 $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
|
3423 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
|
3424 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
|
3425 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
|
3426 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
|
3427 frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3428 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
|
3429 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
|
3430 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
|
3431 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
|
3432 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
|
3433 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
|
3434 focus $top.tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3435 } |
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 proc domktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3438 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
|
3439 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3440 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
|
3441 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
|
3442 if {$tag == {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3443 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
|
3444 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3445 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3446 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
|
3447 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
|
3448 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3449 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3450 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
|
3451 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
|
3452 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3453 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
|
3454 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3455 } |
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 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
|
3458 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
|
3459 redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3460 } |
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 proc redrawtags {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3463 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
|
3464 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3465 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
|
3466 $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
|
3467 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
|
3468 $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
|
3469 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
|
3470 selectline $selectedline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3471 } |
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 proc mktagcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3475 global mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3476 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3477 catch {destroy $mktagtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3478 unset mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3479 } |
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 proc mktaggo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3482 domktag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3483 mktagcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3484 } |
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 proc writecommit {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3487 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
|
3488 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3489 set top .writecommit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3490 set wrcomtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3491 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3492 toplevel $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3493 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
|
3494 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
|
3495 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
|
3496 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
|
3497 $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
|
3498 $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
|
3499 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
|
3500 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
|
3501 $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
|
3502 $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
|
3503 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
|
3504 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
|
3505 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
|
3506 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
|
3507 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
|
3508 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
|
3509 $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
|
3510 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
|
3511 frame $top.buts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3512 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
|
3513 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
|
3514 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
|
3515 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
|
3516 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
|
3517 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
|
3518 focus $top.fname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3519 } |
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 proc wrcomgo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3522 global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3523 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3524 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
|
3525 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
|
3526 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
|
3527 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
|
3528 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
|
3529 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3530 catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3531 unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3532 } |
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 proc wrcomcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3535 global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3536 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3537 catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3538 unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3539 } |
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 proc listrefs {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3542 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
|
3543 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3544 set x {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3545 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
|
3546 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
|
3547 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3548 set y {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3549 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
|
3550 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
|
3551 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3552 set z {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3553 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
|
3554 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
|
3555 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3556 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
|
3557 } |
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 proc rereadrefs {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3560 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
|
3561 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
|
3562 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3563 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
|
3564 [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
|
3565 foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3566 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
|
3567 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
|
3568 } |
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 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
|
3571 catch {unset $v} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3572 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3573 readrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3574 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
|
3575 [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
|
3576 foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3577 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
|
3578 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
|
3579 redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3580 } |
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 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
|
3585 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
|
3586 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3587 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3588 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
|
3589 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3590 $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
|
3591 $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
|
3592 set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3593 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
|
3594 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
|
3595 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3596 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
|
3597 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3598 appendwithlinks $text |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3599 $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
|
3600 $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
|
3601 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3602 |
267 | 3603 proc doquit {} { |
3604 global stopped | |
3605 set stopped 100 | |
3606 destroy . | |
3607 } | |
3608 | |
3609 # defaults... | |
3610 set datemode 0 | |
3611 set boldnames 0 | |
3612 set diffopts "-U 5 -p" | |
1278 | 3613 set wrcomcmd "hg debug-diff-tree --stdin -p --pretty" |
267 | 3614 |
3615 set mainfont {Helvetica 9} | |
3616 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
|
3617 set findmergefiles 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3618 set gaudydiff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3619 set maxgraphpct 50 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3620 set maxwidth 16 |
267 | 3621 |
3622 set colors {green red blue magenta darkgrey brown orange} | |
3623 | |
3624 catch {source ~/.gitk} | |
3625 | |
3626 set namefont $mainfont | |
3627 if {$boldnames} { | |
3628 lappend namefont bold | |
3629 } | |
3630 | |
3631 set revtreeargs {} | |
3632 foreach arg $argv { | |
3633 switch -regexp -- $arg { | |
3634 "^$" { } | |
3635 "^-b" { set boldnames 1 } | |
3636 "^-d" { set datemode 1 } | |
3637 default { | |
3638 lappend revtreeargs $arg | |
3639 } | |
3640 } | |
3641 } | |
3642 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3643 set history {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3644 set historyindex 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3645 |
267 | 3646 set stopped 0 |
3647 set redisplaying 0 | |
3648 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
|
3649 set patchnum 0 |
267 | 3650 setcoords |
3651 makewindow | |
3652 readrefs | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3653 getcommits $revtreeargs |