annotate contrib/hgk @ 13463:22f948c027a9 stable

hgk: display bookmark in commit diff window
author David Soria Parra <dsp@php.net>
date Wed, 23 Feb 2011 00:25:18 +0100
parents 8641cb094c81
children 0f93bbe8deb7
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4 # This program is free software; it may be used, copied, modified
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
5 # and distributed under the terms of the GNU General Public Licence,
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
105 exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
152 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
163 fconfigure $commfd -blocking 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
166 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
167 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
173 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
174 set err "Error reading commits: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
175 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
176 error_popup $err
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
177 exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
237 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
238 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
258 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
270 set inhdr 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
271 set comment {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
272 set headline {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
273 set auname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
274 set audate {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
275 set comname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
279 set bookmark {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
280 if {![info exists nchildren($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
281 set children($id) {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
299 foreach line [split $contents "\n"] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
302 if {$line == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
303 set inhdr 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
304 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
307 set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
310 } elseif {$tag == "committer"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
311 set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
318 } elseif {$tag == "bookmark"} {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
319 set bookmark [join [lrange $line 1 end]]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
320 }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
321 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
322 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
325 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
326 append comment "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
333 append comment $line
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
334 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
335 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
336 if {$audate != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
337 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
338 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
339 if {$comdate != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
340 set cdate($id) $comdate
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
341 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
342 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
343 set commitinfo($id) [list $headline $auname $audate \
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
372 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
423 set status [catch {exec $env(HG) --config ui.report_untrusted=false bookmarks} bookmarks]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
424 if { $status != 0 } {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
425 puts $::errorInfo
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
426 if { ![string equal $::errorCode NONE] } {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
427 exit 2
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
428 }
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
429 }
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
430 set lines [split $bookmarks "\n"]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
431 set bookmarkcurrent 0
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
432 foreach f $lines {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
433 regexp {(\S+)$} $f full
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
434 regsub {\s+(\S+)$} $f "" direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
435 set sha [split $full ':']
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
436 set bookmark [lindex $sha 1]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
437 set current [string first " * " $direct)]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
438 regsub {^\s(\*|\s)\s} $direct "" direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
439 lappend bookmarkids($direct) $bookmark
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
440 lappend idbookmarks($bookmark) $direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
441 if {$current >= 0} {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
442 set bookmarkcurrent $direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
443 }
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
444 }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
445 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
453 catch {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
462 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
470 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
477 proc error_popup msg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
478 set w .error
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
479 toplevel $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
480 wm transient $w .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
481 message $w.m -text $msg -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
482 pack $w.m -side top -fill x -padx 20 -pady 20
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
483 button $w.ok -text OK -command "destroy $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
484 pack $w.ok -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
485 bind $w <Visibility> "grab $w; focus $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
486 tkwait window $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
487 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
488
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
489 proc makewindow {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
503 menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
504 .bar add cascade -label "File" -menu .bar.file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
507 .bar.file add command -label "Quit" -command doquit
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
508 menu .bar.help
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
511 . configure -menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
512
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
513 if {![info exists geometry(canv1)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
514 set geometry(canv1) [expr 45 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
515 set geometry(canv2) [expr 30 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
516 set geometry(canv3) [expr 15 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
517 set geometry(canvh) [expr 25 * $linespc + 4]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
518 set geometry(ctextw) 80
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
519 set geometry(ctexth) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
520 set geometry(cflistw) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
521 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
522 panedwindow .ctop -orient vertical
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
523 if {[info exists geometry(width)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
524 .ctop conf -width $geometry(width) -height $geometry(height)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
525 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
526 set geometry(ctexth) [expr {($texth - 8) /
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
527 [font metrics $textfont -linespace]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
528 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
529 frame .ctop.top
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
530 frame .ctop.top.bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
531 pack .ctop.top.bar -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
532 set cscroll .ctop.top.csb
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
533 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
534 pack $cscroll -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
535 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
536 pack .ctop.top.clist -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
537 .ctop add .ctop.top
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
538 set canv .ctop.top.clist.canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
542 .ctop.top.clist add $canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
543 set canv2 .ctop.top.clist.canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
546 .ctop.top.clist add $canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
547 set canv3 .ctop.top.clist.canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
550 .ctop.top.clist add $canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
551 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
552
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
553 set sha1entry .ctop.top.bar.sha1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
554 set entries $sha1entry
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
555 set sha1but .ctop.top.bar.sha1label
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
556 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
557 -command gotocommit -width 8
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
558 $sha1but conf -disabledforeground [$sha1but cget -foreground]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
559 pack .ctop.top.bar.sha1label -side left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
560 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
561 trace add variable sha1string write sha1change
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
587 button .ctop.top.bar.findbut -text "Find" -command dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
588 pack .ctop.top.bar.findbut -side left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
589 set findstring {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
590 set fstring .ctop.top.bar.findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
591 lappend entries $fstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
592 entry $fstring -width 30 -font $textfont -textvariable findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
593 pack $fstring -side left -expand 1 -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
597 set findloc "All fields"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
600 pack .ctop.top.bar.findloc -side right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
604
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
605 panedwindow .ctop.cdet -orient horizontal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
606 .ctop add .ctop.cdet
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
607 frame .ctop.cdet.left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
617 pack $ctext -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
618 .ctop.cdet add .ctop.cdet.left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
645
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
646 frame .ctop.cdet.right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
650 -yscrollcommand ".ctop.cdet.right.sb set"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
651 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
652 pack .ctop.cdet.right.sb -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
653 pack $cflist -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
654 .ctop.cdet add .ctop.cdet.right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
655 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
656
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
657 pack .ctop -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
662 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
663 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
664 bindall <2> "allcanvs scan mark 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
665 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
666 bind . <Key-Up> "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
667 bind . <Key-Down> "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
668 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
669 bind . <Key-Next> "allcanvs yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
670 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
671 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
672 bindkey <Key-space> "$ctext yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
673 bindkey p "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
674 bindkey n "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
675 bindkey b "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
676 bindkey d "$ctext yview scroll 18 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
680 bindkey ? findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
681 bindkey f nextfile
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
686 bind . <Control-r> findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
687 bind . <Control-equal> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
688 bind . <Control-KP_Add> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
689 bind . <Control-minus> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
690 bind . <Control-KP_Subtract> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
691 bind $cflist <<ListboxSelect>> listboxsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
692 bind . <Destroy> {savestuff %W}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
693 bind . <Button-1> "click %W"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
694 bind $fstring <Key-Return> dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
717 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
718
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
719 # when we make a key binding for the toplevel, make sure
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
720 # it doesn't get triggered when that key is pressed in the
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
721 # find string entry widget.
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
722 proc bindkey {ev script} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
723 global entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
724 bind . $ev $script
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
725 set escript [bind Entry $ev]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
726 if {$escript == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
727 set escript [bind Entry <Key>]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
728 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
729 foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
730 bind $e $ev "$escript; break"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
731 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
732 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
733
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
734 # set the focus back to the toplevel for any click outside
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
735 # the entry widgets
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
736 proc click {w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
737 global entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
738 foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
739 if {$w == $e} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
740 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
741 focus .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
742 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
743
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
744 proc savestuff {w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
751 if {$stuffsaved} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
752 if {![winfo viewable .]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
762 puts $f "set geometry(width) [winfo width .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
763 puts $f "set geometry(height) [winfo height .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
764 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
765 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
766 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
767 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
768 set wid [expr {([winfo width $ctext] - 8) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
769 / [font measure $textfont "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
770 puts $f "set geometry(ctextw) $wid"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
771 set wid [expr {([winfo width $cflist] - 11) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
772 / [font measure [$cflist cget -font] "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
818 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
819 set stuffsaved 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
820 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
821
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
822 proc resizeclistpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
823 global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
824 if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
825 set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
826 set s1 [$win sash coord 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
827 if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
828 set sash0 [expr {int($w/2 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
829 set sash1 [expr {int($w*5/6 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
830 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
831 set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
832 set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
833 set sash1 [expr {int($factor * [lindex $s1 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
834 if {$sash0 < 30} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
835 set sash0 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
836 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
837 if {$sash1 < $sash0 + 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
838 set sash1 [expr $sash0 + 20]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
839 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
840 if {$sash1 > $w - 10} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
841 set sash1 [expr $w - 10]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
842 if {$sash0 > $sash1 - 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
843 set sash0 [expr $sash1 - 20]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
844 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
845 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
846 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
847 $win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
848 $win sash place 1 $sash1 [lindex $s1 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
849 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
850 set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
851 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
852
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
853 proc resizecdetpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
854 global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
855 if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
856 set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
857 if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
858 set sash0 [expr {int($w*3/4 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
859 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
860 set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
861 set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
862 if {$sash0 < 45} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
863 set sash0 45
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
864 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
865 if {$sash0 > $w - 15} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
866 set sash0 [expr $w - 15]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
867 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
868 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
869 $win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
870 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
871 set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
872 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
873
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
874 proc allcanvs args {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
875 global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
876 eval $canv $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
877 eval $canv2 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
878 eval $canv3 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
879 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
880
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
881 proc bindall {event action} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
882 global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
883 bind $canv $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
884 bind $canv2 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
885 bind $canv3 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
886 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
887
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
888 proc about {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
889 set w .about
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
890 if {[winfo exists $w]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
891 raise $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
892 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
893 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
898
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
899 Copyright © 2005 Paul Mackerras
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
902 -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
903 pack $w.m -side top -fill x -padx 20 -pady 20
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
904 button $w.ok -text Close -command "destroy $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
905 pack $w.ok -side bottom
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
906 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
937 proc assigncolor {id} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
938 global commitinfo colormap commcolors colors nextcolor
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
942 if [info exists colormap($id)] return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
958 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
975 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
980 foreach child $children($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
981 if {[info exists colormap($child)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
982 && [lsearch -exact $badcolors $colormap($child)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
983 lappend badcolors $colormap($child)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
984 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
985 if {[info exists parents($child)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
986 foreach p $parents($child) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
987 if {[info exists colormap($p)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
988 && [lsearch -exact $badcolors $colormap($p)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
989 lappend badcolors $colormap($p)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
990 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
991 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
992 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
993 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1060 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1061 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1062 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1087 set nparents($id) 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1088 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1339 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1577 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1578 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1628 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1629 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1652 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1706 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1710 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1711 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1822 if {$redisplaying} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1825 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1826 if {$stopped == 1} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1827 set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1828 after idle drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1829 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1830 set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1831 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1832 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1833 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1834
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1835 proc findmatches {f} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1836 global findtype foundstring foundstrlen
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1837 if {$findtype == "Regexp"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1838 set matches [regexp -indices -all -inline $foundstring $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1839 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1840 if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1841 set str [string tolower $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1842 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1843 set str $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1844 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1845 set matches {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1846 set i 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1847 while {[set j [string first $foundstring $str $i]] >= 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1848 lappend matches [list $j [expr $j+$foundstrlen-1]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1849 set i [expr $j + $foundstrlen]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1850 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1851 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1852 return $matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1853 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1854
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1855 proc dofind {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1856 global findtype findloc findstring markedmatches commitinfo
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1857 global numcommits lineid linehtag linentag linedtag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1862 unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1863 focus .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1869 if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1870 set foundstring [string tolower $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1871 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1872 set foundstring $findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1873 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1874 set foundstrlen [string length $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1880 if {![info exists selectedline]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1881 set oldsel -1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1882 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1883 set oldsel $selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1884 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1887 for {set l 0} {$l < $numcommits} {incr l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1888 set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1889 set info $commitinfo($id)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1890 set doesmatch 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1891 foreach f $info ty $fldtypes {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1892 if {$findloc != "All fields" && $findloc != $ty} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1893 continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1894 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1895 set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1896 if {$matches == {}} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1897 set doesmatch 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1898 if {$ty == "Headline"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1899 markmatches $canv $l $f $linehtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1900 } elseif {$ty == "Author"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1901 markmatches $canv2 $l $f $linentag($l) $matches $namefont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1902 } elseif {$ty == "Date"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1903 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1904 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1905 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1906 if {$doesmatch} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1907 lappend matchinglines $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1908 if {!$didsel && $l > $oldsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1909 findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1910 set didsel 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1911 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1912 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1913 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1914 if {$matchinglines == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1915 bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1916 } elseif {!$didsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1917 findselectline [lindex $matchinglines 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1918 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1919 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1920
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1921 proc findselectline {l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1924 if {$findloc == "All fields" || $findloc == "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1925 # highlight the matches in the comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1926 set f [$ctext get 1.0 $commentend]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1927 set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1928 foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1929 set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1930 set end [expr [lindex $match 1] + 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1931 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1932 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1933 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1934 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1937 global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1942 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1943 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1944 if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1945 foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1946 if {$l > $selectedline} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1947 findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1948 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1949 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1950 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1951 bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1952 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1953
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1954 proc findprev {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1955 global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1956 if {![info exists matchinglines]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1957 dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1958 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1959 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1960 if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1961 set prev {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1962 foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1963 if {$l >= $selectedline} break
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1964 set prev $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1965 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1966 if {$prev != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1967 findselectline $prev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1968 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1969 bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1970 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
1971 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2276 proc markmatches {canv l str tag matches font} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2277 set bbox [$canv bbox $tag]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2278 set x0 [lindex $bbox 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2279 set y0 [lindex $bbox 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2280 set y1 [lindex $bbox 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2281 foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2282 set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2283 set end [lindex $match 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2284 if {$start > $end} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2285 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2286 set xlen [font measure $font [string range $str 0 [expr $end]]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2287 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2288 -outline {} -tags matches -fill yellow]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2289 $canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2290 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2291 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2292
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2295 allcanvs delete matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2298 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2303 set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2304 if {$ymax == {}} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2305 set yfrac [lindex [$canv yview] 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2306 set y [expr {$y + $yfrac * $ymax}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2307 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2308 if {$l < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2309 set l 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2326 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2354 global canv canv2 canv3 ctext commitinfo selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2362 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2363 $canv delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2364 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2365 -tags secsel -fill [$canv cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2366 $canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2367 $canv2 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2368 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2369 -tags secsel -fill [$canv2 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2370 $canv2 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2371 $canv3 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2372 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2373 -tags secsel -fill [$canv3 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2374 $canv3 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2375 set y [expr {$canvy0 + $l * $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2376 set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2377 set ytop [expr {$y - $linespc - 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2378 set ybot [expr {$y + $linespc + 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2379 set wnow [$canv yview]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2380 set wtop [expr [lindex $wnow 0] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2381 set wbot [expr [lindex $wnow 1] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2382 set wh [expr {$wbot - $wtop}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2383 set newtop $wtop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2384 if {$ytop < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2385 if {$ybot < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2386 set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2387 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2388 set newtop $ytop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2389 if {$newtop > $wtop - $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2390 set newtop [expr {$wtop - $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2391 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2392 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2393 } elseif {$ybot > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2394 if {$ytop > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2395 set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2396 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2397 set newtop [expr {$ybot - $wh}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2398 if {$newtop < $wtop + $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2399 set newtop [expr {$wtop + $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2400 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2401 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2402 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2403 if {$newtop != $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2404 if {$newtop < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2405 set newtop 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2406 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2407 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2414 set selectedline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2415
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2416 set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2417 set currentid $id
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2418 $sha1entry delete 0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2419 $sha1entry insert 0 $id
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2420 $sha1entry selection from 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2421 $sha1entry selection to end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2422
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2423 $ctext conf -state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2433 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2443 if {[info exists idtags($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2444 $ctext insert end "Tags:"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2445 foreach tag $idtags($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2446 $ctext insert end " $tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2447 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2448 $ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2468 $ctext tag delete Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2469 $ctext tag remove found 1.0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2470 $ctext conf -state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2471 set commentend [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2472
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2483 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2484 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2485
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2486 proc selnextline {dir} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2487 global selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2488 if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2489 set l [expr $selectedline + $dir]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2564 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2652 $cflist insert end $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
2854 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3038 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3115 set n [gets $gdtf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3116 if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3117 if {![eof $gdtf]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3130 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3136 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3147 puts "error getting diffs: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3148 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3153 set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3154 set curtagstart 0.0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3158 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3166 set n [gets $bdf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3167 if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3168 if {[eof $bdf]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3171 $ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3172 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3173 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3174 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3177 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3182 # start of a new file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3183 $ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3184 $ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3204 set curdifftag "f:$fname"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3205 $ctext tag delete $curdifftag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3206 set l [expr {(78 - [string length $header]) / 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3207 set pad [string range "----------------------------------------" 1 $l]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3212 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3222 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3223 set x [string range $line 0 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3224 if {$x == "-" || $x == "+"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3229 $ctext insert end "$line\n" d$tag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3236 # e.g. "\ No newline at end of file"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3239 # Something else we don't recognize
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3240 if {$curdifftag != "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3241 $ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3242 $ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3243 set curtagstart [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3244 set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3245 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3246 $ctext insert end "$line\n" filesep
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3247 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3248 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3256 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3257
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3258 proc nextfile {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3259 global difffilestart ctext
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3260 set here [$ctext index @0,0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3261 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3267 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3272 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3273
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3281 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3282
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3283 proc setcoords {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3287 set linespc [font metrics $mainfont -linespace]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3288 set charspc [font measure $mainfont "m"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3289 set canvy0 [expr 3 + 0.5 * $linespc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3294 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3295
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3298 if {$stopped > 1} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3299 if {$phase == "getcommits"} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3302 set stopped 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3303 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3304 drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3305 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3306 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3307
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3311 unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3314 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3315 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3316 setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3317 $ctext conf -font $textfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3318 $ctext tag conf filesep -font [concat $textfont bold]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3319 foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3320 $e conf -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3321 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3322 if {$phase == "getcommits"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3323 $canv itemconf textitems -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3324 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3325 redisplay
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3326 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3335 proc sha1change {n1 n2 op} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3336 global sha1string currentid sha1but
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3337 if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3338 || ([info exists currentid] && $sha1string == $currentid)} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3339 set state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3340 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3341 set state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3342 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3343 if {[$sha1but cget -state] == $state} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3344 if {$state == "normal"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3345 $sha1but conf -state normal -relief raised -text "Goto: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3346 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3347 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3348 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3349 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3350
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3351 proc gotocommit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3355 if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3356 || ([info exists currentid] && $sha1string == $currentid)} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3357 if {[info exists tagids($sha1string)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3358 set id $tagids($sha1string)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3359 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3376 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3379 return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3382 set type "SHA1 id"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3383 } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3384 set type "Tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3385 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3386 error_popup "$type $sha1string is not known"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3387 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3887 global idtags idheads idotherrefs idbookmarks
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3888
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3889 set w {}
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3890 if {[info exists idbookmarks($id)]} {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3891 set w $idbookmarks($id)
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3909 global idbookmarks idtags idheads idotherrefs
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3913 [array names idheads] [array names idotherrefs] \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3920 foreach v {tagids idtags headids idheads otherrefids idotherrefs \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
3926 [array names idheads] [array names idotherrefs] \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3975 proc doquit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3976 global stopped
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3977 set stopped 100
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3978 destroy .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3979 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3994 # defaults...
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3995 set datemode 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3996 set boldnames 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
3999
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4000 set mainfont {Helvetica 9}
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
4001 set curidfont {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4007
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4029 set namefont $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4030 if {$boldnames} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4031 lappend namefont bold
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4032 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4033
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4034 set revtreeargs {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4035 foreach arg $argv {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4036 switch -regexp -- $arg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4037 "^$" { }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4038 "^-b" { set boldnames 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4039 "^-d" { set datemode 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4040 default {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4041 lappend revtreeargs $arg
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4042 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4043 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4044 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4049 set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4050 set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4056 setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
4057 makewindow
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
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