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