annotate contrib/hgk @ 22483:a21d04848359

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