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