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