Mercurial > hg > mercurial-crew-with-dirclash

annotate contrib/hgk @ 4501:b2338c0cf468

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