]>
Commit | Line | Data |
---|---|---|
1db95b00 PM |
1 | #!/bin/sh |
2 | # Tcl ignores the next line -*- tcl -*- \ | |
9e026d39 | 3 | exec wish "$0" -- "$@" |
1db95b00 PM |
4 | |
5 | # Copyright (C) 2005 Paul Mackerras. All rights reserved. | |
6 | # This program is free software; it may be used, copied, modified | |
7 | # and distributed under the terms of the GNU General Public Licence, | |
8 | # either version 2, or (at your option) any later version. | |
9 | ||
73b6a6cb JH |
10 | proc gitdir {} { |
11 | global env | |
12 | if {[info exists env(GIT_DIR)]} { | |
13 | return $env(GIT_DIR) | |
14 | } else { | |
15 | return ".git" | |
16 | } | |
17 | } | |
18 | ||
b5c2f306 SV |
19 | proc parse_args {rargs} { |
20 | global parsed_args | |
21 | ||
418c4c7b | 22 | if {[catch { |
b5c2f306 SV |
23 | set parse_args [concat --default HEAD $rargs] |
24 | set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"] | |
418c4c7b | 25 | }]} { |
b5c2f306 SV |
26 | # if git-rev-parse failed for some reason... |
27 | if {$rargs == {}} { | |
28 | set rargs HEAD | |
29 | } | |
30 | set parsed_args $rargs | |
31 | } | |
32 | return $parsed_args | |
33 | } | |
34 | ||
38ad0910 | 35 | proc start_rev_list {rlargs} { |
466e4fdd | 36 | global startmsecs nextupdate ncmupdate |
9f1afe05 | 37 | global commfd leftover tclencoding datemode |
9ccbdfbf | 38 | |
9ccbdfbf | 39 | set startmsecs [clock clicks -milliseconds] |
2ed49d54 | 40 | set nextupdate [expr {$startmsecs + 100}] |
b664550c | 41 | set ncmupdate 1 |
8f7d0cec | 42 | initlayout |
9f1afe05 PM |
43 | set order "--topo-order" |
44 | if {$datemode} { | |
45 | set order "--date-order" | |
46 | } | |
418c4c7b | 47 | if {[catch { |
9f1afe05 | 48 | set commfd [open [concat | git-rev-list --header $order \ |
16c1ff96 | 49 | --parents --boundary $rlargs] r] |
418c4c7b | 50 | } err]} { |
cfb4563c | 51 | puts stderr "Error executing git-rev-list: $err" |
1d10f36d PM |
52 | exit 1 |
53 | } | |
b490a991 | 54 | set leftover {} |
fd8ccbec PM |
55 | fconfigure $commfd -blocking 0 -translation lf |
56 | if {$tclencoding != {}} { | |
57 | fconfigure $commfd -encoding $tclencoding | |
58 | } | |
466e4fdd | 59 | fileevent $commfd readable [list getcommitlines $commfd] |
38ad0910 PM |
60 | . config -cursor watch |
61 | settextcursor watch | |
62 | } | |
63 | ||
64 | proc getcommits {rargs} { | |
aa81d974 | 65 | global phase canv mainfont |
38ad0910 | 66 | |
38ad0910 PM |
67 | set phase getcommits |
68 | start_rev_list [parse_args $rargs] | |
1d10f36d PM |
69 | $canv delete all |
70 | $canv create text 3 3 -anchor nw -text "Reading commits..." \ | |
71 | -font $mainfont -tags textitems | |
72 | } | |
73 | ||
b490a991 | 74 | proc getcommitlines {commfd} { |
8ed16484 PM |
75 | global commitlisted nextupdate |
76 | global leftover | |
77 | global displayorder commitidx commitrow commitdata | |
9ccbdfbf | 78 | |
b490a991 PM |
79 | set stuff [read $commfd] |
80 | if {$stuff == {}} { | |
1d10f36d | 81 | if {![eof $commfd]} return |
f0654861 | 82 | # set it blocking so we wait for the process to terminate |
df3d83b1 | 83 | fconfigure $commfd -blocking 1 |
1d10f36d | 84 | if {![catch {close $commfd} err]} { |
9ccbdfbf | 85 | after idle finishcommits |
1d10f36d PM |
86 | return |
87 | } | |
9a40c50c | 88 | if {[string range $err 0 4] == "usage"} { |
9ccbdfbf | 89 | set err \ |
2ed49d54 JH |
90 | "Gitk: error reading commits: bad arguments to git-rev-list.\ |
91 | (Note: arguments to gitk are passed to git-rev-list\ | |
92 | to allow selection of commits to be displayed.)" | |
9a40c50c | 93 | } else { |
df3d83b1 | 94 | set err "Error reading commits: $err" |
9a40c50c | 95 | } |
df3d83b1 | 96 | error_popup $err |
1d10f36d | 97 | exit 1 |
9a40c50c | 98 | } |
b490a991 | 99 | set start 0 |
8f7d0cec | 100 | set gotsome 0 |
b490a991 PM |
101 | while 1 { |
102 | set i [string first "\0" $stuff $start] | |
103 | if {$i < 0} { | |
7e952e79 | 104 | append leftover [string range $stuff $start end] |
9f1afe05 | 105 | break |
9ccbdfbf | 106 | } |
b490a991 | 107 | if {$start == 0} { |
8f7d0cec PM |
108 | set cmit $leftover |
109 | append cmit [string range $stuff 0 [expr {$i - 1}]] | |
7e952e79 | 110 | set leftover {} |
8f7d0cec PM |
111 | } else { |
112 | set cmit [string range $stuff $start [expr {$i - 1}]] | |
b490a991 PM |
113 | } |
114 | set start [expr {$i + 1}] | |
e5ea701b PM |
115 | set j [string first "\n" $cmit] |
116 | set ok 0 | |
16c1ff96 | 117 | set listed 1 |
e5ea701b PM |
118 | if {$j >= 0} { |
119 | set ids [string range $cmit 0 [expr {$j - 1}]] | |
16c1ff96 PM |
120 | if {[string range $ids 0 0] == "-"} { |
121 | set listed 0 | |
122 | set ids [string range $ids 1 end] | |
123 | } | |
e5ea701b PM |
124 | set ok 1 |
125 | foreach id $ids { | |
8f7d0cec | 126 | if {[string length $id] != 40} { |
e5ea701b PM |
127 | set ok 0 |
128 | break | |
129 | } | |
130 | } | |
131 | } | |
132 | if {!$ok} { | |
7e952e79 PM |
133 | set shortcmit $cmit |
134 | if {[string length $shortcmit] > 80} { | |
135 | set shortcmit "[string range $shortcmit 0 80]..." | |
136 | } | |
137 | error_popup "Can't parse git-rev-list output: {$shortcmit}" | |
b490a991 PM |
138 | exit 1 |
139 | } | |
e5ea701b | 140 | set id [lindex $ids 0] |
16c1ff96 PM |
141 | if {$listed} { |
142 | set olds [lrange $ids 1 end] | |
143 | set commitlisted($id) 1 | |
144 | } else { | |
145 | set olds {} | |
146 | } | |
f7a3e8d2 PM |
147 | updatechildren $id $olds |
148 | set commitdata($id) [string range $cmit [expr {$j + 1}] end] | |
8f7d0cec PM |
149 | set commitrow($id) $commitidx |
150 | incr commitidx | |
151 | lappend displayorder $id | |
152 | set gotsome 1 | |
153 | } | |
154 | if {$gotsome} { | |
155 | layoutmore | |
9f1afe05 | 156 | } |
9f1afe05 PM |
157 | if {[clock clicks -milliseconds] >= $nextupdate} { |
158 | doupdate 1 | |
9ccbdfbf PM |
159 | } |
160 | } | |
161 | ||
b664550c PM |
162 | proc doupdate {reading} { |
163 | global commfd nextupdate numcommits ncmupdate | |
9ccbdfbf | 164 | |
b664550c PM |
165 | if {$reading} { |
166 | fileevent $commfd readable {} | |
167 | } | |
9ccbdfbf | 168 | update |
b664550c PM |
169 | set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
170 | if {$numcommits < 100} { | |
171 | set ncmupdate [expr {$numcommits + 1}] | |
172 | } elseif {$numcommits < 10000} { | |
173 | set ncmupdate [expr {$numcommits + 10}] | |
174 | } else { | |
175 | set ncmupdate [expr {$numcommits + 100}] | |
176 | } | |
177 | if {$reading} { | |
178 | fileevent $commfd readable [list getcommitlines $commfd] | |
179 | } | |
1db95b00 PM |
180 | } |
181 | ||
182 | proc readcommit {id} { | |
418c4c7b | 183 | if {[catch {set contents [exec git-cat-file commit $id]}]} return |
8f7d0cec PM |
184 | updatechildren $id {} |
185 | parsecommit $id $contents 0 | |
b490a991 PM |
186 | } |
187 | ||
fd8ccbec | 188 | proc updatecommits {rargs} { |
aa81d974 PM |
189 | stopfindproc |
190 | foreach v {children nchildren parents nparents commitlisted | |
8f7d0cec PM |
191 | colormap selectedline matchinglines treediffs |
192 | mergefilelist currentid rowtextx commitrow | |
aa81d974 PM |
193 | rowidlist rowoffsets idrowranges idrangedrawn iddrawn |
194 | linesegends crossings cornercrossings} { | |
195 | global $v | |
196 | catch {unset $v} | |
fd8ccbec | 197 | } |
aa81d974 | 198 | allcanvs delete all |
fd8ccbec | 199 | readrefs |
aa81d974 | 200 | getcommits $rargs |
fd8ccbec PM |
201 | } |
202 | ||
b5c2f306 | 203 | proc updatechildren {id olds} { |
9f1afe05 | 204 | global children nchildren parents nparents |
9ccbdfbf | 205 | |
cfb4563c PM |
206 | if {![info exists nchildren($id)]} { |
207 | set children($id) {} | |
208 | set nchildren($id) 0 | |
209 | } | |
e5ea701b PM |
210 | set parents($id) $olds |
211 | set nparents($id) [llength $olds] | |
212 | foreach p $olds { | |
213 | if {![info exists nchildren($p)]} { | |
214 | set children($p) [list $id] | |
215 | set nchildren($p) 1 | |
e5ea701b PM |
216 | } elseif {[lsearch -exact $children($p) $id] < 0} { |
217 | lappend children($p) $id | |
218 | incr nchildren($p) | |
244edd12 PM |
219 | } |
220 | } | |
b5c2f306 SV |
221 | } |
222 | ||
8f7d0cec | 223 | proc parsecommit {id contents listed} { |
b5c2f306 SV |
224 | global commitinfo cdate |
225 | ||
226 | set inhdr 1 | |
227 | set comment {} | |
228 | set headline {} | |
229 | set auname {} | |
230 | set audate {} | |
231 | set comname {} | |
232 | set comdate {} | |
232475d3 PM |
233 | set hdrend [string first "\n\n" $contents] |
234 | if {$hdrend < 0} { | |
235 | # should never happen... | |
236 | set hdrend [string length $contents] | |
237 | } | |
238 | set header [string range $contents 0 [expr {$hdrend - 1}]] | |
239 | set comment [string range $contents [expr {$hdrend + 2}] end] | |
240 | foreach line [split $header "\n"] { | |
241 | set tag [lindex $line 0] | |
242 | if {$tag == "author"} { | |
243 | set audate [lindex $line end-1] | |
244 | set auname [lrange $line 1 end-2] | |
245 | } elseif {$tag == "committer"} { | |
246 | set comdate [lindex $line end-1] | |
247 | set comname [lrange $line 1 end-2] | |
1db95b00 PM |
248 | } |
249 | } | |
232475d3 PM |
250 | set headline {} |
251 | # take the first line of the comment as the headline | |
252 | set i [string first "\n" $comment] | |
253 | if {$i >= 0} { | |
254 | set headline [string trim [string range $comment 0 $i]] | |
f6e2869f PM |
255 | } else { |
256 | set headline $comment | |
232475d3 PM |
257 | } |
258 | if {!$listed} { | |
259 | # git-rev-list indents the comment by 4 spaces; | |
260 | # if we got this via git-cat-file, add the indentation | |
261 | set newcomment {} | |
262 | foreach line [split $comment "\n"] { | |
263 | append newcomment " " | |
264 | append newcomment $line | |
f6e2869f | 265 | append newcomment "\n" |
232475d3 PM |
266 | } |
267 | set comment $newcomment | |
1db95b00 PM |
268 | } |
269 | if {$comdate != {}} { | |
cfb4563c | 270 | set cdate($id) $comdate |
1db95b00 | 271 | } |
e5c2d856 PM |
272 | set commitinfo($id) [list $headline $auname $audate \ |
273 | $comname $comdate $comment] | |
1db95b00 PM |
274 | } |
275 | ||
f7a3e8d2 PM |
276 | proc getcommit {id} { |
277 | global commitdata commitinfo nparents | |
8ed16484 | 278 | |
f7a3e8d2 PM |
279 | if {[info exists commitdata($id)]} { |
280 | parsecommit $id $commitdata($id) 1 | |
8ed16484 PM |
281 | } else { |
282 | readcommit $id | |
283 | if {![info exists commitinfo($id)]} { | |
284 | set commitinfo($id) {"No commit information available"} | |
285 | set nparents($id) 0 | |
286 | } | |
287 | } | |
288 | return 1 | |
289 | } | |
290 | ||
887fe3c4 | 291 | proc readrefs {} { |
106288cb | 292 | global tagids idtags headids idheads tagcontents |
36a7cad6 | 293 | global otherrefids idotherrefs |
106288cb | 294 | |
b5c2f306 SV |
295 | foreach v {tagids idtags headids idheads otherrefids idotherrefs} { |
296 | catch {unset $v} | |
297 | } | |
36a7cad6 JH |
298 | set refd [open [list | git-ls-remote [gitdir]] r] |
299 | while {0 <= [set n [gets $refd line]]} { | |
300 | if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \ | |
301 | match id path]} { | |
302 | continue | |
c2f6a022 | 303 | } |
36a7cad6 JH |
304 | if {![regexp {^(tags|heads)/(.*)$} $path match type name]} { |
305 | set type others | |
306 | set name $path | |
887fe3c4 | 307 | } |
36a7cad6 JH |
308 | if {$type == "tags"} { |
309 | set tagids($name) $id | |
310 | lappend idtags($id) $name | |
311 | set obj {} | |
312 | set type {} | |
313 | set tag {} | |
314 | catch { | |
315 | set commit [exec git-rev-parse "$id^0"] | |
316 | if {"$commit" != "$id"} { | |
317 | set tagids($name) $commit | |
318 | lappend idtags($commit) $name | |
319 | } | |
320 | } | |
321 | catch { | |
322 | set tagcontents($name) [exec git-cat-file tag "$id"] | |
f1d83ba3 | 323 | } |
36a7cad6 JH |
324 | } elseif { $type == "heads" } { |
325 | set headids($name) $id | |
326 | lappend idheads($id) $name | |
327 | } else { | |
328 | set otherrefids($name) $id | |
329 | lappend idotherrefs($id) $name | |
f1d83ba3 PM |
330 | } |
331 | } | |
36a7cad6 | 332 | close $refd |
887fe3c4 PM |
333 | } |
334 | ||
df3d83b1 PM |
335 | proc error_popup msg { |
336 | set w .error | |
337 | toplevel $w | |
338 | wm transient $w . | |
339 | message $w.m -text $msg -justify center -aspect 400 | |
340 | pack $w.m -side top -fill x -padx 20 -pady 20 | |
341 | button $w.ok -text OK -command "destroy $w" | |
342 | pack $w.ok -side bottom -fill x | |
343 | bind $w <Visibility> "grab $w; focus $w" | |
9f841cf1 | 344 | bind $w <Key-Return> "destroy $w" |
df3d83b1 PM |
345 | tkwait window $w |
346 | } | |
347 | ||
b5c2f306 | 348 | proc makewindow {rargs} { |
e5c2d856 | 349 | global canv canv2 canv3 linespc charspc ctext cflist textfont |
b74fd579 | 350 | global findtype findtypemenu findloc findstring fstring geometry |
887fe3c4 | 351 | global entries sha1entry sha1string sha1but |
94a2eede | 352 | global maincursor textcursor curtextcursor |
712fcc08 | 353 | global rowctxmenu mergemax |
9a40c50c PM |
354 | |
355 | menu .bar | |
356 | .bar add cascade -label "File" -menu .bar.file | |
357 | menu .bar.file | |
b5c2f306 | 358 | .bar.file add command -label "Update" -command [list updatecommits $rargs] |
f1d83ba3 | 359 | .bar.file add command -label "Reread references" -command rereadrefs |
1d10f36d | 360 | .bar.file add command -label "Quit" -command doquit |
712fcc08 PM |
361 | menu .bar.edit |
362 | .bar add cascade -label "Edit" -menu .bar.edit | |
363 | .bar.edit add command -label "Preferences" -command doprefs | |
9a40c50c PM |
364 | menu .bar.help |
365 | .bar add cascade -label "Help" -menu .bar.help | |
366 | .bar.help add command -label "About gitk" -command about | |
367 | . configure -menu .bar | |
368 | ||
0fba86b3 | 369 | if {![info exists geometry(canv1)]} { |
2ed49d54 JH |
370 | set geometry(canv1) [expr {45 * $charspc}] |
371 | set geometry(canv2) [expr {30 * $charspc}] | |
372 | set geometry(canv3) [expr {15 * $charspc}] | |
373 | set geometry(canvh) [expr {25 * $linespc + 4}] | |
0fba86b3 PM |
374 | set geometry(ctextw) 80 |
375 | set geometry(ctexth) 30 | |
376 | set geometry(cflistw) 30 | |
377 | } | |
0327d27a | 378 | panedwindow .ctop -orient vertical |
0fba86b3 PM |
379 | if {[info exists geometry(width)]} { |
380 | .ctop conf -width $geometry(width) -height $geometry(height) | |
17386066 PM |
381 | set texth [expr {$geometry(height) - $geometry(canvh) - 56}] |
382 | set geometry(ctexth) [expr {($texth - 8) / | |
383 | [font metrics $textfont -linespace]}] | |
0fba86b3 | 384 | } |
98f350e5 PM |
385 | frame .ctop.top |
386 | frame .ctop.top.bar | |
387 | pack .ctop.top.bar -side bottom -fill x | |
388 | set cscroll .ctop.top.csb | |
389 | scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 | |
390 | pack $cscroll -side right -fill y | |
391 | panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 | |
392 | pack .ctop.top.clist -side top -fill both -expand 1 | |
393 | .ctop add .ctop.top | |
394 | set canv .ctop.top.clist.canv | |
0fba86b3 | 395 | canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ |
b5721c72 | 396 | -bg white -bd 0 \ |
9f1afe05 | 397 | -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" |
98f350e5 PM |
398 | .ctop.top.clist add $canv |
399 | set canv2 .ctop.top.clist.canv2 | |
0fba86b3 | 400 | canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ |
b5721c72 | 401 | -bg white -bd 0 -yscrollincr $linespc |
98f350e5 PM |
402 | .ctop.top.clist add $canv2 |
403 | set canv3 .ctop.top.clist.canv3 | |
0fba86b3 | 404 | canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ |
b5721c72 | 405 | -bg white -bd 0 -yscrollincr $linespc |
98f350e5 | 406 | .ctop.top.clist add $canv3 |
43bddeb4 | 407 | bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} |
98f350e5 PM |
408 | |
409 | set sha1entry .ctop.top.bar.sha1 | |
887fe3c4 PM |
410 | set entries $sha1entry |
411 | set sha1but .ctop.top.bar.sha1label | |
412 | button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ | |
413 | -command gotocommit -width 8 | |
414 | $sha1but conf -disabledforeground [$sha1but cget -foreground] | |
98f350e5 | 415 | pack .ctop.top.bar.sha1label -side left |
887fe3c4 PM |
416 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
417 | trace add variable sha1string write sha1change | |
98f350e5 | 418 | pack $sha1entry -side left -pady 2 |
d698206c PM |
419 | |
420 | image create bitmap bm-left -data { | |
421 | #define left_width 16 | |
422 | #define left_height 16 | |
423 | static unsigned char left_bits[] = { | |
424 | 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, | |
425 | 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, | |
426 | 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; | |
427 | } | |
428 | image create bitmap bm-right -data { | |
429 | #define right_width 16 | |
430 | #define right_height 16 | |
431 | static unsigned char right_bits[] = { | |
432 | 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, | |
433 | 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, | |
434 | 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; | |
435 | } | |
436 | button .ctop.top.bar.leftbut -image bm-left -command goback \ | |
437 | -state disabled -width 26 | |
438 | pack .ctop.top.bar.leftbut -side left -fill y | |
439 | button .ctop.top.bar.rightbut -image bm-right -command goforw \ | |
440 | -state disabled -width 26 | |
441 | pack .ctop.top.bar.rightbut -side left -fill y | |
442 | ||
98f350e5 PM |
443 | button .ctop.top.bar.findbut -text "Find" -command dofind |
444 | pack .ctop.top.bar.findbut -side left | |
445 | set findstring {} | |
df3d83b1 | 446 | set fstring .ctop.top.bar.findstring |
887fe3c4 | 447 | lappend entries $fstring |
df3d83b1 | 448 | entry $fstring -width 30 -font $textfont -textvariable findstring |
df3d83b1 | 449 | pack $fstring -side left -expand 1 -fill x |
98f350e5 | 450 | set findtype Exact |
b74fd579 PM |
451 | set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ |
452 | findtype Exact IgnCase Regexp] | |
98f350e5 PM |
453 | set findloc "All fields" |
454 | tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ | |
b74fd579 | 455 | Comments Author Committer Files Pickaxe |
98f350e5 PM |
456 | pack .ctop.top.bar.findloc -side right |
457 | pack .ctop.top.bar.findtype -side right | |
b74fd579 PM |
458 | # for making sure type==Exact whenever loc==Pickaxe |
459 | trace add variable findloc write findlocchange | |
b5721c72 | 460 | |
5ad588de PM |
461 | panedwindow .ctop.cdet -orient horizontal |
462 | .ctop add .ctop.cdet | |
d2610d11 PM |
463 | frame .ctop.cdet.left |
464 | set ctext .ctop.cdet.left.ctext | |
0fba86b3 PM |
465 | text $ctext -bg white -state disabled -font $textfont \ |
466 | -width $geometry(ctextw) -height $geometry(ctexth) \ | |
b1ba39e7 | 467 | -yscrollcommand ".ctop.cdet.left.sb set" -wrap none |
d2610d11 PM |
468 | scrollbar .ctop.cdet.left.sb -command "$ctext yview" |
469 | pack .ctop.cdet.left.sb -side right -fill y | |
470 | pack $ctext -side left -fill both -expand 1 | |
471 | .ctop.cdet add .ctop.cdet.left | |
472 | ||
f0654861 | 473 | $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" |
712fcc08 PM |
474 | $ctext tag conf hunksep -fore blue |
475 | $ctext tag conf d0 -fore red | |
476 | $ctext tag conf d1 -fore "#00a000" | |
477 | $ctext tag conf m0 -fore red | |
478 | $ctext tag conf m1 -fore blue | |
479 | $ctext tag conf m2 -fore green | |
480 | $ctext tag conf m3 -fore purple | |
481 | $ctext tag conf m4 -fore brown | |
b77b0278 PM |
482 | $ctext tag conf m5 -fore "#009090" |
483 | $ctext tag conf m6 -fore magenta | |
484 | $ctext tag conf m7 -fore "#808000" | |
485 | $ctext tag conf m8 -fore "#009000" | |
486 | $ctext tag conf m9 -fore "#ff0080" | |
487 | $ctext tag conf m10 -fore cyan | |
488 | $ctext tag conf m11 -fore "#b07070" | |
489 | $ctext tag conf m12 -fore "#70b0f0" | |
490 | $ctext tag conf m13 -fore "#70f0b0" | |
491 | $ctext tag conf m14 -fore "#f0b070" | |
492 | $ctext tag conf m15 -fore "#ff70b0" | |
712fcc08 | 493 | $ctext tag conf mmax -fore darkgrey |
b77b0278 | 494 | set mergemax 16 |
712fcc08 PM |
495 | $ctext tag conf mresult -font [concat $textfont bold] |
496 | $ctext tag conf msep -font [concat $textfont bold] | |
497 | $ctext tag conf found -back yellow | |
e5c2d856 | 498 | |
d2610d11 PM |
499 | frame .ctop.cdet.right |
500 | set cflist .ctop.cdet.right.cfiles | |
17386066 | 501 | listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \ |
d2610d11 PM |
502 | -yscrollcommand ".ctop.cdet.right.sb set" |
503 | scrollbar .ctop.cdet.right.sb -command "$cflist yview" | |
504 | pack .ctop.cdet.right.sb -side right -fill y | |
505 | pack $cflist -side left -fill both -expand 1 | |
506 | .ctop.cdet add .ctop.cdet.right | |
0fba86b3 | 507 | bind .ctop.cdet <Configure> {resizecdetpanes %W %w} |
d2610d11 | 508 | |
0327d27a | 509 | pack .ctop -side top -fill both -expand 1 |
1db95b00 | 510 | |
c8dfbcf9 PM |
511 | bindall <1> {selcanvline %W %x %y} |
512 | #bindall <B1-Motion> {selcanvline %W %x %y} | |
cfb4563c PM |
513 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
514 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
be0cd098 PM |
515 | bindall <2> "canvscan mark %W %x %y" |
516 | bindall <B2-Motion> "canvscan dragto %W %x %y" | |
17386066 PM |
517 | bind . <Key-Up> "selnextline -1" |
518 | bind . <Key-Down> "selnextline 1" | |
6e2dda35 RS |
519 | bind . <Key-Right> "goforw" |
520 | bind . <Key-Left> "goback" | |
cfb4563c PM |
521 | bind . <Key-Prior> "allcanvs yview scroll -1 pages" |
522 | bind . <Key-Next> "allcanvs yview scroll 1 pages" | |
523 | bindkey <Key-Delete> "$ctext yview scroll -1 pages" | |
524 | bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |
525 | bindkey <Key-space> "$ctext yview scroll 1 pages" | |
df3d83b1 PM |
526 | bindkey p "selnextline -1" |
527 | bindkey n "selnextline 1" | |
6e2dda35 RS |
528 | bindkey z "goback" |
529 | bindkey x "goforw" | |
530 | bindkey i "selnextline -1" | |
531 | bindkey k "selnextline 1" | |
532 | bindkey j "goback" | |
533 | bindkey l "goforw" | |
cfb4563c PM |
534 | bindkey b "$ctext yview scroll -1 pages" |
535 | bindkey d "$ctext yview scroll 18 units" | |
536 | bindkey u "$ctext yview scroll -18 units" | |
b74fd579 PM |
537 | bindkey / {findnext 1} |
538 | bindkey <Key-Return> {findnext 0} | |
df3d83b1 | 539 | bindkey ? findprev |
39ad8570 | 540 | bindkey f nextfile |
1d10f36d | 541 | bind . <Control-q> doquit |
98f350e5 | 542 | bind . <Control-f> dofind |
b74fd579 | 543 | bind . <Control-g> {findnext 0} |
98f350e5 | 544 | bind . <Control-r> findprev |
1d10f36d PM |
545 | bind . <Control-equal> {incrfont 1} |
546 | bind . <Control-KP_Add> {incrfont 1} | |
547 | bind . <Control-minus> {incrfont -1} | |
548 | bind . <Control-KP_Subtract> {incrfont -1} | |
e5c2d856 | 549 | bind $cflist <<ListboxSelect>> listboxsel |
0fba86b3 | 550 | bind . <Destroy> {savestuff %W} |
df3d83b1 | 551 | bind . <Button-1> "click %W" |
17386066 | 552 | bind $fstring <Key-Return> dofind |
887fe3c4 | 553 | bind $sha1entry <Key-Return> gotocommit |
ee3dc72e | 554 | bind $sha1entry <<PasteSelection>> clearsha1 |
ea13cba1 PM |
555 | |
556 | set maincursor [. cget -cursor] | |
557 | set textcursor [$ctext cget -cursor] | |
94a2eede | 558 | set curtextcursor $textcursor |
84ba7345 | 559 | |
c8dfbcf9 PM |
560 | set rowctxmenu .rowctxmenu |
561 | menu $rowctxmenu -tearoff 0 | |
562 | $rowctxmenu add command -label "Diff this -> selected" \ | |
563 | -command {diffvssel 0} | |
564 | $rowctxmenu add command -label "Diff selected -> this" \ | |
565 | -command {diffvssel 1} | |
74daedb6 | 566 | $rowctxmenu add command -label "Make patch" -command mkpatch |
bdbfbe3d | 567 | $rowctxmenu add command -label "Create tag" -command mktag |
4a2139f5 | 568 | $rowctxmenu add command -label "Write commit to file" -command writecommit |
df3d83b1 PM |
569 | } |
570 | ||
be0cd098 PM |
571 | # mouse-2 makes all windows scan vertically, but only the one |
572 | # the cursor is in scans horizontally | |
573 | proc canvscan {op w x y} { | |
574 | global canv canv2 canv3 | |
575 | foreach c [list $canv $canv2 $canv3] { | |
576 | if {$c == $w} { | |
577 | $c scan $op $x $y | |
578 | } else { | |
579 | $c scan $op 0 $y | |
580 | } | |
581 | } | |
582 | } | |
583 | ||
9f1afe05 PM |
584 | proc scrollcanv {cscroll f0 f1} { |
585 | $cscroll set $f0 $f1 | |
586 | drawfrac $f0 $f1 | |
587 | } | |
588 | ||
df3d83b1 PM |
589 | # when we make a key binding for the toplevel, make sure |
590 | # it doesn't get triggered when that key is pressed in the | |
591 | # find string entry widget. | |
592 | proc bindkey {ev script} { | |
887fe3c4 | 593 | global entries |
df3d83b1 PM |
594 | bind . $ev $script |
595 | set escript [bind Entry $ev] | |
596 | if {$escript == {}} { | |
597 | set escript [bind Entry <Key>] | |
598 | } | |
887fe3c4 PM |
599 | foreach e $entries { |
600 | bind $e $ev "$escript; break" | |
601 | } | |
df3d83b1 PM |
602 | } |
603 | ||
604 | # set the focus back to the toplevel for any click outside | |
887fe3c4 | 605 | # the entry widgets |
df3d83b1 | 606 | proc click {w} { |
887fe3c4 PM |
607 | global entries |
608 | foreach e $entries { | |
609 | if {$w == $e} return | |
df3d83b1 | 610 | } |
887fe3c4 | 611 | focus . |
0fba86b3 PM |
612 | } |
613 | ||
614 | proc savestuff {w} { | |
615 | global canv canv2 canv3 ctext cflist mainfont textfont | |
712fcc08 | 616 | global stuffsaved findmergefiles maxgraphpct |
04c13d38 | 617 | global maxwidth |
4ef17537 | 618 | |
0fba86b3 | 619 | if {$stuffsaved} return |
df3d83b1 | 620 | if {![winfo viewable .]} return |
0fba86b3 PM |
621 | catch { |
622 | set f [open "~/.gitk-new" w] | |
f0654861 PM |
623 | puts $f [list set mainfont $mainfont] |
624 | puts $f [list set textfont $textfont] | |
625 | puts $f [list set findmergefiles $findmergefiles] | |
8d858d1a | 626 | puts $f [list set maxgraphpct $maxgraphpct] |
04c13d38 | 627 | puts $f [list set maxwidth $maxwidth] |
0fba86b3 PM |
628 | puts $f "set geometry(width) [winfo width .ctop]" |
629 | puts $f "set geometry(height) [winfo height .ctop]" | |
2ed49d54 JH |
630 | puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]" |
631 | puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]" | |
632 | puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]" | |
633 | puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]" | |
0fba86b3 PM |
634 | set wid [expr {([winfo width $ctext] - 8) \ |
635 | / [font measure $textfont "0"]}] | |
0fba86b3 | 636 | puts $f "set geometry(ctextw) $wid" |
0fba86b3 PM |
637 | set wid [expr {([winfo width $cflist] - 11) \ |
638 | / [font measure [$cflist cget -font] "0"]}] | |
639 | puts $f "set geometry(cflistw) $wid" | |
640 | close $f | |
641 | file rename -force "~/.gitk-new" "~/.gitk" | |
642 | } | |
643 | set stuffsaved 1 | |
1db95b00 PM |
644 | } |
645 | ||
43bddeb4 PM |
646 | proc resizeclistpanes {win w} { |
647 | global oldwidth | |
418c4c7b | 648 | if {[info exists oldwidth($win)]} { |
43bddeb4 PM |
649 | set s0 [$win sash coord 0] |
650 | set s1 [$win sash coord 1] | |
651 | if {$w < 60} { | |
652 | set sash0 [expr {int($w/2 - 2)}] | |
653 | set sash1 [expr {int($w*5/6 - 2)}] | |
654 | } else { | |
655 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |
656 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |
657 | set sash1 [expr {int($factor * [lindex $s1 0])}] | |
658 | if {$sash0 < 30} { | |
659 | set sash0 30 | |
660 | } | |
661 | if {$sash1 < $sash0 + 20} { | |
2ed49d54 | 662 | set sash1 [expr {$sash0 + 20}] |
43bddeb4 PM |
663 | } |
664 | if {$sash1 > $w - 10} { | |
2ed49d54 | 665 | set sash1 [expr {$w - 10}] |
43bddeb4 | 666 | if {$sash0 > $sash1 - 20} { |
2ed49d54 | 667 | set sash0 [expr {$sash1 - 20}] |
43bddeb4 PM |
668 | } |
669 | } | |
670 | } | |
671 | $win sash place 0 $sash0 [lindex $s0 1] | |
672 | $win sash place 1 $sash1 [lindex $s1 1] | |
673 | } | |
674 | set oldwidth($win) $w | |
675 | } | |
676 | ||
677 | proc resizecdetpanes {win w} { | |
678 | global oldwidth | |
418c4c7b | 679 | if {[info exists oldwidth($win)]} { |
43bddeb4 PM |
680 | set s0 [$win sash coord 0] |
681 | if {$w < 60} { | |
682 | set sash0 [expr {int($w*3/4 - 2)}] | |
683 | } else { | |
684 | set factor [expr {1.0 * $w / $oldwidth($win)}] | |
685 | set sash0 [expr {int($factor * [lindex $s0 0])}] | |
686 | if {$sash0 < 45} { | |
687 | set sash0 45 | |
688 | } | |
689 | if {$sash0 > $w - 15} { | |
2ed49d54 | 690 | set sash0 [expr {$w - 15}] |
43bddeb4 PM |
691 | } |
692 | } | |
693 | $win sash place 0 $sash0 [lindex $s0 1] | |
694 | } | |
695 | set oldwidth($win) $w | |
696 | } | |
697 | ||
b5721c72 PM |
698 | proc allcanvs args { |
699 | global canv canv2 canv3 | |
700 | eval $canv $args | |
701 | eval $canv2 $args | |
702 | eval $canv3 $args | |
703 | } | |
704 | ||
705 | proc bindall {event action} { | |
706 | global canv canv2 canv3 | |
707 | bind $canv $event $action | |
708 | bind $canv2 $event $action | |
709 | bind $canv3 $event $action | |
710 | } | |
711 | ||
9a40c50c PM |
712 | proc about {} { |
713 | set w .about | |
714 | if {[winfo exists $w]} { | |
715 | raise $w | |
716 | return | |
717 | } | |
718 | toplevel $w | |
719 | wm title $w "About gitk" | |
720 | message $w.m -text { | |
9f1afe05 | 721 | Gitk - a commit viewer for git |
9a40c50c | 722 | |
9f1afe05 | 723 |