Show More
@@ -0,0 +1,243 b'' | |||||
|
1 | #!/usr/bin/env python | |||
|
2 | # | |||
|
3 | # Minimal support for git commands on an hg repository | |||
|
4 | # | |||
|
5 | # Copyright 2005 Chris Mason <mason@suse.com> | |||
|
6 | # | |||
|
7 | # This software may be used and distributed according to the terms | |||
|
8 | # of the GNU General Public License, incorporated herein by reference. | |||
|
9 | ||||
|
10 | import time, sys, signal | |||
|
11 | from mercurial import hg, mdiff, fancyopts, commands, ui | |||
|
12 | ||||
|
13 | def difftree(args, repo): | |||
|
14 | def __difftree(repo, files = None, node1 = None, node2 = None): | |||
|
15 | def date(c): | |||
|
16 | return time.asctime(time.gmtime(float(c[2].split(' ')[0]))) | |||
|
17 | ||||
|
18 | if node2: | |||
|
19 | change = repo.changelog.read(node2) | |||
|
20 | mmap2 = repo.manifest.read(change[0]) | |||
|
21 | (c, a, d) = repo.diffrevs(node1, node2) | |||
|
22 | def read(f): return repo.file(f).read(mmap2[f]) | |||
|
23 | date2 = date(change) | |||
|
24 | else: | |||
|
25 | date2 = time.asctime() | |||
|
26 | (c, a, d, u) = repo.diffdir(repo.root, node1) | |||
|
27 | if not node1: | |||
|
28 | node1 = repo.dirstate.parents()[0] | |||
|
29 | def read(f): return file(os.path.join(repo.root, f)).read() | |||
|
30 | ||||
|
31 | change = repo.changelog.read(node1) | |||
|
32 | mmap = repo.manifest.read(change[0]) | |||
|
33 | date1 = date(change) | |||
|
34 | empty = "0" * 40; | |||
|
35 | ||||
|
36 | if files: | |||
|
37 | c, a, d = map(lambda x: filterfiles(files, x), (c, a, d)) | |||
|
38 | ||||
|
39 | for f in c: | |||
|
40 | # TODO get file permissions | |||
|
41 | print ":100664 100664 %s %s %s %s" % (hg.hex(mmap[f]), | |||
|
42 | hg.hex(mmap2[f]), f, f) | |||
|
43 | for f in a: | |||
|
44 | print ":000000 100664 %s %s %s %s" % (empty, hg.hex(mmap2[f]), f, f) | |||
|
45 | for f in d: | |||
|
46 | print ":100664 000000 %s %s %s %s" % (hg.hex(mmap[f]), empty, f, f) | |||
|
47 | ## | |||
|
48 | ||||
|
49 | revs = [] | |||
|
50 | if args: | |||
|
51 | doptions = {} | |||
|
52 | opts = [('p', 'patch', None, 'patch'), | |||
|
53 | ('r', 'recursive', None, 'recursive')] | |||
|
54 | args = fancyopts.fancyopts(args, opts, doptions, | |||
|
55 | 'hg diff-tree [options] sha1 sha1') | |||
|
56 | ||||
|
57 | if len(args) < 2: | |||
|
58 | help() | |||
|
59 | sys.exit(1) | |||
|
60 | revs.append(repo.lookup(args[0])) | |||
|
61 | revs.append(repo.lookup(args[1])) | |||
|
62 | args = args[2:] | |||
|
63 | if doptions['patch']: | |||
|
64 | commands.dodiff(repo, args, *revs) | |||
|
65 | else: | |||
|
66 | __difftree(repo, args, *revs) | |||
|
67 | ||||
|
68 | def catcommit(repo, n, prefix): | |||
|
69 | nlprefix = '\n' + prefix; | |||
|
70 | changes = repo.changelog.read(n) | |||
|
71 | (p1, p2) = repo.changelog.parents(n) | |||
|
72 | (h, h1, h2) = map(hg.hex, (n, p1, p2)) | |||
|
73 | (i1, i2) = map(repo.changelog.rev, (p1, p2)) | |||
|
74 | print "tree %s" % (h) | |||
|
75 | if i1 != -1: print "%sparent %s" % (prefix, h1) | |||
|
76 | if i2 != -1: print "%sparent %s" % (prefix, h2) | |||
|
77 | date_ar = changes[2].split(' ') | |||
|
78 | date = int(float(date_ar[0])) | |||
|
79 | print "%sauthor <%s> %s %s" % (prefix, changes[1], date, date_ar[1]) | |||
|
80 | print "%scommitter <%s> %s %s" % (prefix, changes[1], date, date_ar[1]) | |||
|
81 | print prefix | |||
|
82 | if prefix != "": | |||
|
83 | print "%s%s" % (prefix, changes[4].replace('\n', nlprefix).strip()) | |||
|
84 | else: | |||
|
85 | print changes[4] | |||
|
86 | ||||
|
87 | def catfile(args, ui, repo): | |||
|
88 | doptions = {} | |||
|
89 | opts = [('s', 'stdin', None, 'stdin')] | |||
|
90 | args = fancyopts.fancyopts(args, opts, doptions, | |||
|
91 | 'hg cat-file type sha1') | |||
|
92 | ||||
|
93 | # in stdin mode, every line except the commit is prefixed with two | |||
|
94 | # spaces. This way the our caller can find the commit without magic | |||
|
95 | # strings | |||
|
96 | # | |||
|
97 | prefix = "" | |||
|
98 | if doptions['stdin']: | |||
|
99 | try: | |||
|
100 | (type, r) = raw_input().split(' '); | |||
|
101 | prefix = " " | |||
|
102 | except EOFError: | |||
|
103 | return | |||
|
104 | ||||
|
105 | else: | |||
|
106 | if len(args) < 2: | |||
|
107 | help() | |||
|
108 | sys.exit(1) | |||
|
109 | type = args[0] | |||
|
110 | r = args[1] | |||
|
111 | ||||
|
112 | while r: | |||
|
113 | if type != "commit": | |||
|
114 | sys.stderr.write("aborting hg cat-file only understands commits\n") | |||
|
115 | sys.exit(1); | |||
|
116 | n = repo.changelog.lookup(r) | |||
|
117 | catcommit(repo, n, prefix) | |||
|
118 | if doptions['stdin']: | |||
|
119 | try: | |||
|
120 | (type, r) = raw_input().split(' '); | |||
|
121 | except EOFError: | |||
|
122 | break | |||
|
123 | else: | |||
|
124 | break | |||
|
125 | ||||
|
126 | # git rev-tree is a confusing thing. You can supply a number of | |||
|
127 | # commit sha1s on the command line, and it walks the commit history | |||
|
128 | # telling you which commits are reachable from the supplied ones via | |||
|
129 | # a bitmask based on arg position. | |||
|
130 | # you can specify a commit to stop at by starting the sha1 with ^ | |||
|
131 | def revtree(args, repo): | |||
|
132 | # calculate and return the reachability bitmask for sha | |||
|
133 | def is_reachable(ar, reachable, sha): | |||
|
134 | if len(ar) == 0: | |||
|
135 | return 1 | |||
|
136 | mask = 0 | |||
|
137 | for i in range(len(ar)): | |||
|
138 | if sha in reachable[i]: | |||
|
139 | mask |= 1 << i | |||
|
140 | ||||
|
141 | return mask | |||
|
142 | ||||
|
143 | reachable = [] | |||
|
144 | stop_sha1 = [] | |||
|
145 | want_sha1 = [] | |||
|
146 | ||||
|
147 | # figure out which commits they are asking for and which ones they | |||
|
148 | # want us to stop on | |||
|
149 | for i in range(len(args)): | |||
|
150 | if args[i].count('^'): | |||
|
151 | s = args[i].split('^')[1] | |||
|
152 | stop_sha1.append(repo.changelog.lookup(s)) | |||
|
153 | want_sha1.append(s) | |||
|
154 | elif args[i] != 'HEAD': | |||
|
155 | want_sha1.append(args[i]) | |||
|
156 | # calculate the graph for the supplied commits | |||
|
157 | for i in range(len(want_sha1)): | |||
|
158 | reachable.append({}); | |||
|
159 | n = repo.changelog.lookup(want_sha1[i]); | |||
|
160 | visit = [n]; | |||
|
161 | reachable[i][n] = 1 | |||
|
162 | while visit: | |||
|
163 | n = visit.pop(0) | |||
|
164 | if n in stop_sha1: | |||
|
165 | break | |||
|
166 | for p in repo.changelog.parents(n): | |||
|
167 | if p not in reachable[i]: | |||
|
168 | reachable[i][p] = 1 | |||
|
169 | visit.append(p) | |||
|
170 | if p in stop_sha1: | |||
|
171 | break | |||
|
172 | # walk the repository looking for commits that are in our | |||
|
173 | # reachability graph | |||
|
174 | for i in range(repo.changelog.count()): | |||
|
175 | n = repo.changelog.node(i) | |||
|
176 | mask = is_reachable(want_sha1, reachable, n) | |||
|
177 | if mask: | |||
|
178 | changes = repo.changelog.read(n) | |||
|
179 | (p1, p2) = repo.changelog.parents(n) | |||
|
180 | (h, h1, h2) = map(hg.hex, (n, p1, p2)) | |||
|
181 | (i1, i2) = map(repo.changelog.rev, (p1, p2)) | |||
|
182 | ||||
|
183 | date = changes[2].split(' ')[0] | |||
|
184 | print "%s %s:%s" % (date, h, mask), | |||
|
185 | mask = is_reachable(want_sha1, reachable, p1) | |||
|
186 | if i1 != -1 and mask > 0: | |||
|
187 | print "%s:%s " % (h1, mask), | |||
|
188 | mask = is_reachable(want_sha1, reachable, p2) | |||
|
189 | if i2 != -1 and mask > 0: | |||
|
190 | print "%s:%s " % (h2, mask), | |||
|
191 | print "" | |||
|
192 | ||||
|
193 | # git rev-list tries to order things by date, and has the ability to stop | |||
|
194 | # at a given commit without walking the whole repo. TODO add the stop | |||
|
195 | # parameter | |||
|
196 | def revlist(args, repo): | |||
|
197 | doptions = {} | |||
|
198 | opts = [('c', 'commit', None, 'commit')] | |||
|
199 | args = fancyopts.fancyopts(args, opts, doptions, | |||
|
200 | 'hg rev-list') | |||
|
201 | for i in range(repo.changelog.count()): | |||
|
202 | n = repo.changelog.node(i) | |||
|
203 | print hg.hex(n) | |||
|
204 | if doptions['commit']: | |||
|
205 | catcommit(repo, n, ' ') | |||
|
206 | ||||
|
207 | def catchterm(*args): | |||
|
208 | raise SignalInterrupt | |||
|
209 | ||||
|
210 | def help(): | |||
|
211 | sys.stderr.write("commands:\n") | |||
|
212 | sys.stderr.write(" hgit cat-file [type] sha1\n") | |||
|
213 | sys.stderr.write(" hgit diff-tree [-p] [-r] sha1 sha1\n") | |||
|
214 | sys.stderr.write(" hgit rev-tree [sha1 ... [^stop sha1]]\n") | |||
|
215 | sys.stderr.write(" hgit rev-list [-c]\n") | |||
|
216 | ||||
|
217 | cmd = sys.argv[1] | |||
|
218 | args = sys.argv[2:] | |||
|
219 | u = ui.ui() | |||
|
220 | signal.signal(signal.SIGTERM, catchterm) | |||
|
221 | repo = hg.repository(ui = u) | |||
|
222 | ||||
|
223 | if cmd == "diff-tree": | |||
|
224 | difftree(args, repo) | |||
|
225 | ||||
|
226 | elif cmd == "cat-file": | |||
|
227 | catfile(args, ui, repo) | |||
|
228 | ||||
|
229 | elif cmd == "rev-tree": | |||
|
230 | revtree(args, repo) | |||
|
231 | ||||
|
232 | elif cmd == "rev-list": | |||
|
233 | revlist(args, repo) | |||
|
234 | ||||
|
235 | elif cmd == "help": | |||
|
236 | help() | |||
|
237 | ||||
|
238 | else: | |||
|
239 | if cmd: sys.stderr.write("unknown command\n\n") | |||
|
240 | help() | |||
|
241 | sys.exit(1) | |||
|
242 | ||||
|
243 | sys.exit(0) |
This diff has been collapsed as it changes many lines, (1447 lines changed) Show them Hide them | |||||
@@ -0,0 +1,1447 b'' | |||||
|
1 | #!/bin/sh | |||
|
2 | # Tcl ignores the next line -*- tcl -*- \ | |||
|
3 | exec wish "$0" -- "${1+$@}" | |||
|
4 | ||||
|
5 | # Copyright (C) 2005 Paul Mackerras. All rights reserved. | |||
|
6 | # This program is free software; it may be used, copied, modified | |||
|
7 | # and distributed under the terms of the GNU General Public Licence, | |||
|
8 | # either version 2, or (at your option) any later version. | |||
|
9 | ||||
|
10 | # CVS $Revision: 1.20 $ | |||
|
11 | ||||
|
12 | proc readfullcommits {rargs} { | |||
|
13 | global commits commfd phase canv mainfont curcommit allcommitstate | |||
|
14 | if {$rargs == {}} { | |||
|
15 | set rargs HEAD | |||
|
16 | } | |||
|
17 | set commits {} | |||
|
18 | set curcommit {} | |||
|
19 | set allcommitstate none | |||
|
20 | set phase getcommits | |||
|
21 | if [catch {set commfd [open "|hgit rev-list -c $rargs" r]} err] { | |||
|
22 | puts stderr "Error executing hgit rev-list: $err" | |||
|
23 | exit 1 | |||
|
24 | } | |||
|
25 | fconfigure $commfd -blocking 0 | |||
|
26 | fileevent $commfd readable "getallcommitline $commfd" | |||
|
27 | $canv delete all | |||
|
28 | $canv create text 3 3 -anchor nw -text "Reading all commits..." \ | |||
|
29 | -font $mainfont -tags textitems | |||
|
30 | } | |||
|
31 | ||||
|
32 | proc getcommitline {commfd} { | |||
|
33 | global commits parents cdate nparents children nchildren | |||
|
34 | set n [gets $commfd line] | |||
|
35 | if {$n < 0} { | |||
|
36 | if {![eof $commfd]} return | |||
|
37 | # this works around what is apparently a bug in Tcl... | |||
|
38 | fconfigure $commfd -blocking 1 | |||
|
39 | if {![catch {close $commfd} err]} { | |||
|
40 | after idle readallcommits | |||
|
41 | return | |||
|
42 | } | |||
|
43 | if {[string range $err 0 4] == "usage"} { | |||
|
44 | set err "\ | |||
|
45 | Gitk: error reading commits: bad arguments to hgit rev-list.\n\ | |||
|
46 | (Note: arguments to gitk are passed to hgit rev-list\ | |||
|
47 | to allow selection of commits to be displayed.)" | |||
|
48 | } else { | |||
|
49 | set err "Error reading commits: $err" | |||
|
50 | } | |||
|
51 | error_popup $err | |||
|
52 | exit 1 | |||
|
53 | } | |||
|
54 | if {![regexp {^[0-9a-f]{40}$} $line]} { | |||
|
55 | error_popup "Can't parse hgit rev-tree output: {$line}" | |||
|
56 | exit 1 | |||
|
57 | } | |||
|
58 | lappend commits $line | |||
|
59 | } | |||
|
60 | ||||
|
61 | proc readallcommits {} { | |||
|
62 | global commits | |||
|
63 | foreach id $commits { | |||
|
64 | readcommit $id | |||
|
65 | update | |||
|
66 | } | |||
|
67 | drawgraph | |||
|
68 | } | |||
|
69 | ||||
|
70 | proc readonecommit {id contents} { | |||
|
71 | global commitinfo children nchildren parents nparents cdate | |||
|
72 | set inhdr 1 | |||
|
73 | set comment {} | |||
|
74 | set headline {} | |||
|
75 | set auname {} | |||
|
76 | set audate {} | |||
|
77 | set comname {} | |||
|
78 | set comdate {} | |||
|
79 | if {![info exists nchildren($id)]} { | |||
|
80 | set children($id) {} | |||
|
81 | set nchildren($id) 0 | |||
|
82 | } | |||
|
83 | set parents($id) {} | |||
|
84 | set nparents($id) 0 | |||
|
85 | foreach line [split $contents "\n"] { | |||
|
86 | if {$inhdr} { | |||
|
87 | if {$line == {}} { | |||
|
88 | set inhdr 0 | |||
|
89 | } else { | |||
|
90 | set tag [lindex $line 0] | |||
|
91 | if {$tag == "parent"} { | |||
|
92 | set p [lindex $line 1] | |||
|
93 | if {![info exists nchildren($p)]} { | |||
|
94 | set children($p) {} | |||
|
95 | set nchildren($p) 0 | |||
|
96 | } | |||
|
97 | lappend parents($id) $p | |||
|
98 | incr nparents($id) | |||
|
99 | if {[lsearch -exact $children($p) $id] < 0} { | |||
|
100 | lappend children($p) $id | |||
|
101 | incr nchildren($p) | |||
|
102 | } | |||
|
103 | } elseif {$tag == "author"} { | |||
|
104 | set x [expr {[llength $line] - 2}] | |||
|
105 | set audate [lindex $line $x] | |||
|
106 | set auname [lrange $line 1 [expr {$x - 1}]] | |||
|
107 | } elseif {$tag == "committer"} { | |||
|
108 | set x [expr {[llength $line] - 2}] | |||
|
109 | set comdate [lindex $line $x] | |||
|
110 | set comname [lrange $line 1 [expr {$x - 1}]] | |||
|
111 | } | |||
|
112 | } | |||
|
113 | } else { | |||
|
114 | if {$comment == {}} { | |||
|
115 | set headline $line | |||
|
116 | } else { | |||
|
117 | append comment "\n" | |||
|
118 | } | |||
|
119 | append comment $line | |||
|
120 | } | |||
|
121 | } | |||
|
122 | if {$audate != {}} { | |||
|
123 | set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"] | |||
|
124 | } | |||
|
125 | if {$comdate != {}} { | |||
|
126 | set cdate($id) $comdate | |||
|
127 | set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"] | |||
|
128 | } | |||
|
129 | set commitinfo($id) [list $headline $auname $audate \ | |||
|
130 | $comname $comdate $comment] | |||
|
131 | } | |||
|
132 | ||||
|
133 | proc getallcommitline {commfd} { | |||
|
134 | global commits allcommitstate curcommit curcommitid | |||
|
135 | set n [gets $commfd line] | |||
|
136 | set s "\n" | |||
|
137 | if {$n < 0} { | |||
|
138 | if {![eof $commfd]} return | |||
|
139 | # this works around what is apparently a bug in Tcl... | |||
|
140 | fconfigure $commfd -blocking 1 | |||
|
141 | if {![catch {close $commfd} err]} { | |||
|
142 | after idle drawgraph | |||
|
143 | return | |||
|
144 | } | |||
|
145 | if {[string range $err 0 4] == "usage"} { | |||
|
146 | set err "\ | |||
|
147 | Gitk: error reading commits: bad arguments to hgit rev-list.\n\ | |||
|
148 | (Note: arguments to gitk are passed to hgit rev-list\ | |||
|
149 | to allow selection of commits to be displayed.)" | |||
|
150 | } else { | |||
|
151 | set err "Error reading commits: $err" | |||
|
152 | } | |||
|
153 | error_popup $err | |||
|
154 | exit 1 | |||
|
155 | } | |||
|
156 | if {[string range $line 0 1] != " "} { | |||
|
157 | if {$allcommitstate == "indent"} { | |||
|
158 | readonecommit $curcommitid $curcommit | |||
|
159 | } | |||
|
160 | if {$allcommitstate == "start"} { | |||
|
161 | set curcommit $curcommit$line$s | |||
|
162 | set allcommitstate "indent" | |||
|
163 | } else { | |||
|
164 | set curcommitid $line | |||
|
165 | set curcommit {} | |||
|
166 | set allcommitstate "start" | |||
|
167 | lappend commits $line | |||
|
168 | } | |||
|
169 | } else { | |||
|
170 | set d [string range $line 2 end] | |||
|
171 | set curcommit $curcommit$d$s | |||
|
172 | } | |||
|
173 | } | |||
|
174 | ||||
|
175 | proc getcommits {rargs} { | |||
|
176 | global commits commfd phase canv mainfont | |||
|
177 | if {$rargs == {}} { | |||
|
178 | set rargs HEAD | |||
|
179 | } | |||
|
180 | set commits {} | |||
|
181 | set phase getcommits | |||
|
182 | if [catch {set commfd [open "|hgit rev-list $rargs" r]} err] { | |||
|
183 | puts stderr "Error executing hgit rev-list: $err" | |||
|
184 | exit 1 | |||
|
185 | } | |||
|
186 | fconfigure $commfd -blocking 0 | |||
|
187 | fileevent $commfd readable "getcommitline $commfd" | |||
|
188 | $canv delete all | |||
|
189 | $canv create text 3 3 -anchor nw -text "Reading commits..." \ | |||
|
190 | -font $mainfont -tags textitems | |||
|
191 | } | |||
|
192 | ||||
|
193 | proc readcommit {id} { | |||
|
194 | global commitinfo children nchildren parents nparents cdate | |||
|
195 | set inhdr 1 | |||
|
196 | set comment {} | |||
|
197 | set headline {} | |||
|
198 | set auname {} | |||
|
199 | set audate {} | |||
|
200 | set comname {} | |||
|
201 | set comdate {} | |||
|
202 | if {![info exists nchildren($id)]} { | |||
|
203 | set children($id) {} | |||
|
204 | set nchildren($id) 0 | |||
|
205 | } | |||
|
206 | set parents($id) {} | |||
|
207 | set nparents($id) 0 | |||
|
208 | if [catch {set contents [exec hgit cat-file commit $id]}] return | |||
|
209 | readonecommit $id $contents | |||
|
210 | } | |||
|
211 | ||||
|
212 | proc readrefs {} { | |||
|
213 | global tagids idtags | |||
|
214 | set tags [glob -nocomplain -types f .git/refs/tags/*] | |||
|
215 | foreach f $tags { | |||
|
216 | catch { | |||
|
217 | set fd [open $f r] | |||
|
218 | set line [read $fd] | |||
|
219 | if {[regexp {^[0-9a-f]{40}} $line id]} { | |||
|
220 | set contents [split [exec hgit cat-file tag $id] "\n"] | |||
|
221 | set obj {} | |||
|
222 | set type {} | |||
|
223 | set tag {} | |||
|
224 | foreach l $contents { | |||
|
225 | if {$l == {}} break | |||
|
226 | switch -- [lindex $l 0] { | |||
|
227 | "object" {set obj [lindex $l 1]} | |||
|
228 | "type" {set type [lindex $l 1]} | |||
|
229 | "tag" {set tag [string range $l 4 end]} | |||
|
230 | } | |||
|
231 | } | |||
|
232 | if {$obj != {} && $type == "commit" && $tag != {}} { | |||
|
233 | set tagids($tag) $obj | |||
|
234 | lappend idtags($obj) $tag | |||
|
235 | } | |||
|
236 | } | |||
|
237 | } | |||
|
238 | } | |||
|
239 | } | |||
|
240 | ||||
|
241 | proc error_popup msg { | |||
|
242 | set w .error | |||
|
243 | toplevel $w | |||
|
244 | wm transient $w . | |||
|
245 | message $w.m -text $msg -justify center -aspect 400 | |||
|
246 | pack $w.m -side top -fill x -padx 20 -pady 20 | |||
|
247 | button $w.ok -text OK -command "destroy $w" | |||
|
248 | pack $w.ok -side bottom -fill x | |||
|
249 | bind $w <Visibility> "grab $w; focus $w" | |||
|
250 | tkwait window $w | |||
|
251 | } | |||
|
252 | ||||
|
253 | proc makewindow {} { | |||
|
254 | global canv canv2 canv3 linespc charspc ctext cflist textfont | |||
|
255 | global findtype findloc findstring fstring geometry | |||
|
256 | global entries sha1entry sha1string sha1but | |||
|
257 | ||||
|
258 | menu .bar | |||
|
259 | .bar add cascade -label "File" -menu .bar.file | |||
|
260 | menu .bar.file | |||
|
261 | .bar.file add command -label "Quit" -command doquit | |||
|
262 | menu .bar.help | |||
|
263 | .bar add cascade -label "Help" -menu .bar.help | |||
|
264 | .bar.help add command -label "About gitk" -command about | |||
|
265 | . configure -menu .bar | |||
|
266 | ||||
|
267 | if {![info exists geometry(canv1)]} { | |||
|
268 | set geometry(canv1) [expr 45 * $charspc] | |||
|
269 | set geometry(canv2) [expr 30 * $charspc] | |||
|
270 | set geometry(canv3) [expr 15 * $charspc] | |||
|
271 | set geometry(canvh) [expr 25 * $linespc + 4] | |||
|
272 | set geometry(ctextw) 80 | |||
|
273 | set geometry(ctexth) 30 | |||
|
274 | set geometry(cflistw) 30 | |||
|
275 | } | |||
|
276 | panedwindow .ctop -orient vertical | |||
|
277 | if {[info exists geometry(width)]} { | |||
|
278 | .ctop conf -width $geometry(width) -height $geometry(height) | |||
|
279 | set texth [expr {$geometry(height) - $geometry(canvh) - 56}] | |||
|
280 | set geometry(ctexth) [expr {($texth - 8) / | |||
|
281 | [font metrics $textfont -linespace]}] | |||
|
282 | } | |||
|
283 | frame .ctop.top | |||
|
284 | frame .ctop.top.bar | |||
|
285 | pack .ctop.top.bar -side bottom -fill x | |||
|
286 | set cscroll .ctop.top.csb | |||
|
287 | scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 | |||
|
288 | pack $cscroll -side right -fill y | |||
|
289 | panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 | |||
|
290 | pack .ctop.top.clist -side top -fill both -expand 1 | |||
|
291 | .ctop add .ctop.top | |||
|
292 | set canv .ctop.top.clist.canv | |||
|
293 | canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ | |||
|
294 | -bg white -bd 0 \ | |||
|
295 | -yscrollincr $linespc -yscrollcommand "$cscroll set" | |||
|
296 | .ctop.top.clist add $canv | |||
|
297 | set canv2 .ctop.top.clist.canv2 | |||
|
298 | canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ | |||
|
299 | -bg white -bd 0 -yscrollincr $linespc | |||
|
300 | .ctop.top.clist add $canv2 | |||
|
301 | set canv3 .ctop.top.clist.canv3 | |||
|
302 | canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ | |||
|
303 | -bg white -bd 0 -yscrollincr $linespc | |||
|
304 | .ctop.top.clist add $canv3 | |||
|
305 | bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} | |||
|
306 | ||||
|
307 | set sha1entry .ctop.top.bar.sha1 | |||
|
308 | set entries $sha1entry | |||
|
309 | set sha1but .ctop.top.bar.sha1label | |||
|
310 | button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ | |||
|
311 | -command gotocommit -width 8 | |||
|
312 | $sha1but conf -disabledforeground [$sha1but cget -foreground] | |||
|
313 | pack .ctop.top.bar.sha1label -side left | |||
|
314 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string | |||
|
315 | trace add variable sha1string write sha1change | |||
|
316 | pack $sha1entry -side left -pady 2 | |||
|
317 | button .ctop.top.bar.findbut -text "Find" -command dofind | |||
|
318 | pack .ctop.top.bar.findbut -side left | |||
|
319 | set findstring {} | |||
|
320 | set fstring .ctop.top.bar.findstring | |||
|
321 | lappend entries $fstring | |||
|
322 | entry $fstring -width 30 -font $textfont -textvariable findstring | |||
|
323 | pack $fstring -side left -expand 1 -fill x | |||
|
324 | set findtype Exact | |||
|
325 | tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp | |||
|
326 | set findloc "All fields" | |||
|
327 | tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ | |||
|
328 | Comments Author Committer | |||
|
329 | pack .ctop.top.bar.findloc -side right | |||
|
330 | pack .ctop.top.bar.findtype -side right | |||
|
331 | ||||
|
332 | panedwindow .ctop.cdet -orient horizontal | |||
|
333 | .ctop add .ctop.cdet | |||
|
334 | frame .ctop.cdet.left | |||
|
335 | set ctext .ctop.cdet.left.ctext | |||
|
336 | text $ctext -bg white -state disabled -font $textfont \ | |||
|
337 | -width $geometry(ctextw) -height $geometry(ctexth) \ | |||
|
338 | -yscrollcommand ".ctop.cdet.left.sb set" | |||
|
339 | scrollbar .ctop.cdet.left.sb -command "$ctext yview" | |||
|
340 | pack .ctop.cdet.left.sb -side right -fill y | |||
|
341 | pack $ctext -side left -fill both -expand 1 | |||
|
342 | .ctop.cdet add .ctop.cdet.left | |||
|
343 | ||||
|
344 | $ctext tag conf filesep -font [concat $textfont bold] | |||
|
345 | $ctext tag conf hunksep -back blue -fore white | |||
|
346 | $ctext tag conf d0 -back "#ff8080" | |||
|
347 | $ctext tag conf d1 -back green | |||
|
348 | $ctext tag conf found -back yellow | |||
|
349 | ||||
|
350 | frame .ctop.cdet.right | |||
|
351 | set cflist .ctop.cdet.right.cfiles | |||
|
352 | listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ | |||
|
353 | -yscrollcommand ".ctop.cdet.right.sb set" | |||
|
354 | scrollbar .ctop.cdet.right.sb -command "$cflist yview" | |||
|
355 | pack .ctop.cdet.right.sb -side right -fill y | |||
|
356 | pack $cflist -side left -fill both -expand 1 | |||
|
357 | .ctop.cdet add .ctop.cdet.right | |||
|
358 | bind .ctop.cdet <Configure> {resizecdetpanes %W %w} | |||
|
359 | ||||
|
360 | pack .ctop -side top -fill both -expand 1 | |||
|
361 | ||||
|
362 | bindall <1> {selcanvline %x %y} | |||
|
363 | bindall <B1-Motion> {selcanvline %x %y} | |||
|
364 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" | |||
|
365 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |||
|
366 | bindall <2> "allcanvs scan mark 0 %y" | |||
|
367 | bindall <B2-Motion> "allcanvs scan dragto 0 %y" | |||
|
368 | bind . <Key-Up> "selnextline -1" | |||
|
369 | bind . <Key-Down> "selnextline 1" | |||
|
370 | bind . <Key-Prior> "allcanvs yview scroll -1 pages" | |||
|
371 | bind . <Key-Next> "allcanvs yview scroll 1 pages" | |||
|
372 | bindkey <Key-Delete> "$ctext yview scroll -1 pages" | |||
|
373 | bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |||
|
374 | bindkey <Key-space> "$ctext yview scroll 1 pages" | |||
|
375 | bindkey p "selnextline -1" | |||
|
376 | bindkey n "selnextline 1" | |||
|
377 | bindkey b "$ctext yview scroll -1 pages" | |||
|
378 | bindkey d "$ctext yview scroll 18 units" | |||
|
379 | bindkey u "$ctext yview scroll -18 units" | |||
|
380 | bindkey / findnext | |||
|
381 | bindkey ? findprev | |||
|
382 | bindkey f nextfile | |||
|
383 | bind . <Control-q> doquit | |||
|
384 | bind . <Control-f> dofind | |||
|
385 | bind . <Control-g> findnext | |||
|
386 | bind . <Control-r> findprev | |||
|
387 | bind . <Control-equal> {incrfont 1} | |||
|
388 | bind . <Control-KP_Add> {incrfont 1} | |||
|
389 | bind . <Control-minus> {incrfont -1} | |||
|
390 | bind . <Control-KP_Subtract> {incrfont -1} | |||
|
391 | bind $cflist <<ListboxSelect>> listboxsel | |||
|
392 | bind . <Destroy> {savestuff %W} | |||
|
393 | bind . <Button-1> "click %W" | |||
|
394 | bind $fstring <Key-Return> dofind | |||
|
395 | bind $sha1entry <Key-Return> gotocommit | |||
|
396 | } | |||
|
397 | ||||
|
398 | # when we make a key binding for the toplevel, make sure | |||
|
399 | # it doesn't get triggered when that key is pressed in the | |||
|
400 | # find string entry widget. | |||
|
401 | proc bindkey {ev script} { | |||
|
402 | global entries | |||
|
403 | bind . $ev $script | |||
|
404 | set escript [bind Entry $ev] | |||
|
405 | if {$escript == {}} { | |||
|
406 | set escript [bind Entry <Key>] | |||
|
407 | } | |||
|
408 | foreach e $entries { | |||
|
409 | bind $e $ev "$escript; break" | |||
|
410 | } | |||
|
411 | } | |||
|
412 | ||||
|
413 | # set the focus back to the toplevel for any click outside | |||
|
414 | # the entry widgets | |||
|
415 | proc click {w} { | |||
|
416 | global entries | |||
|
417 | foreach e $entries { | |||
|
418 | if {$w == $e} return | |||
|
419 | } | |||
|
420 | focus . | |||
|
421 | } | |||
|
422 | ||||
|
423 | proc savestuff {w} { | |||
|
424 | global canv canv2 canv3 ctext cflist mainfont textfont | |||
|
425 | global stuffsaved | |||
|
426 | if {$stuffsaved} return | |||
|
427 | if {![winfo viewable .]} return | |||
|
428 | catch { | |||
|
429 | set f [open "~/.gitk-new" w] | |||
|
430 | puts $f "set mainfont {$mainfont}" | |||
|
431 | puts $f "set textfont {$textfont}" | |||
|
432 | puts $f "set geometry(width) [winfo width .ctop]" | |||
|
433 | puts $f "set geometry(height) [winfo height .ctop]" | |||
|
434 | puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" | |||
|
435 | puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" | |||
|
436 | puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" | |||
|
437 | puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" | |||
|
438 | set wid [expr {([winfo width $ctext] - 8) \ | |||
|
439 | / [font measure $textfont "0"]}] | |||
|
440 | puts $f "set geometry(ctextw) $wid" | |||
|
441 | set wid [expr {([winfo width $cflist] - 11) \ | |||
|
442 | / [font measure [$cflist cget -font] "0"]}] | |||
|
443 | puts $f "set geometry(cflistw) $wid" | |||
|
444 | close $f | |||
|
445 | file rename -force "~/.gitk-new" "~/.gitk" | |||
|
446 | } | |||
|
447 | set stuffsaved 1 | |||
|
448 | } | |||
|
449 | ||||
|
450 | proc resizeclistpanes {win w} { | |||
|
451 | global oldwidth | |||
|
452 | if [info exists oldwidth($win)] { | |||
|
453 | set s0 [$win sash coord 0] | |||
|
454 | set s1 [$win sash coord 1] | |||
|
455 | if {$w < 60} { | |||
|
456 | set sash0 [expr {int($w/2 - 2)}] | |||
|
457 | set sash1 [expr {int($w*5/6 - 2)}] | |||
|
458 | } else { | |||
|
459 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |||
|
460 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |||
|
461 | set sash1 [expr {int($factor * [lindex $s1 0])}] | |||
|
462 | if {$sash0 < 30} { | |||
|
463 | set sash0 30 | |||
|
464 | } | |||
|
465 | if {$sash1 < $sash0 + 20} { | |||
|
466 | set sash1 [expr $sash0 + 20] | |||
|
467 | } | |||
|
468 | if {$sash1 > $w - 10} { | |||
|
469 | set sash1 [expr $w - 10] | |||
|
470 | if {$sash0 > $sash1 - 20} { | |||
|
471 | set sash0 [expr $sash1 - 20] | |||
|
472 | } | |||
|
473 | } | |||
|
474 | } | |||
|
475 | $win sash place 0 $sash0 [lindex $s0 1] | |||
|
476 | $win sash place 1 $sash1 [lindex $s1 1] | |||
|
477 | } | |||
|
478 | set oldwidth($win) $w | |||
|
479 | } | |||
|
480 | ||||
|
481 | proc resizecdetpanes {win w} { | |||
|
482 | global oldwidth | |||
|
483 | if [info exists oldwidth($win)] { | |||
|
484 | set s0 [$win sash coord 0] | |||
|
485 | if {$w < 60} { | |||
|
486 | set sash0 [expr {int($w*3/4 - 2)}] | |||
|
487 | } else { | |||
|
488 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |||
|
489 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |||
|
490 | if {$sash0 < 45} { | |||
|
491 | set sash0 45 | |||
|
492 | } | |||
|
493 | if {$sash0 > $w - 15} { | |||
|
494 | set sash0 [expr $w - 15] | |||
|
495 | } | |||
|
496 | } | |||
|
497 | $win sash place 0 $sash0 [lindex $s0 1] | |||
|
498 | } | |||
|
499 | set oldwidth($win) $w | |||
|
500 | } | |||
|
501 | ||||
|
502 | proc allcanvs args { | |||
|
503 | global canv canv2 canv3 | |||
|
504 | eval $canv $args | |||
|
505 | eval $canv2 $args | |||
|
506 | eval $canv3 $args | |||
|
507 | } | |||
|
508 | ||||
|
509 | proc bindall {event action} { | |||
|
510 | global canv canv2 canv3 | |||
|
511 | bind $canv $event $action | |||
|
512 | bind $canv2 $event $action | |||
|
513 | bind $canv3 $event $action | |||
|
514 | } | |||
|
515 | ||||
|
516 | proc about {} { | |||
|
517 | set w .about | |||
|
518 | if {[winfo exists $w]} { | |||
|
519 | raise $w | |||
|
520 | return | |||
|
521 | } | |||
|
522 | toplevel $w | |||
|
523 | wm title $w "About gitk" | |||
|
524 | message $w.m -text { | |||
|
525 | Gitk version 1.1 | |||
|
526 | ||||
|
527 | Copyright οΏ½ 2005 Paul Mackerras | |||
|
528 | ||||
|
529 | Use and redistribute under the terms of the GNU General Public License | |||
|
530 | ||||
|
531 | (CVS $Revision: 1.20 $)} \ | |||
|
532 | -justify center -aspect 400 | |||
|
533 | pack $w.m -side top -fill x -padx 20 -pady 20 | |||
|
534 | button $w.ok -text Close -command "destroy $w" | |||
|
535 | pack $w.ok -side bottom | |||
|
536 | } | |||
|
537 | ||||
|
538 | proc truncatetofit {str width font} { | |||
|
539 | if {[font measure $font $str] <= $width} { | |||
|
540 | return $str | |||
|
541 | } | |||
|
542 | set best 0 | |||
|
543 | set bad [string length $str] | |||
|
544 | set tmp $str | |||
|
545 | while {$best < $bad - 1} { | |||
|
546 | set try [expr {int(($best + $bad) / 2)}] | |||
|
547 | set tmp "[string range $str 0 [expr $try-1]]..." | |||
|
548 | if {[font measure $font $tmp] <= $width} { | |||
|
549 | set best $try | |||
|
550 | } else { | |||
|
551 | set bad $try | |||
|
552 | } | |||
|
553 | } | |||
|
554 | return $tmp | |||
|
555 | } | |||
|
556 | ||||
|
557 | proc assigncolor {id} { | |||
|
558 | global commitinfo colormap commcolors colors nextcolor | |||
|
559 | global colorbycommitter | |||
|
560 | global parents nparents children nchildren | |||
|
561 | if [info exists colormap($id)] return | |||
|
562 | set ncolors [llength $colors] | |||
|
563 | if {$colorbycommitter} { | |||
|
564 | if {![info exists commitinfo($id)]} { | |||
|
565 | readcommit $id | |||
|
566 | } | |||
|
567 | set comm [lindex $commitinfo($id) 3] | |||
|
568 | if {![info exists commcolors($comm)]} { | |||
|
569 | set commcolors($comm) [lindex $colors $nextcolor] | |||
|
570 | if {[incr nextcolor] >= $ncolors} { | |||
|
571 | set nextcolor 0 | |||
|
572 | } | |||
|
573 | } | |||
|
574 | set colormap($id) $commcolors($comm) | |||
|
575 | } else { | |||
|
576 | if {$nparents($id) == 1 && $nchildren($id) == 1} { | |||
|
577 | set child [lindex $children($id) 0] | |||
|
578 | if {[info exists colormap($child)] | |||
|
579 | && $nparents($child) == 1} { | |||
|
580 | set colormap($id) $colormap($child) | |||
|
581 | return | |||
|
582 | } | |||
|
583 | } | |||
|
584 | set badcolors {} | |||
|
585 | foreach child $children($id) { | |||
|
586 | if {[info exists colormap($child)] | |||
|
587 | && [lsearch -exact $badcolors $colormap($child)] < 0} { | |||
|
588 | lappend badcolors $colormap($child) | |||
|
589 | } | |||
|
590 | if {[info exists parents($child)]} { | |||
|
591 | foreach p $parents($child) { | |||
|
592 | if {[info exists colormap($p)] | |||
|
593 | && [lsearch -exact $badcolors $colormap($p)] < 0} { | |||
|
594 | lappend badcolors $colormap($p) | |||
|
595 | } | |||
|
596 | } | |||
|
597 | } | |||
|
598 | } | |||
|
599 | if {[llength $badcolors] >= $ncolors} { | |||
|
600 | set badcolors {} | |||
|
601 | } | |||
|
602 | for {set i 0} {$i <= $ncolors} {incr i} { | |||
|
603 | set c [lindex $colors $nextcolor] | |||
|
604 | if {[incr nextcolor] >= $ncolors} { | |||
|
605 | set nextcolor 0 | |||
|
606 | } | |||
|
607 | if {[lsearch -exact $badcolors $c]} break | |||
|
608 | } | |||
|
609 | set colormap($id) $c | |||
|
610 | } | |||
|
611 | } | |||
|
612 | ||||
|
613 | proc drawgraph {} { | |||
|
614 | global parents children nparents nchildren commits | |||
|
615 | global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc | |||
|
616 | global datemode cdate | |||
|
617 | global lineid linehtag linentag linedtag commitinfo | |||
|
618 | global nextcolor colormap numcommits | |||
|
619 | global stopped phase redisplaying selectedline idtags idline | |||
|
620 | ||||
|
621 | allcanvs delete all | |||
|
622 | set start {} | |||
|
623 | foreach id [array names nchildren] { | |||
|
624 | if {$nchildren($id) == 0} { | |||
|
625 | lappend start $id | |||
|
626 | } | |||
|
627 | set ncleft($id) $nchildren($id) | |||
|
628 | if {![info exists nparents($id)]} { | |||
|
629 | set nparents($id) 0 | |||
|
630 | } | |||
|
631 | } | |||
|
632 | if {$start == {}} { | |||
|
633 | error_popup "Gitk: ERROR: No starting commits found" | |||
|
634 | exit 1 | |||
|
635 | } | |||
|
636 | ||||
|
637 | set nextcolor 0 | |||
|
638 | foreach id $start { | |||
|
639 | assigncolor $id | |||
|
640 | } | |||
|
641 | set todo $start | |||
|
642 | set level [expr [llength $todo] - 1] | |||
|
643 | set y2 $canvy0 | |||
|
644 | set nullentry -1 | |||
|
645 | set lineno -1 | |||
|
646 | set numcommits 0 | |||
|
647 | set phase drawgraph | |||
|
648 | set lthickness [expr {($linespc / 9) + 1}] | |||
|
649 | while 1 { | |||
|
650 | set canvy $y2 | |||
|
651 | allcanvs conf -scrollregion \ | |||
|
652 | [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]] | |||
|
653 | update | |||
|
654 | if {$stopped} break | |||
|
655 | incr numcommits | |||
|
656 | incr lineno | |||
|
657 | set nlines [llength $todo] | |||
|
658 | set id [lindex $todo $level] | |||
|
659 | set lineid($lineno) $id | |||
|
660 | set idline($id) $lineno | |||
|
661 | set actualparents {} | |||
|
662 | set ofill white | |||
|
663 | if {[info exists parents($id)]} { | |||
|
664 | foreach p $parents($id) { | |||
|
665 | if {[info exists ncleft($p)]} { | |||
|
666 | incr ncleft($p) -1 | |||
|
667 | if {![info exists commitinfo($p)]} { | |||
|
668 | readcommit $p | |||
|
669 | if {![info exists commitinfo($p)]} continue | |||
|
670 | } | |||
|
671 | lappend actualparents $p | |||
|
672 | set ofill blue | |||
|
673 | } | |||
|
674 | } | |||
|
675 | } | |||
|
676 | if {![info exists commitinfo($id)]} { | |||
|
677 | readcommit $id | |||
|
678 | if {![info exists commitinfo($id)]} { | |||
|
679 | set commitinfo($id) {"No commit information available"} | |||
|
680 | } | |||
|
681 | } | |||
|
682 | set x [expr $canvx0 + $level * $linespc] | |||
|
683 | set y2 [expr $canvy + $linespc] | |||
|
684 | if {[info exists linestarty($level)] && $linestarty($level) < $canvy} { | |||
|
685 | set t [$canv create line $x $linestarty($level) $x $canvy \ | |||
|
686 | -width $lthickness -fill $colormap($id)] | |||
|
687 | $canv lower $t | |||
|
688 | } | |||
|
689 | set linestarty($level) $canvy | |||
|
690 | set orad [expr {$linespc / 3}] | |||
|
691 | set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \ | |||
|
692 | [expr $x + $orad - 1] [expr $canvy + $orad - 1] \ | |||
|
693 | -fill $ofill -outline black -width 1] | |||
|
694 | $canv raise $t | |||
|
695 | set xt [expr $canvx0 + $nlines * $linespc] | |||
|
696 | if {$nparents($id) > 2} { | |||
|
697 | set xt [expr {$xt + ($nparents($id) - 2) * $linespc}] | |||
|
698 | } | |||
|
699 | if {[info exists idtags($id)] && $idtags($id) != {}} { | |||
|
700 | set delta [expr {int(0.5 * ($linespc - $lthickness))}] | |||
|
701 | set yt [expr $canvy - 0.5 * $linespc] | |||
|
702 | set yb [expr $yt + $linespc - 1] | |||
|
703 | set xvals {} | |||
|
704 | set wvals {} | |||
|
705 | foreach tag $idtags($id) { | |||
|
706 | set wid [font measure $mainfont $tag] | |||
|
707 | lappend xvals $xt | |||
|
708 | lappend wvals $wid | |||
|
709 | set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] | |||
|
710 | } | |||
|
711 | set t [$canv create line $x $canvy [lindex $xvals end] $canvy \ | |||
|
712 | -width $lthickness -fill black] | |||
|
713 | $canv lower $t | |||
|
714 | foreach tag $idtags($id) x $xvals wid $wvals { | |||
|
715 | set xl [expr $x + $delta] | |||
|
716 | set xr [expr $x + $delta + $wid + $lthickness] | |||
|
717 | $canv create polygon $x [expr $yt + $delta] $xl $yt\ | |||
|
718 | $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ | |||
|
719 | -width 1 -outline black -fill yellow | |||
|
720 | $canv create text $xl $canvy -anchor w -text $tag \ | |||
|
721 | -font $mainfont | |||
|
722 | } | |||
|
723 | } | |||
|
724 | set headline [lindex $commitinfo($id) 0] | |||
|
725 | set name [lindex $commitinfo($id) 1] | |||
|
726 | set date [lindex $commitinfo($id) 2] | |||
|
727 | set linehtag($lineno) [$canv create text $xt $canvy -anchor w \ | |||
|
728 | -text $headline -font $mainfont ] | |||
|
729 | set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \ | |||
|
730 | -text $name -font $namefont] | |||
|
731 | set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \ | |||
|
732 | -text $date -font $mainfont] | |||
|
733 | if {!$datemode && [llength $actualparents] == 1} { | |||
|
734 | set p [lindex $actualparents 0] | |||
|
735 | if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { | |||
|
736 | assigncolor $p | |||
|
737 | set todo [lreplace $todo $level $level $p] | |||
|
738 | continue | |||
|
739 | } | |||
|
740 | } | |||
|
741 | ||||
|
742 | set oldtodo $todo | |||
|
743 | set oldlevel $level | |||
|
744 | set lines {} | |||
|
745 | for {set i 0} {$i < $nlines} {incr i} { | |||
|
746 | if {[lindex $todo $i] == {}} continue | |||
|
747 | if {[info exists linestarty($i)]} { | |||
|
748 | set oldstarty($i) $linestarty($i) | |||
|
749 | unset linestarty($i) | |||
|
750 | } | |||
|
751 | if {$i != $level} { | |||
|
752 | lappend lines [list $i [lindex $todo $i]] | |||
|
753 | } | |||
|
754 | } | |||
|
755 | if {$nullentry >= 0} { | |||
|
756 | set todo [lreplace $todo $nullentry $nullentry] | |||
|
757 | if {$nullentry < $level} { | |||
|
758 | incr level -1 | |||
|
759 | } | |||
|
760 | } | |||
|
761 | ||||
|
762 | set todo [lreplace $todo $level $level] | |||
|
763 | if {$nullentry > $level} { | |||
|
764 | incr nullentry -1 | |||
|
765 | } | |||
|
766 | set i $level | |||
|
767 | foreach p $actualparents { | |||
|
768 | set k [lsearch -exact $todo $p] | |||
|
769 | if {$k < 0} { | |||
|
770 | assigncolor $p | |||
|
771 | set todo [linsert $todo $i $p] | |||
|
772 | if {$nullentry >= $i} { | |||
|
773 | incr nullentry | |||
|
774 | } | |||
|
775 | incr i | |||
|
776 | } | |||
|
777 | lappend lines [list $oldlevel $p] | |||
|
778 | } | |||
|
779 | ||||
|
780 | # choose which one to do next time around | |||
|
781 | set todol [llength $todo] | |||
|
782 | set level -1 | |||
|
783 | set latest {} | |||
|
784 | for {set k $todol} {[incr k -1] >= 0} {} { | |||
|
785 | set p [lindex $todo $k] | |||
|
786 | if {$p == {}} continue | |||
|
787 | if {$ncleft($p) == 0} { | |||
|
788 | if {$datemode} { | |||
|
789 | if {$latest == {} || $cdate($p) > $latest} { | |||
|
790 | set level $k | |||
|
791 | set latest $cdate($p) | |||
|
792 | } | |||
|
793 | } else { | |||
|
794 | set level $k | |||
|
795 | break | |||
|
796 | } | |||
|
797 | } | |||
|
798 | } | |||
|
799 | if {$level < 0} { | |||
|
800 | if {$todo != {}} { | |||
|
801 | puts "ERROR: none of the pending commits can be done yet:" | |||
|
802 | foreach p $todo { | |||
|
803 | puts " $p" | |||
|
804 | } | |||
|
805 | } | |||
|
806 | break | |||
|
807 | } | |||
|
808 | ||||
|
809 | # If we are reducing, put in a null entry | |||
|
810 | if {$todol < $nlines} { | |||
|
811 | if {$nullentry >= 0} { | |||
|
812 | set i $nullentry | |||
|
813 | while {$i < $todol | |||
|
814 | && [lindex $oldtodo $i] == [lindex $todo $i]} { | |||
|
815 | incr i | |||
|
816 | } | |||
|
817 | } else { | |||
|
818 | set i $oldlevel | |||
|
819 | if {$level >= $i} { | |||
|
820 | incr i | |||
|
821 | } | |||
|
822 | } | |||
|
823 | if {$i >= $todol} { | |||
|
824 | set nullentry -1 | |||
|
825 | } else { | |||
|
826 | set nullentry $i | |||
|
827 | set todo [linsert $todo $nullentry {}] | |||
|
828 | if {$level >= $i} { | |||
|
829 | incr level | |||
|
830 | } | |||
|
831 | } | |||
|
832 | } else { | |||
|
833 | set nullentry -1 | |||
|
834 | } | |||
|
835 | ||||
|
836 | foreach l $lines { | |||
|
837 | set i [lindex $l 0] | |||
|
838 | set dst [lindex $l 1] | |||
|
839 | set j [lsearch -exact $todo $dst] | |||
|
840 | if {$i == $j} { | |||
|
841 | if {[info exists oldstarty($i)]} { | |||
|
842 | set linestarty($i) $oldstarty($i) | |||
|
843 | } | |||
|
844 | continue | |||
|
845 | } | |||
|
846 | set xi [expr {$canvx0 + $i * $linespc}] | |||
|
847 | set xj [expr {$canvx0 + $j * $linespc}] | |||
|
848 | set coords {} | |||
|
849 | if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} { | |||
|
850 | lappend coords $xi $oldstarty($i) | |||
|
851 | } | |||
|
852 | lappend coords $xi $canvy | |||
|
853 | if {$j < $i - 1} { | |||
|
854 | lappend coords [expr $xj + $linespc] $canvy | |||
|
855 | } elseif {$j > $i + 1} { | |||
|
856 | lappend coords [expr $xj - $linespc] $canvy | |||
|
857 | } | |||
|
858 | lappend coords $xj $y2 | |||
|
859 | set t [$canv create line $coords -width $lthickness \ | |||
|
860 | -fill $colormap($dst)] | |||
|
861 | $canv lower $t | |||
|
862 | if {![info exists linestarty($j)]} { | |||
|
863 | set linestarty($j) $y2 | |||
|
864 | } | |||
|
865 | } | |||
|
866 | } | |||
|
867 | set phase {} | |||
|
868 | if {$redisplaying} { | |||
|
869 | if {$stopped == 0 && [info exists selectedline]} { | |||
|
870 | selectline $selectedline | |||
|
871 | } | |||
|
872 | if {$stopped == 1} { | |||
|
873 | set stopped 0 | |||
|
874 | after idle drawgraph | |||
|
875 | } else { | |||
|
876 | set redisplaying 0 | |||
|
877 | } | |||
|
878 | } | |||
|
879 | } | |||
|
880 | ||||
|
881 | proc findmatches {f} { | |||
|
882 | global findtype foundstring foundstrlen | |||
|
883 | if {$findtype == "Regexp"} { | |||
|
884 | set matches [regexp -indices -all -inline $foundstring $f] | |||
|
885 | } else { | |||
|
886 | if {$findtype == "IgnCase"} { | |||
|
887 | set str [string tolower $f] | |||
|
888 | } else { | |||
|
889 | set str $f | |||
|
890 | } | |||
|
891 | set matches {} | |||
|
892 | set i 0 | |||
|
893 | while {[set j [string first $foundstring $str $i]] >= 0} { | |||
|
894 | lappend matches [list $j [expr $j+$foundstrlen-1]] | |||
|
895 | set i [expr $j + $foundstrlen] | |||
|
896 | } | |||
|
897 | } | |||
|
898 | return $matches | |||
|
899 | } | |||
|
900 | ||||
|
901 | proc dofind {} { | |||
|
902 | global findtype findloc findstring markedmatches commitinfo | |||
|
903 | global numcommits lineid linehtag linentag linedtag | |||
|
904 | global mainfont namefont canv canv2 canv3 selectedline | |||
|
905 | global matchinglines foundstring foundstrlen idtags | |||
|
906 | unmarkmatches | |||
|
907 | focus . | |||
|
908 | set matchinglines {} | |||
|
909 | set fldtypes {Headline Author Date Committer CDate Comment} | |||
|
910 | if {$findtype == "IgnCase"} { | |||
|
911 | set foundstring [string tolower $findstring] | |||
|
912 | } else { | |||
|
913 | set foundstring $findstring | |||
|
914 | } | |||
|
915 | set foundstrlen [string length $findstring] | |||
|
916 | if {$foundstrlen == 0} return | |||
|
917 | if {![info exists selectedline]} { | |||
|
918 | set oldsel -1 | |||
|
919 | } else { | |||
|
920 | set oldsel $selectedline | |||
|
921 | } | |||
|
922 | set didsel 0 | |||
|
923 | for {set l 0} {$l < $numcommits} {incr l} { | |||
|
924 | set id $lineid($l) | |||
|
925 | set info $commitinfo($id) | |||
|
926 | set doesmatch 0 | |||
|
927 | foreach f $info ty $fldtypes { | |||
|
928 | if {$findloc != "All fields" && $findloc != $ty} { | |||
|
929 | continue | |||
|
930 | } | |||
|
931 | set matches [findmatches $f] | |||
|
932 | if {$matches == {}} continue | |||
|
933 | set doesmatch 1 | |||
|
934 | if {$ty == "Headline"} { | |||
|
935 | markmatches $canv $l $f $linehtag($l) $matches $mainfont | |||
|
936 | } elseif {$ty == "Author"} { | |||
|
937 | markmatches $canv2 $l $f $linentag($l) $matches $namefont | |||
|
938 | } elseif {$ty == "Date"} { | |||
|
939 | markmatches $canv3 $l $f $linedtag($l) $matches $mainfont | |||
|
940 | } | |||
|
941 | } | |||
|
942 | if {$doesmatch} { | |||
|
943 | lappend matchinglines $l | |||
|
944 | if {!$didsel && $l > $oldsel} { | |||
|
945 | findselectline $l | |||
|
946 | set didsel 1 | |||
|
947 | } | |||
|
948 | } | |||
|
949 | } | |||
|
950 | if {$matchinglines == {}} { | |||
|
951 | bell | |||
|
952 | } elseif {!$didsel} { | |||
|
953 | findselectline [lindex $matchinglines 0] | |||
|
954 | } | |||
|
955 | } | |||
|
956 | ||||
|
957 | proc findselectline {l} { | |||
|
958 | global findloc commentend ctext | |||
|
959 | selectline $l | |||
|
960 | if {$findloc == "All fields" || $findloc == "Comments"} { | |||
|
961 | # highlight the matches in the comments | |||
|
962 | set f [$ctext get 1.0 $commentend] | |||
|
963 | set matches [findmatches $f] | |||
|
964 | foreach match $matches { | |||
|
965 | set start [lindex $match 0] | |||
|
966 | set end [expr [lindex $match 1] + 1] | |||
|
967 | $ctext tag add found "1.0 + $start c" "1.0 + $end c" | |||
|
968 | } | |||
|
969 | } | |||
|
970 | } | |||
|
971 | ||||
|
972 | proc findnext {} { | |||
|
973 | global matchinglines selectedline | |||
|
974 | if {![info exists matchinglines]} { | |||
|
975 | dofind | |||
|
976 | return | |||
|
977 | } | |||
|
978 | if {![info exists selectedline]} return | |||
|
979 | foreach l $matchinglines { | |||
|
980 | if {$l > $selectedline} { | |||
|
981 | findselectline $l | |||
|
982 | return | |||
|
983 | } | |||
|
984 | } | |||
|
985 | bell | |||
|
986 | } | |||
|
987 | ||||
|
988 | proc findprev {} { | |||
|
989 | global matchinglines selectedline | |||
|
990 | if {![info exists matchinglines]} { | |||
|
991 | dofind | |||
|
992 | return | |||
|
993 | } | |||
|
994 | if {![info exists selectedline]} return | |||
|
995 | set prev {} | |||
|
996 | foreach l $matchinglines { | |||
|
997 | if {$l >= $selectedline} break | |||
|
998 | set prev $l | |||
|
999 | } | |||
|
1000 | if {$prev != {}} { | |||
|
1001 | findselectline $prev | |||
|
1002 | } else { | |||
|
1003 | bell | |||
|
1004 | } | |||
|
1005 | } | |||
|
1006 | ||||
|
1007 | proc markmatches {canv l str tag matches font} { | |||
|
1008 | set bbox [$canv bbox $tag] | |||
|
1009 | set x0 [lindex $bbox 0] | |||
|
1010 | set y0 [lindex $bbox 1] | |||
|
1011 | set y1 [lindex $bbox 3] | |||
|
1012 | foreach match $matches { | |||
|
1013 | set start [lindex $match 0] | |||
|
1014 | set end [lindex $match 1] | |||
|
1015 | if {$start > $end} continue | |||
|
1016 | set xoff [font measure $font [string range $str 0 [expr $start-1]]] | |||
|
1017 | set xlen [font measure $font [string range $str 0 [expr $end]]] | |||
|
1018 | set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ | |||
|
1019 | -outline {} -tags matches -fill yellow] | |||
|
1020 | $canv lower $t | |||
|
1021 | } | |||
|
1022 | } | |||
|
1023 | ||||
|
1024 | proc unmarkmatches {} { | |||
|
1025 | global matchinglines | |||
|
1026 | allcanvs delete matches | |||
|
1027 | catch {unset matchinglines} | |||
|
1028 | } | |||
|
1029 | ||||
|
1030 | proc selcanvline {x y} { | |||
|
1031 | global canv canvy0 ctext linespc selectedline | |||
|
1032 | global lineid linehtag linentag linedtag | |||
|
1033 | set ymax [lindex [$canv cget -scrollregion] 3] | |||
|
1034 | if {$ymax == {}} return | |||
|
1035 | set yfrac [lindex [$canv yview] 0] | |||
|
1036 | set y [expr {$y + $yfrac * $ymax}] | |||
|
1037 | set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] | |||
|
1038 | if {$l < 0} { | |||
|
1039 | set l 0 | |||
|
1040 | } | |||
|
1041 | if {[info exists selectedline] && $selectedline == $l} return | |||
|
1042 | unmarkmatches | |||
|
1043 | selectline $l | |||
|
1044 | } | |||
|
1045 | ||||
|
1046 | proc selectline {l} { | |||
|
1047 | global canv canv2 canv3 ctext commitinfo selectedline | |||
|
1048 | global lineid linehtag linentag linedtag | |||
|
1049 | global canvy0 linespc nparents treepending | |||
|
1050 | global cflist treediffs currentid sha1entry | |||
|
1051 | global commentend seenfile numcommits idtags | |||
|
1052 | if {![info exists lineid($l)] || ![info exists linehtag($l)]} return | |||
|
1053 | $canv delete secsel | |||
|
1054 | set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ | |||
|
1055 | -tags secsel -fill [$canv cget -selectbackground]] | |||
|
1056 | $canv lower $t | |||
|
1057 | $canv2 delete secsel | |||
|
1058 | set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ | |||
|
1059 | -tags secsel -fill [$canv2 cget -selectbackground]] | |||
|
1060 | $canv2 lower $t | |||
|
1061 | $canv3 delete secsel | |||
|
1062 | set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ | |||
|
1063 | -tags secsel -fill [$canv3 cget -selectbackground]] | |||
|
1064 | $canv3 lower $t | |||
|
1065 | set y [expr {$canvy0 + $l * $linespc}] | |||
|
1066 | set ymax [lindex [$canv cget -scrollregion] 3] | |||
|
1067 | set ytop [expr {$y - $linespc - 1}] | |||
|
1068 | set ybot [expr {$y + $linespc + 1}] | |||
|
1069 | set wnow [$canv yview] | |||
|
1070 | set wtop [expr [lindex $wnow 0] * $ymax] | |||
|
1071 | set wbot [expr [lindex $wnow 1] * $ymax] | |||
|
1072 | set wh [expr {$wbot - $wtop}] | |||
|
1073 | set newtop $wtop | |||
|
1074 | if {$ytop < $wtop} { | |||
|
1075 | if {$ybot < $wtop} { | |||
|
1076 | set newtop [expr {$y - $wh / 2.0}] | |||
|
1077 | } else { | |||
|
1078 | set newtop $ytop | |||
|
1079 | if {$newtop > $wtop - $linespc} { | |||
|
1080 | set newtop [expr {$wtop - $linespc}] | |||
|
1081 | } | |||
|
1082 | } | |||
|
1083 | } elseif {$ybot > $wbot} { | |||
|
1084 | if {$ytop > $wbot} { | |||
|
1085 | set newtop [expr {$y - $wh / 2.0}] | |||
|
1086 | } else { | |||
|
1087 | set newtop [expr {$ybot - $wh}] | |||
|
1088 | if {$newtop < $wtop + $linespc} { | |||
|
1089 | set newtop [expr {$wtop + $linespc}] | |||
|
1090 | } | |||
|
1091 | } | |||
|
1092 | } | |||
|
1093 | if {$newtop != $wtop} { | |||
|
1094 | if {$newtop < 0} { | |||
|
1095 | set newtop 0 | |||
|
1096 | } | |||
|
1097 | allcanvs yview moveto [expr $newtop * 1.0 / $ymax] | |||
|
1098 | } | |||
|
1099 | set selectedline $l | |||
|
1100 | ||||
|
1101 | set id $lineid($l) | |||
|
1102 | set currentid $id | |||
|
1103 | $sha1entry delete 0 end | |||
|
1104 | $sha1entry insert 0 $id | |||
|
1105 | $sha1entry selection from 0 | |||
|
1106 | $sha1entry selection to end | |||
|
1107 | ||||
|
1108 | $ctext conf -state normal | |||
|
1109 | $ctext delete 0.0 end | |||
|
1110 | set info $commitinfo($id) | |||
|
1111 | $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" | |||
|
1112 | $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" | |||
|
1113 | if {[info exists idtags($id)]} { | |||
|
1114 | $ctext insert end "Tags:" | |||
|
1115 | foreach tag $idtags($id) { | |||
|
1116 | $ctext insert end " $tag" | |||
|
1117 | } | |||
|
1118 | $ctext insert end "\n" | |||
|
1119 | } | |||
|
1120 | $ctext insert end "\n" | |||
|
1121 | $ctext insert end [lindex $info 5] | |||
|
1122 | $ctext insert end "\n" | |||
|
1123 | $ctext tag delete Comments | |||
|
1124 | $ctext tag remove found 1.0 end | |||
|
1125 | $ctext conf -state disabled | |||
|
1126 | set commentend [$ctext index "end - 1c"] | |||
|
1127 | ||||
|
1128 | $cflist delete 0 end | |||
|
1129 | if {$nparents($id) == 1} { | |||
|
1130 | if {![info exists treediffs($id)]} { | |||
|
1131 | if {![info exists treepending]} { | |||
|
1132 | gettreediffs $id | |||
|
1133 | } | |||
|
1134 | } else { | |||
|
1135 | addtocflist $id | |||
|
1136 | } | |||
|
1137 | } | |||
|
1138 | catch {unset seenfile} | |||
|
1139 | } | |||
|
1140 | ||||
|
1141 | proc selnextline {dir} { | |||
|
1142 | global selectedline | |||
|
1143 | if {![info exists selectedline]} return | |||
|
1144 | set l [expr $selectedline + $dir] | |||
|
1145 | unmarkmatches | |||
|
1146 | selectline $l | |||
|
1147 | } | |||
|
1148 | ||||
|
1149 | proc addtocflist {id} { | |||
|
1150 | global currentid treediffs cflist treepending | |||
|
1151 | if {$id != $currentid} { | |||
|
1152 | gettreediffs $currentid | |||
|
1153 | return | |||
|
1154 | } | |||
|
1155 | $cflist insert end "All files" | |||
|
1156 | foreach f $treediffs($currentid) { | |||
|
1157 | $cflist insert end $f | |||
|
1158 | } | |||
|
1159 | getblobdiffs $id | |||
|
1160 | } | |||
|
1161 | ||||
|
1162 | proc gettreediffs {id} { | |||
|
1163 | global treediffs parents treepending | |||
|
1164 | set treepending $id | |||
|
1165 | set treediffs($id) {} | |||
|
1166 | set p [lindex $parents($id) 0] | |||
|
1167 | puts stderr "hgit diff-tree -r $p $id" | |||
|
1168 | if [catch {set gdtf [open "|hgit diff-tree -r $p $id" r]}] return | |||
|
1169 | fconfigure $gdtf -blocking 0 | |||
|
1170 | fileevent $gdtf readable "gettreediffline $gdtf $id" | |||
|
1171 | } | |||
|
1172 | ||||
|
1173 | proc gettreediffline {gdtf id} { | |||
|
1174 | global treediffs treepending | |||
|
1175 | set n [gets $gdtf line] | |||
|
1176 | if {$n < 0} { | |||
|
1177 | if {![eof $gdtf]} return | |||
|
1178 | close $gdtf | |||
|
1179 | unset treepending | |||
|
1180 | addtocflist $id | |||
|
1181 | return | |||
|
1182 | } | |||
|
1183 | set file [lindex $line 5] | |||
|
1184 | puts stderr "line $file\n" | |||
|
1185 | lappend treediffs($id) $file | |||
|
1186 | } | |||
|
1187 | ||||
|
1188 | proc getblobdiffs {id} { | |||
|
1189 | global parents diffopts blobdifffd env curdifftag curtagstart | |||
|
1190 | global diffindex difffilestart | |||
|
1191 | set p [lindex $parents($id) 0] | |||
|
1192 | set env(GIT_DIFF_OPTS) $diffopts | |||
|
1193 | if [catch {set bdf [open "|hgit diff-tree -r -p $p $id" r]} err] { | |||
|
1194 | puts "error getting diffs: $err" | |||
|
1195 | return | |||
|
1196 | } | |||
|
1197 | fconfigure $bdf -blocking 0 | |||
|
1198 | set blobdifffd($id) $bdf | |||
|
1199 | set curdifftag Comments | |||
|
1200 | set curtagstart 0.0 | |||
|
1201 | set diffindex 0 | |||
|
1202 | catch {unset difffilestart} | |||
|
1203 | fileevent $bdf readable "getblobdiffline $bdf $id" | |||
|
1204 | } | |||
|
1205 | ||||
|
1206 | proc getblobdiffline {bdf id} { | |||
|
1207 | global currentid blobdifffd ctext curdifftag curtagstart seenfile | |||
|
1208 | global diffnexthead diffnextnote diffindex difffilestart | |||
|
1209 | set n [gets $bdf line] | |||
|
1210 | if {$n < 0} { | |||
|
1211 | if {[eof $bdf]} { | |||
|
1212 | close $bdf | |||
|
1213 | if {$id == $currentid && $bdf == $blobdifffd($id)} { | |||
|
1214 | $ctext tag add $curdifftag $curtagstart end | |||
|
1215 | set seenfile($curdifftag) 1 | |||
|
1216 | } | |||
|
1217 | } | |||
|
1218 | return | |||
|
1219 | } | |||
|
1220 | if {$id != $currentid || $bdf != $blobdifffd($id)} { | |||
|
1221 | return | |||
|
1222 | } | |||
|
1223 | $ctext conf -state normal | |||
|
1224 | if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} { | |||
|
1225 | # start of a new file | |||
|
1226 | $ctext insert end "\n" | |||
|
1227 | $ctext tag add $curdifftag $curtagstart end | |||
|
1228 | set seenfile($curdifftag) 1 | |||
|
1229 | set curtagstart [$ctext index "end - 1c"] | |||
|
1230 | set header $fname | |||
|
1231 | if {[info exists diffnexthead]} { | |||
|
1232 | set fname $diffnexthead | |||
|
1233 | set header "$diffnexthead ($diffnextnote)" | |||
|
1234 | unset diffnexthead | |||
|
1235 | } | |||
|
1236 | set difffilestart($diffindex) [$ctext index "end - 1c"] | |||
|
1237 | incr diffindex | |||
|
1238 | set curdifftag "f:$fname" | |||
|
1239 | $ctext tag delete $curdifftag | |||
|
1240 | set l [expr {(78 - [string length $header]) / 2}] | |||
|
1241 | set pad [string range "----------------------------------------" 1 $l] | |||
|
1242 | $ctext insert end "$pad $header $pad\n" filesep | |||
|
1243 | } elseif {[string range $line 0 2] == "+++"} { | |||
|
1244 | # no need to do anything with this | |||
|
1245 | } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} { | |||
|
1246 | set diffnexthead $fn | |||
|
1247 | set diffnextnote "created, mode $m" | |||
|
1248 | } elseif {[string range $line 0 8] == "Deleted: "} { | |||
|
1249 | set diffnexthead [string range $line 9 end] | |||
|
1250 | set diffnextnote "deleted" | |||
|
1251 | } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} { | |||
|
1252 | # save the filename in case the next thing is "new file mode ..." | |||
|
1253 | set diffnexthead $fn | |||
|
1254 | set diffnextnote "modified" | |||
|
1255 | } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} { | |||
|
1256 | set diffnextnote "new file, mode $m" | |||
|
1257 | } elseif {[string range $line 0 11] == "deleted file"} { | |||
|
1258 | set diffnextnote "deleted" | |||
|
1259 | } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ | |||
|
1260 | $line match f1l f1c f2l f2c rest]} { | |||
|
1261 | $ctext insert end "\t" hunksep | |||
|
1262 | $ctext insert end " $f1l " d0 " $f2l " d1 | |||
|
1263 | $ctext insert end " $rest \n" hunksep | |||
|
1264 | } else { | |||
|
1265 | set x [string range $line 0 0] | |||
|
1266 | if {$x == "-" || $x == "+"} { | |||
|
1267 | set tag [expr {$x == "+"}] | |||
|
1268 | set line [string range $line 1 end] | |||
|
1269 | $ctext insert end "$line\n" d$tag | |||
|
1270 | } elseif {$x == " "} { | |||
|
1271 | set line [string range $line 1 end] | |||
|
1272 | $ctext insert end "$line\n" | |||
|
1273 | } elseif {$x == "\\"} { | |||
|
1274 | # e.g. "\ No newline at end of file" | |||
|
1275 | $ctext insert end "$line\n" filesep | |||
|
1276 | } else { | |||
|
1277 | # Something else we don't recognize | |||
|
1278 | if {$curdifftag != "Comments"} { | |||
|
1279 | $ctext insert end "\n" | |||
|
1280 | $ctext tag add $curdifftag $curtagstart end | |||
|
1281 | set seenfile($curdifftag) 1 | |||
|
1282 | set curtagstart [$ctext index "end - 1c"] | |||
|
1283 | set curdifftag Comments | |||
|
1284 | } | |||
|
1285 | $ctext insert end "$line\n" filesep | |||
|
1286 | } | |||
|
1287 | } | |||
|
1288 | $ctext conf -state disabled | |||
|
1289 | } | |||
|
1290 | ||||
|
1291 | proc nextfile {} { | |||
|
1292 | global difffilestart ctext | |||
|
1293 | set here [$ctext index @0,0] | |||
|
1294 | for {set i 0} {[info exists difffilestart($i)]} {incr i} { | |||
|
1295 | if {[$ctext compare $difffilestart($i) > $here]} { | |||
|
1296 | $ctext yview $difffilestart($i) | |||
|
1297 | break | |||
|
1298 | } | |||
|
1299 | } | |||
|
1300 | } | |||
|
1301 | ||||
|
1302 | proc listboxsel {} { | |||
|
1303 | global ctext cflist currentid treediffs seenfile | |||
|
1304 | if {![info exists currentid]} return | |||
|
1305 | set sel [$cflist curselection] | |||
|
1306 | if {$sel == {} || [lsearch -exact $sel 0] >= 0} { | |||
|
1307 | # show everything | |||
|
1308 | $ctext tag conf Comments -elide 0 | |||
|
1309 | foreach f $treediffs($currentid) { | |||
|
1310 | if [info exists seenfile(f:$f)] { | |||
|
1311 | $ctext tag conf "f:$f" -elide 0 | |||
|
1312 | } | |||
|
1313 | } | |||
|
1314 | } else { | |||
|
1315 | # just show selected files | |||
|
1316 | $ctext tag conf Comments -elide 1 | |||
|
1317 | set i 1 | |||
|
1318 | foreach f $treediffs($currentid) { | |||
|
1319 | set elide [expr {[lsearch -exact $sel $i] < 0}] | |||
|
1320 | if [info exists seenfile(f:$f)] { | |||
|
1321 | $ctext tag conf "f:$f" -elide $elide | |||
|
1322 | } | |||
|
1323 | incr i | |||
|
1324 | } | |||
|
1325 | } | |||
|
1326 | } | |||
|
1327 | ||||
|
1328 | proc setcoords {} { | |||
|
1329 | global linespc charspc canvx0 canvy0 mainfont | |||
|
1330 | set linespc [font metrics $mainfont -linespace] | |||
|
1331 | set charspc [font measure $mainfont "m"] | |||
|
1332 | set canvy0 [expr 3 + 0.5 * $linespc] | |||
|
1333 | set canvx0 [expr 3 + 0.5 * $linespc] | |||
|
1334 | } | |||
|
1335 | ||||
|
1336 | proc redisplay {} { | |||
|
1337 | global selectedline stopped redisplaying phase | |||
|
1338 | if {$stopped > 1} return | |||
|
1339 | if {$phase == "getcommits"} return | |||
|
1340 | set redisplaying 1 | |||
|
1341 | if {$phase == "drawgraph"} { | |||
|
1342 | set stopped 1 | |||
|
1343 | } else { | |||
|
1344 | drawgraph | |||
|
1345 | } | |||
|
1346 | } | |||
|
1347 | ||||
|
1348 | proc incrfont {inc} { | |||
|
1349 | global mainfont namefont textfont selectedline ctext canv phase | |||
|
1350 | global stopped entries | |||
|
1351 | unmarkmatches | |||
|
1352 | set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] | |||
|
1353 | set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] | |||
|
1354 | set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] | |||
|
1355 | setcoords | |||
|
1356 | $ctext conf -font $textfont | |||
|
1357 | $ctext tag conf filesep -font [concat $textfont bold] | |||
|
1358 | foreach e $entries { | |||
|
1359 | $e conf -font $mainfont | |||
|
1360 | } | |||
|
1361 | if {$phase == "getcommits"} { | |||
|
1362 | $canv itemconf textitems -font $mainfont | |||
|
1363 | } | |||
|
1364 | redisplay | |||
|
1365 | } | |||
|
1366 | ||||
|
1367 | proc sha1change {n1 n2 op} { | |||
|
1368 | global sha1string currentid sha1but | |||
|
1369 | if {$sha1string == {} | |||
|
1370 | || ([info exists currentid] && $sha1string == $currentid)} { | |||
|
1371 | set state disabled | |||
|
1372 | } else { | |||
|
1373 | set state normal | |||
|
1374 | } | |||
|
1375 | if {[$sha1but cget -state] == $state} return | |||
|
1376 | if {$state == "normal"} { | |||
|
1377 | $sha1but conf -state normal -relief raised -text "Goto: " | |||
|
1378 | } else { | |||
|
1379 | $sha1but conf -state disabled -relief flat -text "SHA1 ID: " | |||
|
1380 | } | |||
|
1381 | } | |||
|
1382 | ||||
|
1383 | proc gotocommit {} { | |||
|
1384 | global sha1string currentid idline tagids | |||
|
1385 | if {$sha1string == {} | |||
|
1386 | || ([info exists currentid] && $sha1string == $currentid)} return | |||
|
1387 | if {[info exists tagids($sha1string)]} { | |||
|
1388 | set id $tagids($sha1string) | |||
|
1389 | } else { | |||
|
1390 | set id [string tolower $sha1string] | |||
|
1391 | } | |||
|
1392 | if {[info exists idline($id)]} { | |||
|
1393 | selectline $idline($id) | |||
|
1394 | return | |||
|
1395 | } | |||
|
1396 | if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} { | |||
|
1397 | set type "SHA1 id" | |||
|
1398 | } else { | |||
|
1399 | set type "Tag" | |||
|
1400 | } | |||
|
1401 | error_popup "$type $sha1string is not known" | |||
|
1402 | } | |||
|
1403 | ||||
|
1404 | proc doquit {} { | |||
|
1405 | global stopped | |||
|
1406 | set stopped 100 | |||
|
1407 | destroy . | |||
|
1408 | } | |||
|
1409 | ||||
|
1410 | # defaults... | |||
|
1411 | set datemode 0 | |||
|
1412 | set boldnames 0 | |||
|
1413 | set diffopts "-U 5 -p" | |||
|
1414 | ||||
|
1415 | set mainfont {Helvetica 9} | |||
|
1416 | set textfont {Courier 9} | |||
|
1417 | ||||
|
1418 | set colors {green red blue magenta darkgrey brown orange} | |||
|
1419 | set colorbycommitter false | |||
|
1420 | ||||
|
1421 | catch {source ~/.gitk} | |||
|
1422 | ||||
|
1423 | set namefont $mainfont | |||
|
1424 | if {$boldnames} { | |||
|
1425 | lappend namefont bold | |||
|
1426 | } | |||
|
1427 | ||||
|
1428 | set revtreeargs {} | |||
|
1429 | foreach arg $argv { | |||
|
1430 | switch -regexp -- $arg { | |||
|
1431 | "^$" { } | |||
|
1432 | "^-b" { set boldnames 1 } | |||
|
1433 | "^-c" { set colorbycommitter 1 } | |||
|
1434 | "^-d" { set datemode 1 } | |||
|
1435 | default { | |||
|
1436 | lappend revtreeargs $arg | |||
|
1437 | } | |||
|
1438 | } | |||
|
1439 | } | |||
|
1440 | ||||
|
1441 | set stopped 0 | |||
|
1442 | set redisplaying 0 | |||
|
1443 | set stuffsaved 0 | |||
|
1444 | setcoords | |||
|
1445 | makewindow | |||
|
1446 | readrefs | |||
|
1447 | readfullcommits $revtreeargs |
General Comments 0
You need to be logged in to leave comments.
Login now