]>
Commit | Line | Data |
---|---|---|
1db95b00 PM |
1 | #!/bin/sh |
2 | # Tcl ignores the next line -*- tcl -*- \ | |
9e026d39 | 3 | exec wish "$0" -- "$@" |
1db95b00 | 4 | |
e1a7c81f | 5 | # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved. |
1db95b00 PM |
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 | ||
73b6a6cb JH |
10 | proc gitdir {} { |
11 | global env | |
12 | if {[info exists env(GIT_DIR)]} { | |
13 | return $env(GIT_DIR) | |
14 | } else { | |
5024baa4 | 15 | return [exec git rev-parse --git-dir] |
73b6a6cb JH |
16 | } |
17 | } | |
18 | ||
7eb3cb9c PM |
19 | # A simple scheduler for compute-intensive stuff. |
20 | # The aim is to make sure that event handlers for GUI actions can | |
21 | # run at least every 50-100 ms. Unfortunately fileevent handlers are | |
22 | # run before X event handlers, so reading from a fast source can | |
23 | # make the GUI completely unresponsive. | |
24 | proc run args { | |
25 | global isonrunq runq | |
26 | ||
27 | set script $args | |
28 | if {[info exists isonrunq($script)]} return | |
29 | if {$runq eq {}} { | |
30 | after idle dorunq | |
31 | } | |
32 | lappend runq [list {} $script] | |
33 | set isonrunq($script) 1 | |
34 | } | |
35 | ||
36 | proc filerun {fd script} { | |
37 | fileevent $fd readable [list filereadable $fd $script] | |
38 | } | |
39 | ||
40 | proc filereadable {fd script} { | |
41 | global runq | |
42 | ||
43 | fileevent $fd readable {} | |
44 | if {$runq eq {}} { | |
45 | after idle dorunq | |
46 | } | |
47 | lappend runq [list $fd $script] | |
48 | } | |
49 | ||
50 | proc dorunq {} { | |
51 | global isonrunq runq | |
52 | ||
53 | set tstart [clock clicks -milliseconds] | |
54 | set t0 $tstart | |
55 | while {$runq ne {}} { | |
56 | set fd [lindex $runq 0 0] | |
57 | set script [lindex $runq 0 1] | |
58 | set repeat [eval $script] | |
59 | set t1 [clock clicks -milliseconds] | |
60 | set t [expr {$t1 - $t0}] | |
61 | set runq [lrange $runq 1 end] | |
62 | if {$repeat ne {} && $repeat} { | |
63 | if {$fd eq {} || $repeat == 2} { | |
64 | # script returns 1 if it wants to be readded | |
65 | # file readers return 2 if they could do more straight away | |
66 | lappend runq [list $fd $script] | |
67 | } else { | |
68 | fileevent $fd readable [list filereadable $fd $script] | |
69 | } | |
70 | } elseif {$fd eq {}} { | |
71 | unset isonrunq($script) | |
72 | } | |
73 | set t0 $t1 | |
74 | if {$t1 - $tstart >= 80} break | |
75 | } | |
76 | if {$runq ne {}} { | |
77 | after idle dorunq | |
78 | } | |
79 | } | |
80 | ||
81 | # Start off a git rev-list process and arrange to read its output | |
da7c24dd | 82 | proc start_rev_list {view} { |
7eb3cb9c | 83 | global startmsecs |
9f1afe05 | 84 | global commfd leftover tclencoding datemode |
6e8c8707 | 85 | global viewargs viewfiles commitidx vnextroot |
219ea3a9 | 86 | global lookingforhead showlocalchanges |
9ccbdfbf | 87 | |
9ccbdfbf | 88 | set startmsecs [clock clicks -milliseconds] |
da7c24dd | 89 | set commitidx($view) 0 |
6e8c8707 | 90 | set vnextroot($view) 0 |
9f1afe05 PM |
91 | set order "--topo-order" |
92 | if {$datemode} { | |
93 | set order "--date-order" | |
94 | } | |
418c4c7b | 95 | if {[catch { |
cdaee5db PM |
96 | set fd [open [concat | git log -z --pretty=raw $order --parents \ |
97 | --boundary $viewargs($view) "--" $viewfiles($view)] r] | |
418c4c7b | 98 | } err]} { |
cdaee5db | 99 | error_popup "Error executing git rev-list: $err" |
1d10f36d PM |
100 | exit 1 |
101 | } | |
da7c24dd PM |
102 | set commfd($view) $fd |
103 | set leftover($view) {} | |
219ea3a9 | 104 | set lookingforhead $showlocalchanges |
86da5b6c | 105 | fconfigure $fd -blocking 0 -translation lf -eofchar {} |
fd8ccbec | 106 | if {$tclencoding != {}} { |
da7c24dd | 107 | fconfigure $fd -encoding $tclencoding |
fd8ccbec | 108 | } |
7eb3cb9c | 109 | filerun $fd [list getcommitlines $fd $view] |
da7c24dd | 110 | nowbusy $view |
38ad0910 PM |
111 | } |
112 | ||
22626ef4 | 113 | proc stop_rev_list {} { |
da7c24dd | 114 | global commfd curview |
22626ef4 | 115 | |
da7c24dd PM |
116 | if {![info exists commfd($curview)]} return |
117 | set fd $commfd($curview) | |
22626ef4 | 118 | catch { |
da7c24dd | 119 | set pid [pid $fd] |
22626ef4 PM |
120 | exec kill $pid |
121 | } | |
da7c24dd PM |
122 | catch {close $fd} |
123 | unset commfd($curview) | |
22626ef4 PM |
124 | } |
125 | ||
a8aaf19c | 126 | proc getcommits {} { |
da7c24dd | 127 | global phase canv mainfont curview |
38ad0910 | 128 | |
38ad0910 | 129 | set phase getcommits |
da7c24dd PM |
130 | initlayout |
131 | start_rev_list $curview | |
098dd8a3 | 132 | show_status "Reading commits..." |
1d10f36d PM |
133 | } |
134 | ||
6e8c8707 PM |
135 | # This makes a string representation of a positive integer which |
136 | # sorts as a string in numerical order | |
137 | proc strrep {n} { | |
138 | if {$n < 16} { | |
139 | return [format "%x" $n] | |
140 | } elseif {$n < 256} { | |
141 | return [format "x%.2x" $n] | |
142 | } elseif {$n < 65536} { | |
143 | return [format "y%.4x" $n] | |
144 | } | |
145 | return [format "z%.8x" $n] | |
146 | } | |
147 | ||
da7c24dd | 148 | proc getcommitlines {fd view} { |
7eb3cb9c | 149 | global commitlisted |
da7c24dd | 150 | global leftover commfd |
8ed16484 | 151 | global displayorder commitidx commitrow commitdata |
6a90bff1 PM |
152 | global parentlist children curview hlview |
153 | global vparentlist vdisporder vcmitlisted | |
b0cdca99 | 154 | global ordertok vnextroot idpending |
9ccbdfbf | 155 | |
d1e46756 | 156 | set stuff [read $fd 500000] |
005a2f4e PM |
157 | # git log doesn't terminate the last commit with a null... |
158 | if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} { | |
159 | set stuff "\0" | |
160 | } | |
b490a991 | 161 | if {$stuff == {}} { |
7eb3cb9c PM |
162 | if {![eof $fd]} { |
163 | return 1 | |
164 | } | |
b0cdca99 PM |
165 | # Check if we have seen any ids listed as parents that haven't |
166 | # appeared in the list | |
167 | foreach vid [array names idpending "$view,*"] { | |
168 | # should only get here if git log is buggy | |
169 | set id [lindex [split $vid ","] 1] | |
170 | set commitrow($vid) $commitidx($view) | |
171 | incr commitidx($view) | |
172 | if {$view == $curview} { | |
173 | lappend parentlist {} | |
174 | lappend displayorder $id | |
175 | lappend commitlisted 0 | |
176 | } else { | |
177 | lappend vparentlist($view) {} | |
178 | lappend vdisporder($view) $id | |
179 | lappend vcmitlisted($view) 0 | |
180 | } | |
181 | } | |
098dd8a3 | 182 | global viewname |
da7c24dd | 183 | unset commfd($view) |
098dd8a3 | 184 | notbusy $view |
f0654861 | 185 | # set it blocking so we wait for the process to terminate |
da7c24dd | 186 | fconfigure $fd -blocking 1 |
098dd8a3 PM |
187 | if {[catch {close $fd} err]} { |
188 | set fv {} | |
189 | if {$view != $curview} { | |
190 | set fv " for the \"$viewname($view)\" view" | |
da7c24dd | 191 | } |
098dd8a3 PM |
192 | if {[string range $err 0 4] == "usage"} { |
193 | set err "Gitk: error reading commits$fv:\ | |
8974c6f9 | 194 | bad arguments to git rev-list." |
098dd8a3 PM |
195 | if {$viewname($view) eq "Command line"} { |
196 | append err \ | |
8974c6f9 | 197 | " (Note: arguments to gitk are passed to git rev-list\ |
098dd8a3 PM |
198 | to allow selection of commits to be displayed.)" |
199 | } | |
200 | } else { | |
201 | set err "Error reading commits$fv: $err" | |
202 | } | |
203 | error_popup $err | |
1d10f36d | 204 | } |
098dd8a3 | 205 | if {$view == $curview} { |
7eb3cb9c | 206 | run chewcommits $view |
9a40c50c | 207 | } |
7eb3cb9c | 208 | return 0 |
9a40c50c | 209 | } |
b490a991 | 210 | set start 0 |
8f7d0cec | 211 | set gotsome 0 |
b490a991 PM |
212 | while 1 { |
213 | set i [string first "\0" $stuff $start] | |
214 | if {$i < 0} { | |
da7c24dd | 215 | append leftover($view) [string range $stuff $start end] |
9f1afe05 | 216 | break |
9ccbdfbf | 217 | } |
b490a991 | 218 | if {$start == 0} { |
da7c24dd | 219 | set cmit $leftover($view) |
8f7d0cec | 220 | append cmit [string range $stuff 0 [expr {$i - 1}]] |
da7c24dd | 221 | set leftover($view) {} |
8f7d0cec PM |
222 | } else { |
223 | set cmit [string range $stuff $start [expr {$i - 1}]] | |
b490a991 PM |
224 | } |
225 | set start [expr {$i + 1}] | |
e5ea701b PM |
226 | set j [string first "\n" $cmit] |
227 | set ok 0 | |
16c1ff96 | 228 | set listed 1 |
c961b228 PM |
229 | if {$j >= 0 && [string match "commit *" $cmit]} { |
230 | set ids [string range $cmit 7 [expr {$j - 1}]] | |
231 | if {[string match {[-<>]*} $ids]} { | |
232 | switch -- [string index $ids 0] { | |
233 | "-" {set listed 0} | |
234 | "<" {set listed 2} | |
235 | ">" {set listed 3} | |
236 | } | |
16c1ff96 PM |
237 | set ids [string range $ids 1 end] |
238 | } | |
e5ea701b PM |
239 | set ok 1 |
240 | foreach id $ids { | |
8f7d0cec | 241 | if {[string length $id] != 40} { |
e5ea701b PM |
242 | set ok 0 |
243 | break | |
244 | } | |
245 | } | |
246 | } | |
247 | if {!$ok} { | |
7e952e79 PM |
248 | set shortcmit $cmit |
249 | if {[string length $shortcmit] > 80} { | |
250 | set shortcmit "[string range $shortcmit 0 80]..." | |
251 | } | |
c961b228 | 252 | error_popup "Can't parse git log output: {$shortcmit}" |
b490a991 PM |
253 | exit 1 |
254 | } | |
e5ea701b | 255 | set id [lindex $ids 0] |
6e8c8707 PM |
256 | if {![info exists ordertok($view,$id)]} { |
257 | set otok "o[strrep $vnextroot($view)]" | |
258 | incr vnextroot($view) | |
259 | set ordertok($view,$id) $otok | |
260 | } else { | |
261 | set otok $ordertok($view,$id) | |
b0cdca99 | 262 | unset idpending($view,$id) |
6e8c8707 | 263 | } |
16c1ff96 PM |
264 | if {$listed} { |
265 | set olds [lrange $ids 1 end] | |
6e8c8707 PM |
266 | if {[llength $olds] == 1} { |
267 | set p [lindex $olds 0] | |
268 | lappend children($view,$p) $id | |
269 | if {![info exists ordertok($view,$p)]} { | |
270 | set ordertok($view,$p) $ordertok($view,$id) | |
b0cdca99 | 271 | set idpending($view,$p) 1 |
6e8c8707 PM |
272 | } |
273 | } else { | |
274 | set i 0 | |
275 | foreach p $olds { | |
276 | if {$i == 0 || [lsearch -exact $olds $p] >= $i} { | |
277 | lappend children($view,$p) $id | |
278 | } | |
279 | if {![info exists ordertok($view,$p)]} { | |
280 | set ordertok($view,$p) "$otok[strrep $i]]" | |
b0cdca99 | 281 | set idpending($view,$p) 1 |
6e8c8707 PM |
282 | } |
283 | incr i | |
50b44ece | 284 | } |
79b2c75e | 285 | } |
16c1ff96 PM |
286 | } else { |
287 | set olds {} | |
288 | } | |
da7c24dd PM |
289 | if {![info exists children($view,$id)]} { |
290 | set children($view,$id) {} | |
79b2c75e | 291 | } |
f7a3e8d2 | 292 | set commitdata($id) [string range $cmit [expr {$j + 1}] end] |
da7c24dd PM |
293 | set commitrow($view,$id) $commitidx($view) |
294 | incr commitidx($view) | |
295 | if {$view == $curview} { | |
296 | lappend parentlist $olds | |
da7c24dd PM |
297 | lappend displayorder $id |
298 | lappend commitlisted $listed | |
299 | } else { | |
300 | lappend vparentlist($view) $olds | |
da7c24dd PM |
301 | lappend vdisporder($view) $id |
302 | lappend vcmitlisted($view) $listed | |
303 | } | |
8f7d0cec PM |
304 | set gotsome 1 |
305 | } | |
306 | if {$gotsome} { | |
7eb3cb9c | 307 | run chewcommits $view |
9ccbdfbf | 308 | } |
7eb3cb9c | 309 | return 2 |
9ccbdfbf PM |
310 | } |
311 | ||
7eb3cb9c PM |
312 | proc chewcommits {view} { |
313 | global curview hlview commfd | |
314 | global selectedline pending_select | |
315 | ||
316 | set more 0 | |
317 | if {$view == $curview} { | |
318 | set allread [expr {![info exists commfd($view)]}] | |
319 | set tlimit [expr {[clock clicks -milliseconds] + 50}] | |
320 | set more [layoutmore $tlimit $allread] | |
321 | if {$allread && !$more} { | |
8f489363 | 322 | global displayorder commitidx phase |
7eb3cb9c | 323 | global numcommits startmsecs |
9ccbdfbf | 324 | |
7eb3cb9c | 325 | if {[info exists pending_select]} { |
8f489363 | 326 | set row [first_real_row] |
7eb3cb9c PM |
327 | selectline $row 1 |
328 | } | |
329 | if {$commitidx($curview) > 0} { | |
330 | #set ms [expr {[clock clicks -milliseconds] - $startmsecs}] | |
331 | #puts "overall $ms ms for $numcommits commits" | |
332 | } else { | |
333 | show_status "No commits selected" | |
334 | } | |
335 | notbusy layout | |
336 | set phase {} | |
337 | } | |
b664550c | 338 | } |
7eb3cb9c PM |
339 | if {[info exists hlview] && $view == $hlview} { |
340 | vhighlightmore | |
b664550c | 341 | } |
7eb3cb9c | 342 | return $more |
1db95b00 PM |
343 | } |
344 | ||
345 | proc readcommit {id} { | |
8974c6f9 | 346 | if {[catch {set contents [exec git cat-file commit $id]}]} return |
8f7d0cec | 347 | parsecommit $id $contents 0 |
b490a991 PM |
348 | } |
349 | ||
50b44ece | 350 | proc updatecommits {} { |
b0cdca99 | 351 | global viewdata curview phase displayorder ordertok idpending |
a69b2d1a | 352 | global children commitrow selectedline thickerline showneartags |
50b44ece | 353 | |
22626ef4 PM |
354 | if {$phase ne {}} { |
355 | stop_rev_list | |
356 | set phase {} | |
fd8ccbec | 357 | } |
d94f8cd6 | 358 | set n $curview |
da7c24dd PM |
359 | foreach id $displayorder { |
360 | catch {unset children($n,$id)} | |
361 | catch {unset commitrow($n,$id)} | |
b0cdca99 PM |
362 | catch {unset ordertok($n,$id)} |
363 | } | |
364 | foreach vid [array names idpending "$n,*"] { | |
365 | unset idpending($vid) | |
da7c24dd | 366 | } |
d94f8cd6 | 367 | set curview -1 |
908c3585 PM |
368 | catch {unset selectedline} |
369 | catch {unset thickerline} | |
d94f8cd6 | 370 | catch {unset viewdata($n)} |
fd8ccbec | 371 | readrefs |
e11f1233 | 372 | changedrefs |
a69b2d1a PM |
373 | if {$showneartags} { |
374 | getallcommits | |
375 | } | |
d94f8cd6 | 376 | showview $n |
fd8ccbec PM |
377 | } |
378 | ||
8f7d0cec | 379 | proc parsecommit {id contents listed} { |
b5c2f306 SV |
380 | global commitinfo cdate |
381 | ||
382 | set inhdr 1 | |
383 | set comment {} | |
384 | set headline {} | |
385 | set auname {} | |
386 | set audate {} | |
387 | set comname {} | |
388 | set comdate {} | |
232475d3 PM |
389 | set hdrend [string first "\n\n" $contents] |
390 | if {$hdrend < 0} { | |
391 | # should never happen... | |
392 | set hdrend [string length $contents] | |
393 | } | |
394 | set header [string range $contents 0 [expr {$hdrend - 1}]] | |
395 | set comment [string range $contents [expr {$hdrend + 2}] end] | |
396 | foreach line [split $header "\n"] { | |
397 | set tag [lindex $line 0] | |
398 | if {$tag == "author"} { | |
399 | set audate [lindex $line end-1] | |
400 | set auname [lrange $line 1 end-2] | |
401 | } elseif {$tag == "committer"} { | |
402 | set comdate [lindex $line end-1] | |
403 | set comname [lrange $line 1 end-2] | |
1db95b00 PM |
404 | } |
405 | } | |
232475d3 | 406 | set headline {} |
43c25074 PM |
407 | # take the first non-blank line of the comment as the headline |
408 | set headline [string trimleft $comment] | |
409 | set i [string first "\n" $headline] | |
232475d3 | 410 | if {$i >= 0} { |
43c25074 PM |
411 | set headline [string range $headline 0 $i] |
412 | } | |
413 | set headline [string trimright $headline] | |
414 | set i [string first "\r" $headline] | |
415 | if {$i >= 0} { | |
416 | set headline [string trimright [string range $headline 0 $i]] | |
232475d3 PM |
417 | } |
418 | if {!$listed} { | |
8974c6f9 TH |
419 | # git rev-list indents the comment by 4 spaces; |
420 | # if we got this via git cat-file, add the indentation | |
232475d3 PM |
421 | set newcomment {} |
422 | foreach line [split $comment "\n"] { | |
423 | append newcomment " " | |
424 | append newcomment $line | |
f6e2869f | 425 | append newcomment "\n" |
232475d3 PM |
426 | } |
427 | set comment $newcomment | |
1db95b00 PM |
428 | } |
429 | if {$comdate != {}} { | |
cfb4563c | 430 | set cdate($id) $comdate |
1db95b00 | 431 | } |
e5c2d856 PM |
432 | set commitinfo($id) [list $headline $auname $audate \ |
433 | $comname $comdate $comment] | |
1db95b00 PM |
434 | } |
435 | ||
f7a3e8d2 | 436 | proc getcommit {id} { |
79b2c75e | 437 | global commitdata commitinfo |
8ed16484 | 438 | |
f7a3e8d2 PM |
439 | if {[info exists commitdata($id)]} { |
440 | parsecommit $id $commitdata($id) 1 | |
8ed16484 PM |
441 | } else { |
442 | readcommit $id | |
443 | if {![info exists commitinfo($id)]} { | |
444 | set commitinfo($id) {"No commit information available"} | |
8ed16484 PM |
445 | } |
446 | } | |
447 | return 1 | |
448 | } | |
449 | ||
887fe3c4 | 450 | proc readrefs {} { |
62d3ea65 | 451 | global tagids idtags headids idheads tagobjid |
219ea3a9 | 452 | global otherrefids idotherrefs mainhead mainheadid |
106288cb | 453 | |
b5c2f306 SV |
454 | foreach v {tagids idtags headids idheads otherrefids idotherrefs} { |
455 | catch {unset $v} | |
456 | } | |
62d3ea65 PM |
457 | set refd [open [list | git show-ref -d] r] |
458 | while {[gets $refd line] >= 0} { | |
459 | if {[string index $line 40] ne " "} continue | |
460 | set id [string range $line 0 39] | |
461 | set ref [string range $line 41 end] | |
462 | if {![string match "refs/*" $ref]} continue | |
463 | set name [string range $ref 5 end] | |
464 | if {[string match "remotes/*" $name]} { | |
465 | if {![string match "*/HEAD" $name]} { | |
466 | set headids($name) $id | |
467 | lappend idheads($id) $name | |
f1d83ba3 | 468 | } |
62d3ea65 PM |
469 | } elseif {[string match "heads/*" $name]} { |
470 | set name [string range $name 6 end] | |
36a7cad6 JH |
471 | set headids($name) $id |
472 | lappend idheads($id) $name | |
62d3ea65 PM |
473 | } elseif {[string match "tags/*" $name]} { |
474 | # this lets refs/tags/foo^{} overwrite refs/tags/foo, | |
475 | # which is what we want since the former is the commit ID | |
476 | set name [string range $name 5 end] | |
477 | if {[string match "*^{}" $name]} { | |
478 | set name [string range $name 0 end-3] | |
479 | } else { | |
480 | set tagobjid($name) $id | |
481 | } | |
482 | set tagids($name) $id | |
483 | lappend idtags($id) $name | |
36a7cad6 JH |
484 | } else { |
485 | set otherrefids($name) $id | |
486 | lappend idotherrefs($id) $name | |
f1d83ba3 PM |
487 | } |
488 | } | |
062d671f | 489 | catch {close $refd} |
8a48571c | 490 | set mainhead {} |
219ea3a9 | 491 | set mainheadid {} |
8a48571c PM |
492 | catch { |
493 | set thehead [exec git symbolic-ref HEAD] | |
494 | if {[string match "refs/heads/*" $thehead]} { | |
495 | set mainhead [string range $thehead 11 end] | |
219ea3a9 PM |
496 | if {[info exists headids($mainhead)]} { |
497 | set mainheadid $headids($mainhead) | |
498 | } | |
8a48571c PM |
499 | } |
500 | } | |
887fe3c4 PM |
501 | } |
502 | ||
8f489363 PM |
503 | # skip over fake commits |
504 | proc first_real_row {} { | |
505 | global nullid nullid2 displayorder numcommits | |
506 | ||
507 | for {set row 0} {$row < $numcommits} {incr row} { | |
508 | set id [lindex $displayorder $row] | |
509 | if {$id ne $nullid && $id ne $nullid2} { | |
510 | break | |
511 | } | |
512 | } | |
513 | return $row | |
514 | } | |
515 | ||
e11f1233 PM |
516 | # update things for a head moved to a child of its previous location |
517 | proc movehead {id name} { | |
518 | global headids idheads | |
519 | ||
520 | removehead $headids($name) $name | |
521 | set headids($name) $id | |
522 | lappend idheads($id) $name | |
523 | } | |
524 | ||
525 | # update things when a head has been removed | |
526 | proc removehead {id name} { | |
527 | global headids idheads | |
528 | ||
529 | if {$idheads($id) eq $name} { | |
530 | unset idheads($id) | |
531 | } else { | |
532 | set i [lsearch -exact $idheads($id) $name] | |
533 | if {$i >= 0} { | |
534 | set idheads($id) [lreplace $idheads($id) $i $i] | |
535 | } | |
536 | } | |
537 | unset headids($name) | |
538 | } | |
539 | ||
e54be9e3 | 540 | proc show_error {w top msg} { |
df3d83b1 PM |
541 | message $w.m -text $msg -justify center -aspect 400 |
542 | pack $w.m -side top -fill x -padx 20 -pady 20 | |
e54be9e3 | 543 | button $w.ok -text OK -command "destroy $top" |
df3d83b1 | 544 | pack $w.ok -side bottom -fill x |
e54be9e3 PM |
545 | bind $top <Visibility> "grab $top; focus $top" |
546 | bind $top <Key-Return> "destroy $top" | |
547 | tkwait window $top | |
df3d83b1 PM |
548 | } |
549 | ||
098dd8a3 PM |
550 | proc error_popup msg { |
551 | set w .error | |
552 | toplevel $w | |
553 | wm transient $w . | |
e54be9e3 | 554 | show_error $w $w $msg |
098dd8a3 PM |
555 | } |
556 | ||
10299152 PM |
557 | proc confirm_popup msg { |
558 | global confirm_ok | |
559 | set confirm_ok 0 | |
560 | set w .confirm | |
561 | toplevel $w | |
562 | wm transient $w . | |
563 | message $w.m -text $msg -justify center -aspect 400 | |
564 | pack $w.m -side top -fill x -padx 20 -pady 20 | |
565 | button $w.ok -text OK -command "set confirm_ok 1; destroy $w" | |
566 | pack $w.ok -side left -fill x | |
567 | button $w.cancel -text Cancel -command "destroy $w" | |
568 | pack $w.cancel -side right -fill x | |
569 | bind $w <Visibility> "grab $w; focus $w" | |
570 | tkwait window $w | |
571 | return $confirm_ok | |
572 | } | |
573 | ||
d94f8cd6 | 574 | proc makewindow {} { |
fdedbcfb | 575 | global canv canv2 canv3 linespc charspc ctext cflist |
7e12f1a6 | 576 | global textfont mainfont uifont tabstop |
b74fd579 | 577 | global findtype findtypemenu findloc findstring fstring geometry |
887fe3c4 | 578 | global entries sha1entry sha1string sha1but |
890fae70 | 579 | global diffcontextstring diffcontext |
94a2eede | 580 | global maincursor textcursor curtextcursor |
219ea3a9 | 581 | global rowctxmenu fakerowmenu mergemax wrapcomment |
60f7a7dc | 582 | global highlight_files gdttype |
3ea06f9f | 583 | global searchstring sstring |
60378c0c | 584 | global bgcolor fgcolor bglist fglist diffcolors selectbgcolor |
10299152 | 585 | global headctxmenu |
9a40c50c PM |
586 | |
587 | menu .bar | |
588 | .bar add cascade -label "File" -menu .bar.file | |
4840be66 | 589 | .bar configure -font $uifont |
9a40c50c | 590 | menu .bar.file |
50b44ece | 591 | .bar.file add command -label "Update" -command updatecommits |
f1d83ba3 | 592 | .bar.file add command -label "Reread references" -command rereadrefs |
887c996e | 593 | .bar.file add command -label "List references" -command showrefs |
1d10f36d | 594 | .bar.file add command -label "Quit" -command doquit |
4840be66 | 595 | .bar.file configure -font $uifont |
712fcc08 PM |
596 | menu .bar.edit |
597 | .bar add cascade -label "Edit" -menu .bar.edit | |
598 | .bar.edit add command -label "Preferences" -command doprefs | |
4840be66 | 599 | .bar.edit configure -font $uifont |
da7c24dd | 600 | |
fdedbcfb | 601 | menu .bar.view -font $uifont |
50b44ece | 602 | .bar add cascade -label "View" -menu .bar.view |
da7c24dd PM |
603 | .bar.view add command -label "New view..." -command {newview 0} |
604 | .bar.view add command -label "Edit view..." -command editview \ | |
605 | -state disabled | |
50b44ece PM |
606 | .bar.view add command -label "Delete view" -command delview -state disabled |
607 | .bar.view add separator | |
a90a6d24 PM |
608 | .bar.view add radiobutton -label "All files" -command {showview 0} \ |
609 | -variable selectedview -value 0 | |
40b87ff8 | 610 | |
9a40c50c PM |
611 | menu .bar.help |
612 | .bar add cascade -label "Help" -menu .bar.help | |
613 | .bar.help add command -label "About gitk" -command about | |
4e95e1f7 | 614 | .bar.help add command -label "Key bindings" -command keys |
4840be66 | 615 | .bar.help configure -font $uifont |
9a40c50c PM |
616 | . configure -menu .bar |
617 | ||
e9937d2a | 618 | # the gui has upper and lower half, parts of a paned window. |
0327d27a | 619 | panedwindow .ctop -orient vertical |
e9937d2a JH |
620 | |
621 | # possibly use assumed geometry | |
9ca72f4f | 622 | if {![info exists geometry(pwsash0)]} { |
e9937d2a JH |
623 | set geometry(topheight) [expr {15 * $linespc}] |
624 | set geometry(topwidth) [expr {80 * $charspc}] | |
625 | set geometry(botheight) [expr {15 * $linespc}] | |
626 | set geometry(botwidth) [expr {50 * $charspc}] | |
9ca72f4f ML |
627 | set geometry(pwsash0) "[expr {40 * $charspc}] 2" |
628 | set geometry(pwsash1) "[expr {60 * $charspc}] 2" | |
e9937d2a JH |
629 | } |
630 | ||
631 | # the upper half will have a paned window, a scroll bar to the right, and some stuff below | |
632 | frame .tf -height $geometry(topheight) -width $geometry(topwidth) | |
633 | frame .tf.histframe | |
634 | panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4 | |
635 | ||
636 | # create three canvases | |
637 | set cscroll .tf.histframe.csb | |
638 | set canv .tf.histframe.pwclist.canv | |
9ca72f4f | 639 | canvas $canv \ |
60378c0c | 640 | -selectbackground $selectbgcolor \ |
f8a2c0d1 | 641 | -background $bgcolor -bd 0 \ |
9f1afe05 | 642 | -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" |
e9937d2a JH |
643 | .tf.histframe.pwclist add $canv |
644 | set canv2 .tf.histframe.pwclist.canv2 | |
9ca72f4f | 645 | canvas $canv2 \ |
60378c0c | 646 | -selectbackground $selectbgcolor \ |
f8a2c0d1 | 647 | -background $bgcolor -bd 0 -yscrollincr $linespc |
e9937d2a JH |
648 | .tf.histframe.pwclist add $canv2 |
649 | set canv3 .tf.histframe.pwclist.canv3 | |
9ca72f4f | 650 | canvas $canv3 \ |
60378c0c | 651 | -selectbackground $selectbgcolor \ |
f8a2c0d1 | 652 | -background $bgcolor -bd 0 -yscrollincr $linespc |
e9937d2a | 653 | .tf.histframe.pwclist add $canv3 |
9ca72f4f ML |
654 | eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) |
655 | eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1) | |
e9937d2a JH |
656 | |
657 | # a scroll bar to rule them | |
658 | scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 | |
659 | pack $cscroll -side right -fill y | |
660 | bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w} | |
f8a2c0d1 | 661 | lappend bglist $canv $canv2 $canv3 |
e9937d2a | 662 | pack .tf.histframe.pwclist -fill both -expand 1 -side left |
98f350e5 | 663 | |
e9937d2a JH |
664 | # we have two button bars at bottom of top frame. Bar 1 |
665 | frame .tf.bar | |
666 | frame .tf.lbar -height 15 | |
667 | ||
668 | set sha1entry .tf.bar.sha1 | |
887fe3c4 | 669 | set entries $sha1entry |
e9937d2a | 670 | set sha1but .tf.bar.sha1label |
887fe3c4 | 671 | button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ |
4840be66 | 672 | -command gotocommit -width 8 -font $uifont |
887fe3c4 | 673 | $sha1but conf -disabledforeground [$sha1but cget -foreground] |
e9937d2a | 674 | pack .tf.bar.sha1label -side left |
887fe3c4 PM |
675 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
676 | trace add variable sha1string write sha1change | |
98f350e5 | 677 | pack $sha1entry -side left -pady 2 |
d698206c PM |
678 | |
679 | image create bitmap bm-left -data { | |
680 | #define left_width 16 | |
681 | #define left_height 16 | |
682 | static unsigned char left_bits[] = { | |
683 | 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, | |
684 | 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, | |
685 | 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; | |
686 | } | |
687 | image create bitmap bm-right -data { | |
688 | #define right_width 16 | |
689 | #define right_height 16 | |
690 | static unsigned char right_bits[] = { | |
691 | 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, | |
692 | 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, | |
693 | 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; | |
694 | } | |
e9937d2a | 695 | button .tf.bar.leftbut -image bm-left -command goback \ |
d698206c | 696 | -state disabled -width 26 |
e9937d2a JH |
697 | pack .tf.bar.leftbut -side left -fill y |
698 | button .tf.bar.rightbut -image bm-right -command goforw \ | |
d698206c | 699 | -state disabled -width 26 |
e9937d2a | 700 | pack .tf.bar.rightbut -side left -fill y |
d698206c | 701 | |
e9937d2a JH |
702 | button .tf.bar.findbut -text "Find" -command dofind -font $uifont |
703 | pack .tf.bar.findbut -side left | |
98f350e5 | 704 | set findstring {} |
e9937d2a | 705 | set fstring .tf.bar.findstring |
887fe3c4 | 706 | lappend entries $fstring |
908c3585 | 707 | entry $fstring -width 30 -font $textfont -textvariable findstring |
60f7a7dc | 708 | trace add variable findstring write find_change |
e9937d2a | 709 | pack $fstring -side left -expand 1 -fill x -in .tf.bar |
98f350e5 | 710 | set findtype Exact |
e9937d2a JH |
711 | set findtypemenu [tk_optionMenu .tf.bar.findtype \ |
712 | findtype Exact IgnCase Regexp] | |
60f7a7dc | 713 | trace add variable findtype write find_change |
e9937d2a JH |
714 | .tf.bar.findtype configure -font $uifont |
715 | .tf.bar.findtype.menu configure -font $uifont | |
98f350e5 | 716 | set findloc "All fields" |
e9937d2a | 717 | tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \ |
60f7a7dc PM |
718 | Comments Author Committer |
719 | trace add variable findloc write find_change | |
e9937d2a JH |
720 | .tf.bar.findloc configure -font $uifont |
721 | .tf.bar.findloc.menu configure -font $uifont | |
722 | pack .tf.bar.findloc -side right | |
723 | pack .tf.bar.findtype -side right | |
724 | ||
725 | # build up the bottom bar of upper window | |
726 | label .tf.lbar.flabel -text "Highlight: Commits " \ | |
727 | -font $uifont | |
728 | pack .tf.lbar.flabel -side left -fill y | |
60f7a7dc | 729 | set gdttype "touching paths:" |
e9937d2a JH |
730 | set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \ |
731 | "adding/removing string:"] | |
60f7a7dc PM |
732 | trace add variable gdttype write hfiles_change |
733 | $gm conf -font $uifont | |
e9937d2a JH |
734 | .tf.lbar.gdttype conf -font $uifont |
735 | pack .tf.lbar.gdttype -side left -fill y | |
736 | entry .tf.lbar.fent -width 25 -font $textfont \ | |
908c3585 PM |
737 | -textvariable highlight_files |
738 | trace add variable highlight_files write hfiles_change | |
e9937d2a JH |
739 | lappend entries .tf.lbar.fent |
740 | pack .tf.lbar.fent -side left -fill x -expand 1 | |
741 | label .tf.lbar.vlabel -text " OR in view" -font $uifont | |
742 | pack .tf.lbar.vlabel -side left -fill y | |
908c3585 | 743 | global viewhlmenu selectedhlview |
e9937d2a | 744 | set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None] |
3cd204e5 | 745 | $viewhlmenu entryconf None -command delvhighlight |
63b79191 | 746 | $viewhlmenu conf -font $uifont |
e9937d2a JH |
747 | .tf.lbar.vhl conf -font $uifont |
748 | pack .tf.lbar.vhl -side left -fill y | |
749 | label .tf.lbar.rlabel -text " OR " -font $uifont | |
750 | pack .tf.lbar.rlabel -side left -fill y | |
164ff275 | 751 | global highlight_related |
e9937d2a JH |
752 | set m [tk_optionMenu .tf.lbar.relm highlight_related None \ |
753 | "Descendent" "Not descendent" "Ancestor" "Not ancestor"] | |
164ff275 | 754 | $m conf -font $uifont |
e9937d2a | 755 | .tf.lbar.relm conf -font $uifont |
164ff275 | 756 | trace add variable highlight_related write vrel_change |
e9937d2a JH |
757 | pack .tf.lbar.relm -side left -fill y |
758 | ||
759 | # Finish putting the upper half of the viewer together | |
760 | pack .tf.lbar -in .tf -side bottom -fill x | |
761 | pack .tf.bar -in .tf -side bottom -fill x | |
762 | pack .tf.histframe -fill both -side top -expand 1 | |
763 | .ctop add .tf | |
9ca72f4f ML |
764 | .ctop paneconfigure .tf -height $geometry(topheight) |
765 | .ctop paneconfigure .tf -width $geometry(topwidth) | |
e9937d2a JH |
766 | |
767 | # now build up the bottom | |
768 | panedwindow .pwbottom -orient horizontal | |
769 | ||
770 | # lower left, a text box over search bar, scroll bar to the right | |
771 | # if we know window height, then that will set the lower text height, otherwise | |
772 | # we set lower text height which will drive window height | |
773 | if {[info exists geometry(main)]} { | |
774 | frame .bleft -width $geometry(botwidth) | |
775 | } else { | |
776 | frame .bleft -width $geometry(botwidth) -height $geometry(botheight) | |
777 | } | |
778 | frame .bleft.top | |
a8d610a2 | 779 | frame .bleft.mid |
e9937d2a JH |
780 | |
781 | button .bleft.top.search -text "Search" -command dosearch \ | |
3ea06f9f | 782 | -font $uifont |
e9937d2a JH |
783 | pack .bleft.top.search -side left -padx 5 |
784 | set sstring .bleft.top.sstring | |
3ea06f9f PM |
785 | entry $sstring -width 20 -font $textfont -textvariable searchstring |
786 | lappend entries $sstring | |
787 | trace add variable searchstring write incrsearch | |
788 | pack $sstring -side left -expand 1 -fill x | |
a8d610a2 PM |
789 | radiobutton .bleft.mid.diff -text "Diff" \ |
790 | -command changediffdisp -variable diffelide -value {0 0} | |
791 | radiobutton .bleft.mid.old -text "Old version" \ | |
792 | -command changediffdisp -variable diffelide -value {0 1} | |
793 | radiobutton .bleft.mid.new -text "New version" \ | |
794 | -command changediffdisp -variable diffelide -value {1 0} | |
890fae70 SP |
795 | label .bleft.mid.labeldiffcontext -text " Lines of context: " \ |
796 | -font $uifont | |
a8d610a2 | 797 | pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left |
890fae70 SP |
798 | spinbox .bleft.mid.diffcontext -width 5 -font $textfont \ |
799 | -from 1 -increment 1 -to 10000000 \ | |
800 | -validate all -validatecommand "diffcontextvalidate %P" \ | |
801 | -textvariable diffcontextstring | |
802 | .bleft.mid.diffcontext set $diffcontext | |
803 | trace add variable diffcontextstring write diffcontextchange | |
804 | lappend entries .bleft.mid.diffcontext | |
805 | pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left | |
e9937d2a | 806 | set ctext .bleft.ctext |
f8a2c0d1 | 807 | text $ctext -background $bgcolor -foreground $fgcolor \ |
7e12f1a6 | 808 | -tabs "[expr {$tabstop * $charspc}]" \ |
f8a2c0d1 | 809 | -state disabled -font $textfont \ |
3ea06f9f | 810 | -yscrollcommand scrolltext -wrap none |
e9937d2a JH |
811 | scrollbar .bleft.sb -command "$ctext yview" |
812 | pack .bleft.top -side top -fill x | |
a8d610a2 | 813 | pack .bleft.mid -side top -fill x |
e9937d2a | 814 | pack .bleft.sb -side right -fill y |
d2610d11 | 815 | pack $ctext -side left -fill both -expand 1 |
f8a2c0d1 PM |
816 | lappend bglist $ctext |
817 | lappend fglist $ctext | |
d2610d11 | 818 | |
f1b86294 | 819 | $ctext tag conf comment -wrap $wrapcomment |
f0654861 | 820 | $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" |
f8a2c0d1 PM |
821 | $ctext tag conf hunksep -fore [lindex $diffcolors 2] |
822 | $ctext tag conf d0 -fore [lindex $diffcolors 0] | |
823 | $ctext tag conf d1 -fore [lindex $diffcolors 1] | |
712fcc08 PM |
824 | $ctext tag conf m0 -fore red |
825 | $ctext tag conf m1 -fore blue | |
826 | $ctext tag conf m2 -fore green | |
827 | $ctext tag conf m3 -fore purple | |
828 | $ctext tag conf m4 -fore brown | |
b77b0278 PM |
829 | $ctext tag conf m5 -fore "#009090" |
830 | $ctext tag conf m6 -fore magenta | |
831 | $ctext tag conf m7 -fore "#808000" | |
832 | $ctext tag conf m8 -fore "#009000" | |
833 | $ctext tag conf m9 -fore "#ff0080" | |
834 | $ctext tag conf m10 -fore cyan | |
835 | $ctext tag conf m11 -fore "#b07070" | |
836 | $ctext tag conf m12 -fore "#70b0f0" | |
837 | $ctext tag conf m13 -fore "#70f0b0" | |
838 | $ctext tag conf m14 -fore "#f0b070" | |
839 | $ctext tag conf m15 -fore "#ff70b0" | |
712fcc08 | 840 | $ctext tag conf mmax -fore darkgrey |
b77b0278 | 841 | set mergemax 16 |
712fcc08 PM |
842 | $ctext tag conf mresult -font [concat $textfont bold] |
843 | $ctext tag conf msep -font [concat $textfont bold] | |
844 | $ctext tag conf found -back yellow | |
e5c2d856 | 845 | |
e9937d2a | 846 | .pwbottom add .bleft |
9ca72f4f | 847 | .pwbottom paneconfigure .bleft -width $geometry(botwidth) |
e9937d2a JH |
848 | |
849 | # lower right | |
850 | frame .bright | |
851 | frame .bright.mode | |
852 | radiobutton .bright.mode.patch -text "Patch" \ | |
f8b28a40 | 853 | -command reselectline -variable cmitmode -value "patch" |
d59c4b6f | 854 | .bright.mode.patch configure -font $uifont |
e9937d2a | 855 | radiobutton .bright.mode.tree -text "Tree" \ |
f8b28a40 | 856 | -command reselectline -variable cmitmode -value "tree" |
d59c4b6f | 857 | .bright.mode.tree configure -font $uifont |
e9937d2a JH |
858 | grid .bright.mode.patch .bright.mode.tree -sticky ew |
859 | pack .bright.mode -side top -fill x | |
860 | set cflist .bright.cfiles | |
7fcceed7 | 861 | set indent [font measure $mainfont "nn"] |
e9937d2a | 862 | text $cflist \ |
60378c0c | 863 | -selectbackground $selectbgcolor \ |
f8a2c0d1 PM |
864 | -background $bgcolor -foreground $fgcolor \ |
865 | -font $mainfont \ | |
7fcceed7 | 866 | -tabs [list $indent [expr {2 * $indent}]] \ |
e9937d2a | 867 | -yscrollcommand ".bright.sb set" \ |
7fcceed7 PM |
868 | -cursor [. cget -cursor] \ |
869 | -spacing1 1 -spacing3 1 | |
f8a2c0d1 PM |
870 | lappend bglist $cflist |
871 | lappend fglist $cflist | |
e9937d2a JH |
872 | scrollbar .bright.sb -command "$cflist yview" |
873 | pack .bright.sb -side right -fill y | |
d2610d11 | 874 | pack $cflist -side left -fill both -expand 1 |
89b11d3b PM |
875 | $cflist tag configure highlight \ |
876 | -background [$cflist cget -selectbackground] | |
63b79191 | 877 | $cflist tag configure bold -font [concat $mainfont bold] |
d2610d11 | 878 | |
e9937d2a JH |
879 | .pwbottom add .bright |
880 | .ctop add .pwbottom | |
1db95b00 | 881 | |
e9937d2a JH |
882 | # restore window position if known |
883 | if {[info exists geometry(main)]} { | |
884 | wm geometry . "$geometry(main)" | |
885 | } | |
886 | ||
d23d98d3 SP |
887 | if {[tk windowingsystem] eq {aqua}} { |
888 | set M1B M1 | |
889 | } else { | |
890 | set M1B Control | |
891 | } | |
892 | ||
e9937d2a JH |
893 | bind .pwbottom <Configure> {resizecdetpanes %W %w} |
894 | pack .ctop -fill both -expand 1 | |
c8dfbcf9 PM |
895 | bindall <1> {selcanvline %W %x %y} |
896 | #bindall <B1-Motion> {selcanvline %W %x %y} | |
314c3093 ML |
897 | if {[tk windowingsystem] == "win32"} { |
898 | bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D } | |
899 | bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break } | |
900 | } else { | |
901 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" | |
902 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
903 | } | |
be0cd098 PM |
904 | bindall <2> "canvscan mark %W %x %y" |
905 | bindall <B2-Motion> "canvscan dragto %W %x %y" | |
6e5f7203 RN |
906 | bindkey <Home> selfirstline |
907 | bindkey <End> sellastline | |
17386066 PM |
908 | bind . <Key-Up> "selnextline -1" |
909 | bind . <Key-Down> "selnextline 1" | |
4e7d6779 PM |
910 | bind . <Shift-Key-Up> "next_highlight -1" |
911 | bind . <Shift-Key-Down> "next_highlight 1" | |
6e5f7203 RN |
912 | bindkey <Key-Right> "goforw" |
913 | bindkey <Key-Left> "goback" | |
914 | bind . <Key-Prior> "selnextpage -1" | |
915 | bind . <Key-Next> "selnextpage 1" | |
d23d98d3 SP |
916 | bind . <$M1B-Home> "allcanvs yview moveto 0.0" |
917 | bind . <$M1B-End> "allcanvs yview moveto 1.0" | |
918 | bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units" | |
919 | bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units" | |
920 | bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages" | |
921 | bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages" | |
cfb4563c PM |
922 | bindkey <Key-Delete> "$ctext yview scroll -1 pages" |
923 | bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |
924 | bindkey <Key-space> "$ctext yview scroll 1 pages" | |
df3d83b1 PM |
925 | bindkey p "selnextline -1" |
926 | bindkey n "selnextline 1" | |
6e2dda35 RS |
927 | bindkey z "goback" |
928 | bindkey x "goforw" | |
929 | bindkey i "selnextline -1" | |
930 | bindkey k "selnextline 1" | |
931 | bindkey j "goback" | |
932 | bindkey l "goforw" | |
cfb4563c PM |
933 | bindkey b "$ctext yview scroll -1 pages" |
934 | bindkey d "$ctext yview scroll 18 units" | |
935 | bindkey u "$ctext yview scroll -18 units" | |
b74fd579 PM |
936 | bindkey / {findnext 1} |
937 | bindkey <Key-Return> {findnext 0} | |
df3d83b1 | 938 | bindkey ? findprev |
39ad8570 | 939 | bindkey f nextfile |
e7a09191 | 940 | bindkey <F5> updatecommits |
d23d98d3 SP |
941 | bind . <$M1B-q> doquit |
942 | bind . <$M1B-f> dofind | |
943 | bind . <$M1B-g> {findnext 0} | |
944 | bind . <$M1B-r> dosearchback | |
945 | bind . <$M1B-s> dosearch | |
946 | bind . <$M1B-equal> {incrfont 1} | |
947 | bind . <$M1B-KP_Add> {incrfont 1} | |
948 | bind . <$M1B-minus> {incrfont -1} | |
949 | bind . <$M1B-KP_Subtract> {incrfont -1} | |
b6047c5a | 950 | wm protocol . WM_DELETE_WINDOW doquit |
df3d83b1 | 951 | bind . <Button-1> "click %W" |
17386066 | 952 | bind $fstring <Key-Return> dofind |
887fe3c4 | 953 | bind $sha1entry <Key-Return> gotocommit |
ee3dc72e | 954 | bind $sha1entry <<PasteSelection>> clearsha1 |
7fcceed7 PM |
955 | bind $cflist <1> {sel_flist %W %x %y; break} |
956 | bind $cflist <B1-Motion> {sel_flist %W %x %y; break} | |
f8b28a40 | 957 | bind $cflist <ButtonRelease-1> {treeclick %W %x %y} |
3244729a | 958 | bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y} |
ea13cba1 PM |
959 | |
960 | set maincursor [. cget -cursor] | |
961 | set textcursor [$ctext cget -cursor] | |
94a2eede | 962 | set curtextcursor $textcursor |
84ba7345 | 963 | |
c8dfbcf9 PM |
964 | set rowctxmenu .rowctxmenu |
965 | menu $rowctxmenu -tearoff 0 | |
966 | $rowctxmenu add command -label "Diff this -> selected" \ | |
967 | -command {diffvssel 0} | |
968 | $rowctxmenu add command -label "Diff selected -> this" \ | |
969 | -command {diffvssel 1} | |
74daedb6 | 970 | $rowctxmenu add command -label "Make patch" -command mkpatch |
bdbfbe3d | 971 | $rowctxmenu add command -label "Create tag" -command mktag |
4a2139f5 | 972 | $rowctxmenu add command -label "Write commit to file" -command writecommit |
d6ac1a86 | 973 | $rowctxmenu add command -label "Create new branch" -command mkbranch |
ca6d8f58 PM |
974 | $rowctxmenu add command -label "Cherry-pick this commit" \ |
975 | -command cherrypick | |
6fb735ae PM |
976 | $rowctxmenu add command -label "Reset HEAD branch to here" \ |
977 | -command resethead | |
10299152 | 978 | |
219ea3a9 PM |
979 | set fakerowmenu .fakerowmenu |
980 | menu $fakerowmenu -tearoff 0 | |
981 | $fakerowmenu add command -label "Diff this -> selected" \ | |
982 | -command {diffvssel 0} | |
983 | $fakerowmenu add command -label "Diff selected -> this" \ | |
984 | -command {diffvssel 1} | |
985 | $fakerowmenu add command -label "Make patch" -command mkpatch | |
986 | # $fakerowmenu add command -label "Commit" -command {mkcommit 0} | |
987 | # $fakerowmenu add command -label "Commit all" -command {mkcommit 1} | |
988 | # $fakerowmenu add command -label "Revert local changes" -command revertlocal | |
989 | ||
10299152 PM |
990 | set headctxmenu .headctxmenu |
991 | menu $headctxmenu -tearoff 0 | |
992 | $headctxmenu add command -label "Check out this branch" \ | |
993 | -command cobranch | |
994 | $headctxmenu add command -label "Remove this branch" \ | |
995 | -command rmbranch | |
3244729a PM |
996 | |
997 | global flist_menu | |
998 | set flist_menu .flistctxmenu | |
999 | menu $flist_menu -tearoff 0 | |
1000 | $flist_menu add command -label "Highlight this too" \ | |
1001 | -command {flist_hl 0} | |
1002 | $flist_menu add command -label "Highlight this only" \ | |
1003 | -command {flist_hl 1} | |
df3d83b1 PM |
1004 | } |
1005 | ||
314c3093 ML |
1006 | # Windows sends all mouse wheel events to the current focused window, not |
1007 | # the one where the mouse hovers, so bind those events here and redirect | |
1008 | # to the correct window | |
1009 | proc windows_mousewheel_redirector {W X Y D} { | |
1010 | global canv canv2 canv3 | |
1011 | set w [winfo containing -displayof $W $X $Y] | |
1012 | if {$w ne ""} { | |
1013 | set u [expr {$D < 0 ? 5 : -5}] | |
1014 | if {$w == $canv || $w == $canv2 || $w == $canv3} { | |
1015 | allcanvs yview scroll $u units | |
1016 | } else { | |
1017 | catch { | |
1018 | $w yview scroll $u units | |
1019 | } | |
1020 | } | |
1021 | } | |
1022 | } | |
1023 | ||
be0cd098 PM |
1024 | # mouse-2 makes all windows scan vertically, but only the one |
1025 | # the cursor is in scans horizontally | |
1026 | proc canvscan {op w x y} { | |
1027 | global canv canv2 canv3 | |
1028 | foreach c [list $canv $canv2 $canv3] { | |
1029 | if {$c == $w} { | |
1030 | $c scan $op $x $y | |
1031 | } else { | |
1032 | $c scan $op 0 $y | |
1033 | } | |
1034 | } | |
1035 | } | |
1036 | ||
9f1afe05 PM |
1037 | proc scrollcanv {cscroll f0 f1} { |
1038 | $cscroll set $f0 $f1 | |
1039 | drawfrac $f0 $f1 | |
908c3585 | 1040 | flushhighlights |
9f1afe05 PM |
1041 | } |
1042 | ||
df3d83b1 PM |
1043 | # when we make a key binding for the toplevel, make sure |
1044 | # it doesn't get triggered when that key is pressed in the | |
1045 | # find string entry widget. | |
1046 | proc bindkey {ev script} { | |
887fe3c4 | 1047 | global entries |
df3d83b1 PM |
1048 | bind . $ev $script |
1049 | set escript [bind Entry $ev] | |
1050 | if {$escript == {}} { | |
1051 | set escript [bind Entry <Key>] | |
1052 | } | |
887fe3c4 PM |
1053 | foreach e $entries { |
1054 | bind $e $ev "$escript; break" | |
1055 | } | |
df3d83b1 PM |
1056 | } |
1057 | ||
1058 | # set the focus back to the toplevel for any click outside | |
887fe3c4 | 1059 | # the entry widgets |
df3d83b1 | 1060 | proc click {w} { |
bd441de4 ML |
1061 | global ctext entries |
1062 | foreach e [concat $entries $ctext] { | |
887fe3c4 | 1063 | if {$w == $e} return |
df3d83b1 | 1064 | } |
887fe3c4 | 1065 | focus . |
0fba86b3 PM |
1066 | } |
1067 | ||
1068 | proc savestuff {w} { | |
7e12f1a6 | 1069 | global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop |
712fcc08 | 1070 | global stuffsaved findmergefiles maxgraphpct |
219ea3a9 | 1071 | global maxwidth showneartags showlocalchanges |
098dd8a3 | 1072 | global viewname viewfiles viewargs viewperm nextviewnum |
e8b5f4be | 1073 | global cmitmode wrapcomment datetimeformat |
890fae70 | 1074 | global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor |
4ef17537 | 1075 | |
0fba86b3 | 1076 | if {$stuffsaved} return |
df3d83b1 | 1077 | if {![winfo viewable .]} return |
0fba86b3 PM |
1078 | catch { |
1079 | set f [open "~/.gitk-new" w] | |
f0654861 PM |
1080 | puts $f [list set mainfont $mainfont] |
1081 | puts $f [list set textfont $textfont] | |
4840be66 | 1082 | puts $f [list set uifont $uifont] |
7e12f1a6 | 1083 | puts $f [list set tabstop $tabstop] |
f0654861 | 1084 | puts $f [list set findmergefiles $findmergefiles] |
8d858d1a | 1085 | puts $f [list set maxgraphpct $maxgraphpct] |
04c13d38 | 1086 | puts $f [list set maxwidth $maxwidth] |
f8b28a40 | 1087 | puts $f [list set cmitmode $cmitmode] |
f1b86294 | 1088 | puts $f [list set wrapcomment $wrapcomment] |
b8ab2e17 | 1089 | puts $f [list set showneartags $showneartags] |
219ea3a9 | 1090 | puts $f [list set showlocalchanges $showlocalchanges] |
e8b5f4be | 1091 | puts $f [list set datetimeformat $datetimeformat] |
f8a2c0d1 PM |
1092 | puts $f [list set bgcolor $bgcolor] |
1093 | puts $f [list set fgcolor $fgcolor] | |
1094 | puts $f [list set colors $colors] | |
1095 | puts $f [list set diffcolors $diffcolors] | |
890fae70 | 1096 | puts $f [list set diffcontext $diffcontext] |
60378c0c | 1097 | puts $f [list set selectbgcolor $selectbgcolor] |
e9937d2a | 1098 | |
b6047c5a | 1099 | puts $f "set geometry(main) [wm geometry .]" |
e9937d2a JH |
1100 | puts $f "set geometry(topwidth) [winfo width .tf]" |
1101 | puts $f "set geometry(topheight) [winfo height .tf]" | |
9ca72f4f ML |
1102 | puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\"" |
1103 | puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\"" | |
e9937d2a JH |
1104 | puts $f "set geometry(botwidth) [winfo width .bleft]" |
1105 | puts $f "set geometry(botheight) [winfo height .bleft]" | |
1106 | ||
a90a6d24 PM |
1107 | puts -nonewline $f "set permviews {" |
1108 | for {set v 0} {$v < $nextviewnum} {incr v} { | |
1109 | if {$viewperm($v)} { | |
098dd8a3 | 1110 | puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}" |
a90a6d24 PM |
1111 | } |
1112 | } | |
1113 | puts $f "}" | |
0fba86b3 PM |
1114 | close $f |
1115 | file rename -force "~/.gitk-new" "~/.gitk" | |
1116 | } | |
1117 | set stuffsaved 1 | |
1db95b00 PM |
1118 | } |
1119 | ||
43bddeb4 PM |
1120 | proc resizeclistpanes {win w} { |
1121 | global oldwidth | |
418c4c7b | 1122 | if {[info exists oldwidth($win)]} { |
43bddeb4 PM |
1123 | set s0 [$win sash coord 0] |
1124 | set s1 [$win sash coord 1] | |
1125 | if {$w < 60} { | |
1126 | set sash0 [expr {int($w/2 - 2)}] | |
1127 | set sash1 [expr {int($w*5/6 - 2)}] | |
1128 | } else { | |
1129 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |
1130 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |
1131 | set sash1 [expr {int($factor * [lindex $s1 0])}] | |
1132 | if {$sash0 < 30} { | |
1133 | set sash0 30 | |
1134 | } | |
1135 | if {$sash1 < $sash0 + 20} { | |
2ed49d54 | 1136 | set sash1 [expr {$sash0 + 20}] |
43bddeb4 PM |
1137 | } |
1138 | if {$sash1 > $w - 10} { | |
2ed49d54 | 1139 | set sash1 [expr {$w - 10}] |
43bddeb4 | 1140 | if {$sash0 > $sash1 - 20} { |
2ed49d54 | 1141 | set sash0 [expr {$sash1 - 20}] |
43bddeb4 PM |
1142 | } |
1143 | } | |
1144 | } | |
1145 | $win sash place 0 $sash0 [lindex $s0 1] | |
1146 | $win sash place 1 $sash1 [lindex $s1 1] | |
1147 | } | |
1148 | set oldwidth($win) $w | |
1149 | } | |
1150 | ||
1151 | proc resizecdetpanes {win w} { | |
1152 | global oldwidth | |
418c4c7b | 1153 | if {[info exists oldwidth($win)]} { |
43bddeb4 PM |
1154 | set s0 [$win sash coord 0] |
1155 | if {$w < 60} { | |
1156 | set sash0 [expr {int($w*3/4 - 2)}] | |
1157 | } else { | |
1158 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |
1159 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |
1160 | if {$sash0 < 45} { | |
1161 | set sash0 45 | |
1162 | } | |
1163 | if {$sash0 > $w - 15} { | |
2ed49d54 | 1164 | set sash0 [expr {$w - 15}] |
43bddeb4 PM |
1165 | } |
1166 | } | |
1167 | $win sash place 0 $sash0 [lindex $s0 1] | |
1168 | } | |
1169 | set oldwidth($win) $w | |
1170 | } | |
1171 | ||
b5721c72 PM |
1172 | proc allcanvs args { |
1173 | global canv canv2 canv3 | |
1174 | eval $canv $args | |
1175 | eval $canv2 $args | |
1176 | eval $canv3 $args | |
1177 | } | |
1178 | ||
1179 | proc bindall {event action} { | |
1180 | global canv canv2 canv3 | |
1181 | bind $canv $event $action | |
1182 | bind $canv2 $event $action | |
1183 | bind $canv3 $event $action | |
1184 | } | |
1185 | ||
9a40c50c | 1186 | proc about {} { |
d59c4b6f | 1187 | global uifont |
9a40c50c PM |
1188 | set w .about |
1189 | if {[winfo exists $w]} { | |
1190 | raise $w | |
1191 | return | |
1192 | } | |
1193 | toplevel $w | |
1194 | wm title $w "About gitk" | |
1195 | message $w.m -text { | |
9f1afe05 | 1196 | Gitk - a commit viewer for git |
9a40c50c | 1197 | |
9f1afe05 | 1198 |