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