Merge master.kernel.org:/pub/scm/gitk/gitk
[git/git.git] / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "${1+$@}"
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
1db95b00 10proc getcommits {rargs} {
e2ede2b9 11 global commits commfd phase canv mainfont env
9ccbdfbf 12 global startmsecs nextupdate
b490a991 13 global ctext maincursor textcursor leftover
9ccbdfbf 14
e2ede2b9
PM
15 # check that we can find a .git directory somewhere...
16 if {[info exists env(GIT_DIR)]} {
17 set gitdir $env(GIT_DIR)
18 } else {
19 set gitdir ".git"
20 }
21 if {![file isdirectory $gitdir]} {
22 error_popup "Cannot find the git directory \"$gitdir\"."
23 exit 1
24 }
1db95b00 25 set commits {}
1d10f36d 26 set phase getcommits
9ccbdfbf
PM
27 set startmsecs [clock clicks -milliseconds]
28 set nextupdate [expr $startmsecs + 100]
2efef4b9 29 if [catch {
b490a991 30 set parse_args [concat --default HEAD $rargs]
2efef4b9
PM
31 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
32 }] {
b490a991 33 # if git-rev-parse failed for some reason...
2efef4b9
PM
34 if {$rargs == {}} {
35 set rargs HEAD
36 }
b490a991 37 set parsed_args $rargs
2efef4b9
PM
38 }
39 if [catch {
b490a991 40 set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
2efef4b9 41 } err] {
cfb4563c 42 puts stderr "Error executing git-rev-list: $err"
1d10f36d
PM
43 exit 1
44 }
b490a991
PM
45 set leftover {}
46 fconfigure $commfd -blocking 0 -translation binary
47 fileevent $commfd readable "getcommitlines $commfd"
1d10f36d
PM
48 $canv delete all
49 $canv create text 3 3 -anchor nw -text "Reading commits..." \
50 -font $mainfont -tags textitems
ea13cba1
PM
51 . config -cursor watch
52 $ctext config -cursor watch
1d10f36d
PM
53}
54
b490a991 55proc getcommitlines {commfd} {
a823a911 56 global commits parents cdate children nchildren
9ccbdfbf 57 global commitlisted phase commitinfo nextupdate
b490a991 58 global stopped redisplaying leftover
9ccbdfbf 59
b490a991
PM
60 set stuff [read $commfd]
61 if {$stuff == {}} {
1d10f36d 62 if {![eof $commfd]} return
df3d83b1
PM
63 # this works around what is apparently a bug in Tcl...
64 fconfigure $commfd -blocking 1
1d10f36d 65 if {![catch {close $commfd} err]} {
9ccbdfbf 66 after idle finishcommits
1d10f36d
PM
67 return
68 }
9a40c50c 69 if {[string range $err 0 4] == "usage"} {
9ccbdfbf
PM
70 set err \
71{Gitk: error reading commits: bad arguments to git-rev-list.
72(Note: arguments to gitk are passed to git-rev-list
73to allow selection of commits to be displayed.)}
9a40c50c 74 } else {
df3d83b1 75 set err "Error reading commits: $err"
9a40c50c 76 }
df3d83b1 77 error_popup $err
1d10f36d 78 exit 1
9a40c50c 79 }
b490a991
PM
80 set start 0
81 while 1 {
82 set i [string first "\0" $stuff $start]
83 if {$i < 0} {
7e952e79 84 append leftover [string range $stuff $start end]
b490a991 85 return
9ccbdfbf 86 }
b490a991
PM
87 set cmit [string range $stuff $start [expr {$i - 1}]]
88 if {$start == 0} {
89 set cmit "$leftover$cmit"
7e952e79 90 set leftover {}
b490a991
PM
91 }
92 set start [expr {$i + 1}]
93 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
7e952e79
PM
94 set shortcmit $cmit
95 if {[string length $shortcmit] > 80} {
96 set shortcmit "[string range $shortcmit 0 80]..."
97 }
98 error_popup "Can't parse git-rev-list output: {$shortcmit}"
b490a991
PM
99 exit 1
100 }
101 set cmit [string range $cmit 41 end]
102 lappend commits $id
103 set commitlisted($id) 1
104 parsecommit $id $cmit 1
105 drawcommit $id
106 if {[clock clicks -milliseconds] >= $nextupdate} {
107 doupdate
108 }
109 while {$redisplaying} {
110 set redisplaying 0
111 if {$stopped == 1} {
112 set stopped 0
113 set phase "getcommits"
114 foreach id $commits {
115 drawcommit $id
116 if {$stopped} break
117 if {[clock clicks -milliseconds] >= $nextupdate} {
118 doupdate
119 }
9ccbdfbf
PM
120 }
121 }
122 }
123 }
124}
125
126proc doupdate {} {
127 global commfd nextupdate
128
129 incr nextupdate 100
130 fileevent $commfd readable {}
131 update
b490a991 132 fileevent $commfd readable "getcommitlines $commfd"
1db95b00
PM
133}
134
135proc readcommit {id} {
b490a991
PM
136 if [catch {set contents [exec git-cat-file commit $id]}] return
137 parsecommit $id $contents 0
138}
139
140proc parsecommit {id contents listed} {
9ccbdfbf 141 global commitinfo children nchildren parents nparents cdate ncleft
9ccbdfbf 142
1db95b00
PM
143 set inhdr 1
144 set comment {}
145 set headline {}
146 set auname {}
147 set audate {}
148 set comname {}
149 set comdate {}
cfb4563c
PM
150 if {![info exists nchildren($id)]} {
151 set children($id) {}
152 set nchildren($id) 0
9ccbdfbf 153 set ncleft($id) 0
cfb4563c
PM
154 }
155 set parents($id) {}
156 set nparents($id) 0
df3d83b1 157 foreach line [split $contents "\n"] {
1db95b00
PM
158 if {$inhdr} {
159 if {$line == {}} {
160 set inhdr 0
161 } else {
162 set tag [lindex $line 0]
cfb4563c
PM
163 if {$tag == "parent"} {
164 set p [lindex $line 1]
165 if {![info exists nchildren($p)]} {
166 set children($p) {}
167 set nchildren($p) 0
9ccbdfbf 168 set ncleft($p) 0
cfb4563c
PM
169 }
170 lappend parents($id) $p
171 incr nparents($id)
a823a911 172 # sometimes we get a commit that lists a parent twice...
b490a991 173 if {$listed && [lsearch -exact $children($p) $id] < 0} {
cfb4563c
PM
174 lappend children($p) $id
175 incr nchildren($p)
9ccbdfbf 176 incr ncleft($p)
cfb4563c
PM
177 }
178 } elseif {$tag == "author"} {
1db95b00
PM
179 set x [expr {[llength $line] - 2}]
180 set audate [lindex $line $x]
181 set auname [lrange $line 1 [expr {$x - 1}]]
182 } elseif {$tag == "committer"} {
183 set x [expr {[llength $line] - 2}]
184 set comdate [lindex $line $x]
185 set comname [lrange $line 1 [expr {$x - 1}]]
186 }
187 }
188 } else {
189 if {$comment == {}} {
806ce097 190 set headline [string trim $line]
1db95b00
PM
191 } else {
192 append comment "\n"
193 }
806ce097
PM
194 if {!$listed} {
195 # git-rev-list indents the comment by 4 spaces;
196 # if we got this via git-cat-file, add the indentation
197 append comment " "
198 }
1db95b00
PM
199 append comment $line
200 }
201 }
202 if {$audate != {}} {
203 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
204 }
205 if {$comdate != {}} {
cfb4563c 206 set cdate($id) $comdate
1db95b00
PM
207 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
208 }
e5c2d856
PM
209 set commitinfo($id) [list $headline $auname $audate \
210 $comname $comdate $comment]
1db95b00
PM
211}
212
887fe3c4 213proc readrefs {} {
c2f6a022 214 global tagids idtags headids idheads
887fe3c4
PM
215 set tags [glob -nocomplain -types f .git/refs/tags/*]
216 foreach f $tags {
217 catch {
218 set fd [open $f r]
219 set line [read $fd]
220 if {[regexp {^[0-9a-f]{40}} $line id]} {
9ccbdfbf
PM
221 set direct [file tail $f]
222 set tagids($direct) $id
223 lappend idtags($id) $direct
887fe3c4
PM
224 set contents [split [exec git-cat-file tag $id] "\n"]
225 set obj {}
226 set type {}
227 set tag {}
228 foreach l $contents {
229 if {$l == {}} break
230 switch -- [lindex $l 0] {
231 "object" {set obj [lindex $l 1]}
232 "type" {set type [lindex $l 1]}
233 "tag" {set tag [string range $l 4 end]}
234 }
235 }
236 if {$obj != {} && $type == "commit" && $tag != {}} {
237 set tagids($tag) $obj
238 lappend idtags($obj) $tag
239 }
240 }
c2f6a022
PM
241 close $fd
242 }
243 }
244 set heads [glob -nocomplain -types f .git/refs/heads/*]
245 foreach f $heads {
246 catch {
247 set fd [open $f r]
248 set line [read $fd 40]
249 if {[regexp {^[0-9a-f]{40}} $line id]} {
250 set head [file tail $f]
251 set headids($head) $line
252 lappend idheads($line) $head
253 }
254 close $fd
887fe3c4
PM
255 }
256 }
257}
258
df3d83b1
PM
259proc error_popup msg {
260 set w .error
261 toplevel $w
262 wm transient $w .
263 message $w.m -text $msg -justify center -aspect 400
264 pack $w.m -side top -fill x -padx 20 -pady 20
265 button $w.ok -text OK -command "destroy $w"
266 pack $w.ok -side bottom -fill x
267 bind $w <Visibility> "grab $w; focus $w"
268 tkwait window $w
269}
270
1db95b00 271proc makewindow {} {
e5c2d856 272 global canv canv2 canv3 linespc charspc ctext cflist textfont
887fe3c4
PM
273 global findtype findloc findstring fstring geometry
274 global entries sha1entry sha1string sha1but
ea13cba1 275 global maincursor textcursor
c8dfbcf9 276 global rowctxmenu
9a40c50c
PM
277
278 menu .bar
279 .bar add cascade -label "File" -menu .bar.file
280 menu .bar.file
1d10f36d 281 .bar.file add command -label "Quit" -command doquit
9a40c50c
PM
282 menu .bar.help
283 .bar add cascade -label "Help" -menu .bar.help
284 .bar.help add command -label "About gitk" -command about
285 . configure -menu .bar
286
0fba86b3
PM
287 if {![info exists geometry(canv1)]} {
288 set geometry(canv1) [expr 45 * $charspc]
289 set geometry(canv2) [expr 30 * $charspc]
290 set geometry(canv3) [expr 15 * $charspc]
291 set geometry(canvh) [expr 25 * $linespc + 4]
292 set geometry(ctextw) 80
293 set geometry(ctexth) 30
294 set geometry(cflistw) 30
295 }
0327d27a 296 panedwindow .ctop -orient vertical
0fba86b3
PM
297 if {[info exists geometry(width)]} {
298 .ctop conf -width $geometry(width) -height $geometry(height)
17386066
PM
299 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
300 set geometry(ctexth) [expr {($texth - 8) /
301 [font metrics $textfont -linespace]}]
0fba86b3 302 }
98f350e5
PM
303 frame .ctop.top
304 frame .ctop.top.bar
305 pack .ctop.top.bar -side bottom -fill x
306 set cscroll .ctop.top.csb
307 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
308 pack $cscroll -side right -fill y
309 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
310 pack .ctop.top.clist -side top -fill both -expand 1
311 .ctop add .ctop.top
312 set canv .ctop.top.clist.canv
0fba86b3 313 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
b5721c72
PM
314 -bg white -bd 0 \
315 -yscrollincr $linespc -yscrollcommand "$cscroll set"
98f350e5
PM
316 .ctop.top.clist add $canv
317 set canv2 .ctop.top.clist.canv2
0fba86b3 318 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
b5721c72 319 -bg white -bd 0 -yscrollincr $linespc
98f350e5
PM
320 .ctop.top.clist add $canv2
321 set canv3 .ctop.top.clist.canv3
0fba86b3 322 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
b5721c72 323 -bg white -bd 0 -yscrollincr $linespc
98f350e5 324 .ctop.top.clist add $canv3
43bddeb4 325 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
98f350e5
PM
326
327 set sha1entry .ctop.top.bar.sha1
887fe3c4
PM
328 set entries $sha1entry
329 set sha1but .ctop.top.bar.sha1label
330 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
331 -command gotocommit -width 8
332 $sha1but conf -disabledforeground [$sha1but cget -foreground]
98f350e5 333 pack .ctop.top.bar.sha1label -side left
887fe3c4
PM
334 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
335 trace add variable sha1string write sha1change
98f350e5
PM
336 pack $sha1entry -side left -pady 2
337 button .ctop.top.bar.findbut -text "Find" -command dofind
338 pack .ctop.top.bar.findbut -side left
339 set findstring {}
df3d83b1 340 set fstring .ctop.top.bar.findstring
887fe3c4 341 lappend entries $fstring
df3d83b1 342 entry $fstring -width 30 -font $textfont -textvariable findstring
df3d83b1 343 pack $fstring -side left -expand 1 -fill x
98f350e5
PM
344 set findtype Exact
345 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
346 set findloc "All fields"
347 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
348 Comments Author Committer
349 pack .ctop.top.bar.findloc -side right
350 pack .ctop.top.bar.findtype -side right
b5721c72 351
5ad588de
PM
352 panedwindow .ctop.cdet -orient horizontal
353 .ctop add .ctop.cdet
d2610d11
PM
354 frame .ctop.cdet.left
355 set ctext .ctop.cdet.left.ctext
0fba86b3
PM
356 text $ctext -bg white -state disabled -font $textfont \
357 -width $geometry(ctextw) -height $geometry(ctexth) \
d2610d11
PM
358 -yscrollcommand ".ctop.cdet.left.sb set"
359 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
360 pack .ctop.cdet.left.sb -side right -fill y
361 pack $ctext -side left -fill both -expand 1
362 .ctop.cdet add .ctop.cdet.left
363
e5c2d856
PM
364 $ctext tag conf filesep -font [concat $textfont bold]
365 $ctext tag conf hunksep -back blue -fore white
366 $ctext tag conf d0 -back "#ff8080"
367 $ctext tag conf d1 -back green
df3d83b1 368 $ctext tag conf found -back yellow
e5c2d856 369
d2610d11
PM
370 frame .ctop.cdet.right
371 set cflist .ctop.cdet.right.cfiles
17386066 372 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
d2610d11
PM
373 -yscrollcommand ".ctop.cdet.right.sb set"
374 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
375 pack .ctop.cdet.right.sb -side right -fill y
376 pack $cflist -side left -fill both -expand 1
377 .ctop.cdet add .ctop.cdet.right
0fba86b3 378 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
d2610d11 379
0327d27a 380 pack .ctop -side top -fill both -expand 1
1db95b00 381
c8dfbcf9
PM
382 bindall <1> {selcanvline %W %x %y}
383 #bindall <B1-Motion> {selcanvline %W %x %y}
cfb4563c
PM
384 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
385 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
b5721c72
PM
386 bindall <2> "allcanvs scan mark 0 %y"
387 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
17386066
PM
388 bind . <Key-Up> "selnextline -1"
389 bind . <Key-Down> "selnextline 1"
cfb4563c
PM
390 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
391 bind . <Key-Next> "allcanvs yview scroll 1 pages"
392 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
393 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
394 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
395 bindkey p "selnextline -1"
396 bindkey n "selnextline 1"
cfb4563c
PM
397 bindkey b "$ctext yview scroll -1 pages"
398 bindkey d "$ctext yview scroll 18 units"
399 bindkey u "$ctext yview scroll -18 units"
df3d83b1
PM
400 bindkey / findnext
401 bindkey ? findprev
39ad8570 402 bindkey f nextfile
1d10f36d 403 bind . <Control-q> doquit
98f350e5
PM
404 bind . <Control-f> dofind
405 bind . <Control-g> findnext
406 bind . <Control-r> findprev
1d10f36d
PM
407 bind . <Control-equal> {incrfont 1}
408 bind . <Control-KP_Add> {incrfont 1}
409 bind . <Control-minus> {incrfont -1}
410 bind . <Control-KP_Subtract> {incrfont -1}
e5c2d856 411 bind $cflist <<ListboxSelect>> listboxsel
0fba86b3 412 bind . <Destroy> {savestuff %W}
df3d83b1 413 bind . <Button-1> "click %W"
17386066 414 bind $fstring <Key-Return> dofind
887fe3c4 415 bind $sha1entry <Key-Return> gotocommit
ee3dc72e 416 bind $sha1entry <<PasteSelection>> clearsha1
ea13cba1
PM
417
418 set maincursor [. cget -cursor]
419 set textcursor [$ctext cget -cursor]
84ba7345 420
c8dfbcf9
PM
421 set rowctxmenu .rowctxmenu
422 menu $rowctxmenu -tearoff 0
423 $rowctxmenu add command -label "Diff this -> selected" \
424 -command {diffvssel 0}
425 $rowctxmenu add command -label "Diff selected -> this" \
426 -command {diffvssel 1}
74daedb6 427 $rowctxmenu add command -label "Make patch" -command mkpatch
bdbfbe3d 428 $rowctxmenu add command -label "Create tag" -command mktag
4a2139f5 429 $rowctxmenu add command -label "Write commit to file" -command writecommit
df3d83b1
PM
430}
431
432# when we make a key binding for the toplevel, make sure
433# it doesn't get triggered when that key is pressed in the
434# find string entry widget.
435proc bindkey {ev script} {
887fe3c4 436 global entries
df3d83b1
PM
437 bind . $ev $script
438 set escript [bind Entry $ev]
439 if {$escript == {}} {
440 set escript [bind Entry <Key>]
441 }
887fe3c4
PM
442 foreach e $entries {
443 bind $e $ev "$escript; break"
444 }
df3d83b1
PM
445}
446
447# set the focus back to the toplevel for any click outside
887fe3c4 448# the entry widgets
df3d83b1 449proc click {w} {
887fe3c4
PM
450 global entries
451 foreach e $entries {
452 if {$w == $e} return
df3d83b1 453 }
887fe3c4 454 focus .
0fba86b3
PM
455}
456
457proc savestuff {w} {
458 global canv canv2 canv3 ctext cflist mainfont textfont
459 global stuffsaved
460 if {$stuffsaved} return
df3d83b1 461 if {![winfo viewable .]} return
0fba86b3
PM
462 catch {
463 set f [open "~/.gitk-new" w]
464 puts $f "set mainfont {$mainfont}"
465 puts $f "set textfont {$textfont}"
466 puts $f "set geometry(width) [winfo width .ctop]"
467 puts $f "set geometry(height) [winfo height .ctop]"
df3d83b1
PM
468 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
469 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
470 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
471 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
0fba86b3
PM
472 set wid [expr {([winfo width $ctext] - 8) \
473 / [font measure $textfont "0"]}]
0fba86b3 474 puts $f "set geometry(ctextw) $wid"
0fba86b3
PM
475 set wid [expr {([winfo width $cflist] - 11) \
476 / [font measure [$cflist cget -font] "0"]}]
477 puts $f "set geometry(cflistw) $wid"
478 close $f
479 file rename -force "~/.gitk-new" "~/.gitk"
480 }
481 set stuffsaved 1
1db95b00
PM
482}
483
43bddeb4
PM
484proc resizeclistpanes {win w} {
485 global oldwidth
486 if [info exists oldwidth($win)] {
487 set s0 [$win sash coord 0]
488 set s1 [$win sash coord 1]
489 if {$w < 60} {
490 set sash0 [expr {int($w/2 - 2)}]
491 set sash1 [expr {int($w*5/6 - 2)}]
492 } else {
493 set factor [expr {1.0 * $w / $oldwidth($win)}]
494 set sash0 [expr {int($factor * [lindex $s0 0])}]
495 set sash1 [expr {int($factor * [lindex $s1 0])}]
496 if {$sash0 < 30} {
497 set sash0 30
498 }
499 if {$sash1 < $sash0 + 20} {
500 set sash1 [expr $sash0 + 20]
501 }
502 if {$sash1 > $w - 10} {
503 set sash1 [expr $w - 10]
504 if {$sash0 > $sash1 - 20} {
505 set sash0 [expr $sash1 - 20]
506 }
507 }
508 }
509 $win sash place 0 $sash0 [lindex $s0 1]
510 $win sash place 1 $sash1 [lindex $s1 1]
511 }
512 set oldwidth($win) $w
513}
514
515proc resizecdetpanes {win w} {
516 global oldwidth
517 if [info exists oldwidth($win)] {
518 set s0 [$win sash coord 0]
519 if {$w < 60} {
520 set sash0 [expr {int($w*3/4 - 2)}]
521 } else {
522 set factor [expr {1.0 * $w / $oldwidth($win)}]
523 set sash0 [expr {int($factor * [lindex $s0 0])}]
524 if {$sash0 < 45} {
525 set sash0 45
526 }
527 if {$sash0 > $w - 15} {
528 set sash0 [expr $w - 15]
529 }
530 }
531 $win sash place 0 $sash0 [lindex $s0 1]
532 }
533 set oldwidth($win) $w
534}
535
b5721c72
PM
536proc allcanvs args {
537 global canv canv2 canv3
538 eval $canv $args
539 eval $canv2 $args
540 eval $canv3 $args
541}
542
543proc bindall {event action} {
544 global canv canv2 canv3
545 bind $canv $event $action
546 bind $canv2 $event $action
547 bind $canv3 $event $action
548}
549
9a40c50c
PM
550proc about {} {
551 set w .about
552 if {[winfo exists $w]} {
553 raise $w
554 return
555 }
556 toplevel $w
557 wm title $w "About gitk"
558 message $w.m -text {
c8dfbcf9 559Gitk version 1.2
9a40c50c
PM
560
561