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