bdb557184ea41616ff85e93d75762db2e2446dbb
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3 if test "z$*" = zversion \
   4 || test "z$*" = z--version; \
   5 then \
   6        echo 'git-gui version @@GITGUI_VERSION@@'; \
   7        exit; \
   8 fi; \
   9 exec wish "$0" -- "$@"
  10
  11set appvers {@@GITGUI_VERSION@@}
  12set copyright {
  13Copyright © 2006, 2007 Shawn Pearce, et. al.
  14
  15This program is free software; you can redistribute it and/or modify
  16it under the terms of the GNU General Public License as published by
  17the Free Software Foundation; either version 2 of the License, or
  18(at your option) any later version.
  19
  20This program is distributed in the hope that it will be useful,
  21but WITHOUT ANY WARRANTY; without even the implied warranty of
  22MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23GNU General Public License for more details.
  24
  25You should have received a copy of the GNU General Public License
  26along with this program; if not, write to the Free Software
  27Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  28
  29######################################################################
  30##
  31## Tcl/Tk sanity check
  32
  33if {[catch {package require Tcl 8.4} err]
  34 || [catch {package require Tk  8.4} err]
  35} {
  36        catch {wm withdraw .}
  37        tk_messageBox \
  38                -icon error \
  39                -type ok \
  40                -title "git-gui: fatal error" \
  41                -message $err
  42        exit 1
  43}
  44
  45######################################################################
  46##
  47## enable verbose loading?
  48
  49if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  50        unset _verbose
  51        rename auto_load real__auto_load
  52        proc auto_load {name args} {
  53                puts stderr "auto_load $name"
  54                return [uplevel 1 real__auto_load $name $args]
  55        }
  56        rename source real__source
  57        proc source {name} {
  58                puts stderr "source    $name"
  59                uplevel 1 real__source $name
  60        }
  61}
  62
  63######################################################################
  64##
  65## configure our library
  66
  67set oguilib {@@GITGUI_LIBDIR@@}
  68set oguirel {@@GITGUI_RELATIVE@@}
  69if {$oguirel eq {1}} {
  70        set oguilib [file dirname [file dirname [file normalize $argv0]]]
  71        set oguilib [file join $oguilib share git-gui lib]
  72} elseif {[string match @@* $oguirel]} {
  73        set oguilib [file join [file dirname [file normalize $argv0]] lib]
  74}
  75
  76set idx [file join $oguilib tclIndex]
  77if {[catch {set fd [open $idx r]} err]} {
  78        catch {wm withdraw .}
  79        tk_messageBox \
  80                -icon error \
  81                -type ok \
  82                -title "git-gui: fatal error" \
  83                -message $err
  84        exit 1
  85}
  86if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
  87        set idx [list]
  88        while {[gets $fd n] >= 0} {
  89                if {$n ne {} && ![string match #* $n]} {
  90                        lappend idx $n
  91                }
  92        }
  93} else {
  94        set idx {}
  95}
  96close $fd
  97
  98if {$idx ne {}} {
  99        set loaded [list]
 100        foreach p $idx {
 101                if {[lsearch -exact $loaded $p] >= 0} continue
 102                source [file join $oguilib $p]
 103                lappend loaded $p
 104        }
 105        unset loaded p
 106} else {
 107        set auto_path [concat [list $oguilib] $auto_path]
 108}
 109unset -nocomplain oguirel idx fd
 110
 111######################################################################
 112##
 113## read only globals
 114
 115set _appname [lindex [file split $argv0] end]
 116set _gitdir {}
 117set _gitexec {}
 118set _reponame {}
 119set _iscygwin {}
 120set _search_path {}
 121
 122proc appname {} {
 123        global _appname
 124        return $_appname
 125}
 126
 127proc gitdir {args} {
 128        global _gitdir
 129        if {$args eq {}} {
 130                return $_gitdir
 131        }
 132        return [eval [list file join $_gitdir] $args]
 133}
 134
 135proc gitexec {args} {
 136        global _gitexec
 137        if {$_gitexec eq {}} {
 138                if {[catch {set _gitexec [git --exec-path]} err]} {
 139                        error "Git not installed?\n\n$err"
 140                }
 141                if {[is_Cygwin]} {
 142                        set _gitexec [exec cygpath \
 143                                --windows \
 144                                --absolute \
 145                                $_gitexec]
 146                } else {
 147                        set _gitexec [file normalize $_gitexec]
 148                }
 149        }
 150        if {$args eq {}} {
 151                return $_gitexec
 152        }
 153        return [eval [list file join $_gitexec] $args]
 154}
 155
 156proc reponame {} {
 157        global _reponame
 158        return $_reponame
 159}
 160
 161proc is_MacOSX {} {
 162        global tcl_platform tk_library
 163        if {[tk windowingsystem] eq {aqua}} {
 164                return 1
 165        }
 166        return 0
 167}
 168
 169proc is_Windows {} {
 170        global tcl_platform
 171        if {$tcl_platform(platform) eq {windows}} {
 172                return 1
 173        }
 174        return 0
 175}
 176
 177proc is_Cygwin {} {
 178        global tcl_platform _iscygwin
 179        if {$_iscygwin eq {}} {
 180                if {$tcl_platform(platform) eq {windows}} {
 181                        if {[catch {set p [exec cygpath --windir]} err]} {
 182                                set _iscygwin 0
 183                        } else {
 184                                set _iscygwin 1
 185                        }
 186                } else {
 187                        set _iscygwin 0
 188                }
 189        }
 190        return $_iscygwin
 191}
 192
 193proc is_enabled {option} {
 194        global enabled_options
 195        if {[catch {set on $enabled_options($option)}]} {return 0}
 196        return $on
 197}
 198
 199proc enable_option {option} {
 200        global enabled_options
 201        set enabled_options($option) 1
 202}
 203
 204proc disable_option {option} {
 205        global enabled_options
 206        set enabled_options($option) 0
 207}
 208
 209######################################################################
 210##
 211## config
 212
 213proc is_many_config {name} {
 214        switch -glob -- $name {
 215        remote.*.fetch -
 216        remote.*.push
 217                {return 1}
 218        *
 219                {return 0}
 220        }
 221}
 222
 223proc is_config_true {name} {
 224        global repo_config
 225        if {[catch {set v $repo_config($name)}]} {
 226                return 0
 227        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 228                return 1
 229        } else {
 230                return 0
 231        }
 232}
 233
 234proc get_config {name} {
 235        global repo_config
 236        if {[catch {set v $repo_config($name)}]} {
 237                return {}
 238        } else {
 239                return $v
 240        }
 241}
 242
 243proc load_config {include_global} {
 244        global repo_config global_config default_config
 245
 246        array unset global_config
 247        if {$include_global} {
 248                catch {
 249                        set fd_rc [git_read config --global --list]
 250                        while {[gets $fd_rc line] >= 0} {
 251                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 252                                        if {[is_many_config $name]} {
 253                                                lappend global_config($name) $value
 254                                        } else {
 255                                                set global_config($name) $value
 256                                        }
 257                                }
 258                        }
 259                        close $fd_rc
 260                }
 261        }
 262
 263        array unset repo_config
 264        catch {
 265                set fd_rc [git_read config --list]
 266                while {[gets $fd_rc line] >= 0} {
 267                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 268                                if {[is_many_config $name]} {
 269                                        lappend repo_config($name) $value
 270                                } else {
 271                                        set repo_config($name) $value
 272                                }
 273                        }
 274                }
 275                close $fd_rc
 276        }
 277
 278        foreach name [array names default_config] {
 279                if {[catch {set v $global_config($name)}]} {
 280                        set global_config($name) $default_config($name)
 281                }
 282                if {[catch {set v $repo_config($name)}]} {
 283                        set repo_config($name) $default_config($name)
 284                }
 285        }
 286}
 287
 288######################################################################
 289##
 290## handy utils
 291
 292proc _git_cmd {name} {
 293        global _git_cmd_path
 294
 295        if {[catch {set v $_git_cmd_path($name)}]} {
 296                switch -- $name {
 297                  version   -
 298                --version   -
 299                --exec-path { return [list $::_git $name] }
 300                }
 301
 302                set p [gitexec git-$name$::_search_exe]
 303                if {[file exists $p]} {
 304                        set v [list $p]
 305                } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 306                        # Try to determine what sort of magic will make
 307                        # git-$name go and do its thing, because native
 308                        # Tcl on Windows doesn't know it.
 309                        #
 310                        set p [gitexec git-$name]
 311                        set f [open $p r]
 312                        set s [gets $f]
 313                        close $f
 314
 315                        switch -glob -- $s {
 316                        #!*sh     { set i sh     }
 317                        #!*perl   { set i perl   }
 318                        #!*python { set i python }
 319                        default   { error "git-$name is not supported: $s" }
 320                        }
 321
 322                        upvar #0 _$i interp
 323                        if {![info exists interp]} {
 324                                set interp [_which $i]
 325                        }
 326                        if {$interp eq {}} {
 327                                error "git-$name requires $i (not in PATH)"
 328                        }
 329                        set v [list $interp $p]
 330                } else {
 331                        # Assume it is builtin to git somehow and we
 332                        # aren't actually able to see a file for it.
 333                        #
 334                        set v [list $::_git $name]
 335                }
 336                set _git_cmd_path($name) $v
 337        }
 338        return $v
 339}
 340
 341proc _which {what} {
 342        global env _search_exe _search_path
 343
 344        if {$_search_path eq {}} {
 345                if {[is_Cygwin]} {
 346                        set _search_path [split [exec cygpath \
 347                                --windows \
 348                                --path \
 349                                --absolute \
 350                                $env(PATH)] {;}]
 351                        set _search_exe .exe
 352                } elseif {[is_Windows]} {
 353                        set _search_path [split $env(PATH) {;}]
 354                        set _search_exe .exe
 355                } else {
 356                        set _search_path [split $env(PATH) :]
 357                        set _search_exe {}
 358                }
 359        }
 360
 361        foreach p $_search_path {
 362                set p [file join $p $what$_search_exe]
 363                if {[file exists $p]} {
 364                        return [file normalize $p]
 365                }
 366        }
 367        return {}
 368}
 369
 370proc git {args} {
 371        set opt [list exec]
 372
 373        while {1} {
 374                switch -- [lindex $args 0] {
 375                --nice {
 376                        global _nice
 377                        if {$_nice ne {}} {
 378                                lappend opt $_nice
 379                        }
 380                }
 381
 382                default {
 383                        break
 384                }
 385
 386                }
 387
 388                set args [lrange $args 1 end]
 389        }
 390
 391        set cmdp [_git_cmd [lindex $args 0]]
 392        set args [lrange $args 1 end]
 393
 394        return [eval $opt $cmdp $args]
 395}
 396
 397proc _open_stdout_stderr {cmd} {
 398        if {[catch {
 399                        set fd [open $cmd r]
 400                } err]} {
 401                if {   [lindex $cmd end] eq {2>@1}
 402                    && $err eq {can not find channel named "1"}
 403                        } {
 404                        # Older versions of Tcl 8.4 don't have this 2>@1 IO
 405                        # redirect operator.  Fallback to |& cat for those.
 406                        # The command was not actually started, so its safe
 407                        # to try to start it a second time.
 408                        #
 409                        set fd [open [concat \
 410                                [lrange $cmd 0 end-1] \
 411                                [list |& cat] \
 412                                ] r]
 413                } else {
 414                        error $err
 415                }
 416        }
 417        return $fd
 418}
 419
 420proc git_read {args} {
 421        set opt [list |]
 422
 423        while {1} {
 424                switch -- [lindex $args 0] {
 425                --nice {
 426                        global _nice
 427                        if {$_nice ne {}} {
 428                                lappend opt $_nice
 429                        }
 430                }
 431
 432                --stderr {
 433                        lappend args 2>@1
 434                }
 435
 436                default {
 437                        break
 438                }
 439
 440                }
 441
 442                set args [lrange $args 1 end]
 443        }
 444
 445        set cmdp [_git_cmd [lindex $args 0]]
 446        set args [lrange $args 1 end]
 447
 448        return [_open_stdout_stderr [concat $opt $cmdp $args]]
 449}
 450
 451proc git_write {args} {
 452        set opt [list |]
 453
 454        while {1} {
 455                switch -- [lindex $args 0] {
 456                --nice {
 457                        global _nice
 458                        if {$_nice ne {}} {
 459                                lappend opt $_nice
 460                        }
 461                }
 462
 463                default {
 464                        break
 465                }
 466
 467                }
 468
 469                set args [lrange $args 1 end]
 470        }
 471
 472        set cmdp [_git_cmd [lindex $args 0]]
 473        set args [lrange $args 1 end]
 474
 475        return [open [concat $opt $cmdp $args] w]
 476}
 477
 478proc sq {value} {
 479        regsub -all ' $value "'\\''" value
 480        return "'$value'"
 481}
 482
 483proc load_current_branch {} {
 484        global current_branch is_detached
 485
 486        set fd [open [gitdir HEAD] r]
 487        if {[gets $fd ref] < 1} {
 488                set ref {}
 489        }
 490        close $fd
 491
 492        set pfx {ref: refs/heads/}
 493        set len [string length $pfx]
 494        if {[string equal -length $len $pfx $ref]} {
 495                # We're on a branch.  It might not exist.  But
 496                # HEAD looks good enough to be a branch.
 497                #
 498                set current_branch [string range $ref $len end]
 499                set is_detached 0
 500        } else {
 501                # Assume this is a detached head.
 502                #
 503                set current_branch HEAD
 504                set is_detached 1
 505        }
 506}
 507
 508auto_load tk_optionMenu
 509rename tk_optionMenu real__tkOptionMenu
 510proc tk_optionMenu {w varName args} {
 511        set m [eval real__tkOptionMenu $w $varName $args]
 512        $m configure -font font_ui
 513        $w configure -font font_ui
 514        return $m
 515}
 516
 517######################################################################
 518##
 519## find git
 520
 521set _git  [_which git]
 522if {$_git eq {}} {
 523        catch {wm withdraw .}
 524        error_popup "Cannot find git in PATH."
 525        exit 1
 526}
 527set _nice [_which nice]
 528
 529######################################################################
 530##
 531## version check
 532
 533if {[catch {set _git_version [git --version]} err]} {
 534        catch {wm withdraw .}
 535        error_popup "Cannot determine Git version:
 536
 537$err
 538
 539[appname] requires Git 1.5.0 or later."
 540        exit 1
 541}
 542if {![regsub {^git version } $_git_version {} _git_version]} {
 543        catch {wm withdraw .}
 544        error_popup "Cannot parse Git version string:\n\n$_git_version"
 545        exit 1
 546}
 547regsub {-dirty$} $_git_version {} _git_version
 548regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 549regsub {\.rc[0-9]+$} $_git_version {} _git_version
 550
 551proc git-version {args} {
 552        global _git_version
 553
 554        switch [llength $args] {
 555        0 {
 556                return $_git_version
 557        }
 558
 559        2 {
 560                set op [lindex $args 0]
 561                set vr [lindex $args 1]
 562                set cm [package vcompare $_git_version $vr]
 563                return [expr $cm $op 0]
 564        }
 565
 566        4 {
 567                set type [lindex $args 0]
 568                set name [lindex $args 1]
 569                set parm [lindex $args 2]
 570                set body [lindex $args 3]
 571
 572                if {($type ne {proc} && $type ne {method})} {
 573                        error "Invalid arguments to git-version"
 574                }
 575                if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 576                        error "Last arm of $type $name must be default"
 577                }
 578
 579                foreach {op vr cb} [lrange $body 0 end-2] {
 580                        if {[git-version $op $vr]} {
 581                                return [uplevel [list $type $name $parm $cb]]
 582                        }
 583                }
 584
 585                return [uplevel [list $type $name $parm [lindex $body end]]]
 586        }
 587
 588        default {
 589                error "git-version >= x"
 590        }
 591
 592        }
 593}
 594
 595if {[git-version < 1.5]} {
 596        catch {wm withdraw .}
 597        error_popup "[appname] requires Git 1.5.0 or later.
 598
 599You are using [git-version]:
 600
 601[git --version]"
 602        exit 1
 603}
 604
 605######################################################################
 606##
 607## repository setup
 608
 609if {[catch {
 610                set _gitdir $env(GIT_DIR)
 611                set _prefix {}
 612                }]
 613        && [catch {
 614                set _gitdir [git rev-parse --git-dir]
 615                set _prefix [git rev-parse --show-prefix]
 616        } err]} {
 617        catch {wm withdraw .}
 618        error_popup "Cannot find the git directory:\n\n$err"
 619        exit 1
 620}
 621if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 622        catch {set _gitdir [exec cygpath --unix $_gitdir]}
 623}
 624if {![file isdirectory $_gitdir]} {
 625        catch {wm withdraw .}
 626        error_popup "Git directory not found:\n\n$_gitdir"
 627        exit 1
 628}
 629if {[lindex [file split $_gitdir] end] ne {.git}} {
 630        catch {wm withdraw .}
 631        error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 632        exit 1
 633}
 634if {[catch {cd [file dirname $_gitdir]} err]} {
 635        catch {wm withdraw .}
 636        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 637        exit 1
 638}
 639set _reponame [lindex [file split \
 640        [file normalize [file dirname $_gitdir]]] \
 641        end]
 642
 643######################################################################
 644##
 645## global init
 646
 647set current_diff_path {}
 648set current_diff_side {}
 649set diff_actions [list]
 650
 651set HEAD {}
 652set PARENT {}
 653set MERGE_HEAD [list]
 654set commit_type {}
 655set empty_tree {}
 656set current_branch {}
 657set is_detached 0
 658set current_diff_path {}
 659set selected_commit_type new
 660
 661######################################################################
 662##
 663## task management
 664
 665set rescan_active 0
 666set diff_active 0
 667set last_clicked {}
 668
 669set disable_on_lock [list]
 670set index_lock_type none
 671
 672proc lock_index {type} {
 673        global index_lock_type disable_on_lock
 674
 675        if {$index_lock_type eq {none}} {
 676                set index_lock_type $type
 677                foreach w $disable_on_lock {
 678                        uplevel #0 $w disabled
 679                }
 680                return 1
 681        } elseif {$index_lock_type eq "begin-$type"} {
 682                set index_lock_type $type
 683                return 1
 684        }
 685        return 0
 686}
 687
 688proc unlock_index {} {
 689        global index_lock_type disable_on_lock
 690
 691        set index_lock_type none
 692        foreach w $disable_on_lock {
 693                uplevel #0 $w normal
 694        }
 695}
 696
 697######################################################################
 698##
 699## status
 700
 701proc repository_state {ctvar hdvar mhvar} {
 702        global current_branch
 703        upvar $ctvar ct $hdvar hd $mhvar mh
 704
 705        set mh [list]
 706
 707        load_current_branch
 708        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 709                set hd {}
 710                set ct initial
 711                return
 712        }
 713
 714        set merge_head [gitdir MERGE_HEAD]
 715        if {[file exists $merge_head]} {
 716                set ct merge
 717                set fd_mh [open $merge_head r]
 718                while {[gets $fd_mh line] >= 0} {
 719                        lappend mh $line
 720                }
 721                close $fd_mh
 722                return
 723        }
 724
 725        set ct normal
 726}
 727
 728proc PARENT {} {
 729        global PARENT empty_tree
 730
 731        set p [lindex $PARENT 0]
 732        if {$p ne {}} {
 733                return $p
 734        }
 735        if {$empty_tree eq {}} {
 736                set empty_tree [git mktree << {}]
 737        }
 738        return $empty_tree
 739}
 740
 741proc rescan {after {honor_trustmtime 1}} {
 742        global HEAD PARENT MERGE_HEAD commit_type
 743        global ui_index ui_workdir ui_comm
 744        global rescan_active file_states
 745        global repo_config
 746
 747        if {$rescan_active > 0 || ![lock_index read]} return
 748
 749        repository_state newType newHEAD newMERGE_HEAD
 750        if {[string match amend* $commit_type]
 751                && $newType eq {normal}
 752                && $newHEAD eq $HEAD} {
 753        } else {
 754                set HEAD $newHEAD
 755                set PARENT $newHEAD
 756                set MERGE_HEAD $newMERGE_HEAD
 757                set commit_type $newType
 758        }
 759
 760        array unset file_states
 761
 762        if {![$ui_comm edit modified]
 763                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 764                if {[string match amend* $commit_type]} {
 765                } elseif {[load_message GITGUI_MSG]} {
 766                } elseif {[load_message MERGE_MSG]} {
 767                } elseif {[load_message SQUASH_MSG]} {
 768                }
 769                $ui_comm edit reset
 770                $ui_comm edit modified false
 771        }
 772
 773        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 774                rescan_stage2 {} $after
 775        } else {
 776                set rescan_active 1
 777                ui_status {Refreshing file status...}
 778                set fd_rf [git_read update-index \
 779                        -q \
 780                        --unmerged \
 781                        --ignore-missing \
 782                        --refresh \
 783                        ]
 784                fconfigure $fd_rf -blocking 0 -translation binary
 785                fileevent $fd_rf readable \
 786                        [list rescan_stage2 $fd_rf $after]
 787        }
 788}
 789
 790proc rescan_stage2 {fd after} {
 791        global rescan_active buf_rdi buf_rdf buf_rlo
 792
 793        if {$fd ne {}} {
 794                read $fd
 795                if {![eof $fd]} return
 796                close $fd
 797        }
 798
 799        set ls_others [list --exclude-per-directory=.gitignore]
 800        set info_exclude [gitdir info exclude]
 801        if {[file readable $info_exclude]} {
 802                lappend ls_others "--exclude-from=$info_exclude"
 803        }
 804
 805        set buf_rdi {}
 806        set buf_rdf {}
 807        set buf_rlo {}
 808
 809        set rescan_active 3
 810        ui_status {Scanning for modified files ...}
 811        set fd_di [git_read diff-index --cached -z [PARENT]]
 812        set fd_df [git_read diff-files -z]
 813        set fd_lo [eval git_read ls-files --others -z $ls_others]
 814
 815        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 816        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 817        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 818        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 819        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 820        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 821}
 822
 823proc load_message {file} {
 824        global ui_comm
 825
 826        set f [gitdir $file]
 827        if {[file isfile $f]} {
 828                if {[catch {set fd [open $f r]}]} {
 829                        return 0
 830                }
 831                set content [string trim [read $fd]]
 832                close $fd
 833                regsub -all -line {[ \r\t]+$} $content {} content
 834                $ui_comm delete 0.0 end
 835                $ui_comm insert end $content
 836                return 1
 837        }
 838        return 0
 839}
 840
 841proc read_diff_index {fd after} {
 842        global buf_rdi
 843
 844        append buf_rdi [read $fd]
 845        set c 0
 846        set n [string length $buf_rdi]
 847        while {$c < $n} {
 848                set z1 [string first "\0" $buf_rdi $c]
 849                if {$z1 == -1} break
 850                incr z1
 851                set z2 [string first "\0" $buf_rdi $z1]
 852                if {$z2 == -1} break
 853
 854                incr c
 855                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 856                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 857                merge_state \
 858                        [encoding convertfrom $p] \
 859                        [lindex $i 4]? \
 860                        [list [lindex $i 0] [lindex $i 2]] \
 861                        [list]
 862                set c $z2
 863                incr c
 864        }
 865        if {$c < $n} {
 866                set buf_rdi [string range $buf_rdi $c end]
 867        } else {
 868                set buf_rdi {}
 869        }
 870
 871        rescan_done $fd buf_rdi $after
 872}
 873
 874proc read_diff_files {fd after} {
 875        global buf_rdf
 876
 877        append buf_rdf [read $fd]
 878        set c 0
 879        set n [string length $buf_rdf]
 880        while {$c < $n} {
 881                set z1 [string first "\0" $buf_rdf $c]
 882                if {$z1 == -1} break
 883                incr z1
 884                set z2 [string first "\0" $buf_rdf $z1]
 885                if {$z2 == -1} break
 886
 887                incr c
 888                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 889                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 890                merge_state \
 891                        [encoding convertfrom $p] \
 892                        ?[lindex $i 4] \
 893                        [list] \
 894                        [list [lindex $i 0] [lindex $i 2]]
 895                set c $z2
 896                incr c
 897        }
 898        if {$c < $n} {
 899                set buf_rdf [string range $buf_rdf $c end]
 900        } else {
 901                set buf_rdf {}
 902        }
 903
 904        rescan_done $fd buf_rdf $after
 905}
 906
 907proc read_ls_others {fd after} {
 908        global buf_rlo
 909
 910        append buf_rlo [read $fd]
 911        set pck [split $buf_rlo "\0"]
 912        set buf_rlo [lindex $pck end]
 913        foreach p [lrange $pck 0 end-1] {
 914                merge_state [encoding convertfrom $p] ?O
 915        }
 916        rescan_done $fd buf_rlo $after
 917}
 918
 919proc rescan_done {fd buf after} {
 920        global rescan_active current_diff_path
 921        global file_states repo_config
 922        upvar $buf to_clear
 923
 924        if {![eof $fd]} return
 925        set to_clear {}
 926        close $fd
 927        if {[incr rescan_active -1] > 0} return
 928
 929        prune_selection
 930        unlock_index
 931        display_all_files
 932        if {$current_diff_path ne {}} reshow_diff
 933        uplevel #0 $after
 934}
 935
 936proc prune_selection {} {
 937        global file_states selected_paths
 938
 939        foreach path [array names selected_paths] {
 940                if {[catch {set still_here $file_states($path)}]} {
 941                        unset selected_paths($path)
 942                }
 943        }
 944}
 945
 946######################################################################
 947##
 948## ui helpers
 949
 950proc mapicon {w state path} {
 951        global all_icons
 952
 953        if {[catch {set r $all_icons($state$w)}]} {
 954                puts "error: no icon for $w state={$state} $path"
 955                return file_plain
 956        }
 957        return $r
 958}
 959
 960proc mapdesc {state path} {
 961        global all_descs
 962
 963        if {[catch {set r $all_descs($state)}]} {
 964                puts "error: no desc for state={$state} $path"
 965                return $state
 966        }
 967        return $r
 968}
 969
 970proc ui_status {msg} {
 971        $::main_status show $msg
 972}
 973
 974proc ui_ready {{test {}}} {
 975        $::main_status show {Ready.} $test
 976}
 977
 978proc escape_path {path} {
 979        regsub -all {\\} $path "\\\\" path
 980        regsub -all "\n" $path "\\n" path
 981        return $path
 982}
 983
 984proc short_path {path} {
 985        return [escape_path [lindex [file split $path] end]]
 986}
 987
 988set next_icon_id 0
 989set null_sha1 [string repeat 0 40]
 990
 991proc merge_state {path new_state {head_info {}} {index_info {}}} {
 992        global file_states next_icon_id null_sha1
 993
 994        set s0 [string index $new_state 0]
 995        set s1 [string index $new_state 1]
 996
 997        if {[catch {set info $file_states($path)}]} {
 998                set state __
 999                set icon n[incr next_icon_id]
1000        } else {
1001                set state [lindex $info 0]
1002                set icon [lindex $info 1]
1003                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1004                if {$index_info eq {}} {set index_info [lindex $info 3]}
1005        }
1006
1007        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1008        elseif {$s0 eq {_}} {set s0 _}
1009
1010        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1011        elseif {$s1 eq {_}} {set s1 _}
1012
1013        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1014                set head_info [list 0 $null_sha1]
1015        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1016                && $head_info eq {}} {
1017                set head_info $index_info
1018        }
1019
1020        set file_states($path) [list $s0$s1 $icon \
1021                $head_info $index_info \
1022                ]
1023        return $state
1024}
1025
1026proc display_file_helper {w path icon_name old_m new_m} {
1027        global file_lists
1028
1029        if {$new_m eq {_}} {
1030                set lno [lsearch -sorted -exact $file_lists($w) $path]
1031                if {$lno >= 0} {
1032                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1033                        incr lno
1034                        $w conf -state normal
1035                        $w delete $lno.0 [expr {$lno + 1}].0
1036                        $w conf -state disabled
1037                }
1038        } elseif {$old_m eq {_} && $new_m ne {_}} {
1039                lappend file_lists($w) $path
1040                set file_lists($w) [lsort -unique $file_lists($w)]
1041                set lno [lsearch -sorted -exact $file_lists($w) $path]
1042                incr lno
1043                $w conf -state normal
1044                $w image create $lno.0 \
1045                        -align center -padx 5 -pady 1 \
1046                        -name $icon_name \
1047                        -image [mapicon $w $new_m $path]
1048                $w insert $lno.1 "[escape_path $path]\n"
1049                $w conf -state disabled
1050        } elseif {$old_m ne $new_m} {
1051                $w conf -state normal
1052                $w image conf $icon_name -image [mapicon $w $new_m $path]
1053                $w conf -state disabled
1054        }
1055}
1056
1057proc display_file {path state} {
1058        global file_states selected_paths
1059        global ui_index ui_workdir
1060
1061        set old_m [merge_state $path $state]
1062        set s $file_states($path)
1063        set new_m [lindex $s 0]
1064        set icon_name [lindex $s 1]
1065
1066        set o [string index $old_m 0]
1067        set n [string index $new_m 0]
1068        if {$o eq {U}} {
1069                set o _
1070        }
1071        if {$n eq {U}} {
1072                set n _
1073        }
1074        display_file_helper     $ui_index $path $icon_name $o $n
1075
1076        if {[string index $old_m 0] eq {U}} {
1077                set o U
1078        } else {
1079                set o [string index $old_m 1]
1080        }
1081        if {[string index $new_m 0] eq {U}} {
1082                set n U
1083        } else {
1084                set n [string index $new_m 1]
1085        }
1086        display_file_helper     $ui_workdir $path $icon_name $o $n
1087
1088        if {$new_m eq {__}} {
1089                unset file_states($path)
1090                catch {unset selected_paths($path)}
1091        }
1092}
1093
1094proc display_all_files_helper {w path icon_name m} {
1095        global file_lists
1096
1097        lappend file_lists($w) $path
1098        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1099        $w image create end \
1100                -align center -padx 5 -pady 1 \
1101                -name $icon_name \
1102                -image [mapicon $w $m $path]
1103        $w insert end "[escape_path $path]\n"
1104}
1105
1106proc display_all_files {} {
1107        global ui_index ui_workdir
1108        global file_states file_lists
1109        global last_clicked
1110
1111        $ui_index conf -state normal
1112        $ui_workdir conf -state normal
1113
1114        $ui_index delete 0.0 end
1115        $ui_workdir delete 0.0 end
1116        set last_clicked {}
1117
1118        set file_lists($ui_index) [list]
1119        set file_lists($ui_workdir) [list]
1120
1121        foreach path [lsort [array names file_states]] {
1122                set s $file_states($path)
1123                set m [lindex $s 0]
1124                set icon_name [lindex $s 1]
1125
1126                set s [string index $m 0]
1127                if {$s ne {U} && $s ne {_}} {
1128                        display_all_files_helper $ui_index $path \
1129                                $icon_name $s
1130                }
1131
1132                if {[string index $m 0] eq {U}} {
1133                        set s U
1134                } else {
1135                        set s [string index $m 1]
1136                }
1137                if {$s ne {_}} {
1138                        display_all_files_helper $ui_workdir $path \
1139                                $icon_name $s
1140                }
1141        }
1142
1143        $ui_index conf -state disabled
1144        $ui_workdir conf -state disabled
1145}
1146
1147######################################################################
1148##
1149## icons
1150
1151set filemask {
1152#define mask_width 14
1153#define mask_height 15
1154static unsigned char mask_bits[] = {
1155   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1156   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1157   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1158}
1159
1160image create bitmap file_plain -background white -foreground black -data {
1161#define plain_width 14
1162#define plain_height 15
1163static unsigned char plain_bits[] = {
1164   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1165   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1166   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1167} -maskdata $filemask
1168
1169image create bitmap file_mod -background white -foreground blue -data {
1170#define mod_width 14
1171#define mod_height 15
1172static unsigned char mod_bits[] = {
1173   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1174   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1175   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1176} -maskdata $filemask
1177
1178image create bitmap file_fulltick -background white -foreground "#007000" -data {
1179#define file_fulltick_width 14
1180#define file_fulltick_height 15
1181static unsigned char file_fulltick_bits[] = {
1182   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1183   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1184   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1185} -maskdata $filemask
1186
1187image create bitmap file_parttick -background white -foreground "#005050" -data {
1188#define parttick_width 14
1189#define parttick_height 15
1190static unsigned char parttick_bits[] = {
1191   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1192   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1193   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1194} -maskdata $filemask
1195
1196image create bitmap file_question -background white -foreground black -data {
1197#define file_question_width 14
1198#define file_question_height 15
1199static unsigned char file_question_bits[] = {
1200   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1201   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1202   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1203} -maskdata $filemask
1204
1205image create bitmap file_removed -background white -foreground red -data {
1206#define file_removed_width 14
1207#define file_removed_height 15
1208static unsigned char file_removed_bits[] = {
1209   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1210   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1211   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1212} -maskdata $filemask
1213
1214image create bitmap file_merge -background white -foreground blue -data {
1215#define file_merge_width 14
1216#define file_merge_height 15
1217static unsigned char file_merge_bits[] = {
1218   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1219   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1220   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1221} -maskdata $filemask
1222
1223set file_dir_data {
1224#define file_width 18
1225#define file_height 18
1226static unsigned char file_bits[] = {
1227  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1228  0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1229  0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1230  0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1231  0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1232}
1233image create bitmap file_dir -background white -foreground blue \
1234        -data $file_dir_data -maskdata $file_dir_data
1235unset file_dir_data
1236
1237set file_uplevel_data {
1238#define up_width 15
1239#define up_height 15
1240static unsigned char up_bits[] = {
1241  0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1242  0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1243  0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1244}
1245image create bitmap file_uplevel -background white -foreground red \
1246        -data $file_uplevel_data -maskdata $file_uplevel_data
1247unset file_uplevel_data
1248
1249set ui_index .vpane.files.index.list
1250set ui_workdir .vpane.files.workdir.list
1251
1252set all_icons(_$ui_index)   file_plain
1253set all_icons(A$ui_index)   file_fulltick
1254set all_icons(M$ui_index)   file_fulltick
1255set all_icons(D$ui_index)   file_removed
1256set all_icons(U$ui_index)   file_merge
1257
1258set all_icons(_$ui_workdir) file_plain
1259set all_icons(M$ui_workdir) file_mod
1260set all_icons(D$ui_workdir) file_question
1261set all_icons(U$ui_workdir) file_merge
1262set all_icons(O$ui_workdir) file_plain
1263
1264set max_status_desc 0
1265foreach i {
1266                {__ "Unmodified"}
1267
1268                {_M "Modified, not staged"}
1269                {M_ "Staged for commit"}
1270                {MM "Portions staged for commit"}
1271                {MD "Staged for commit, missing"}
1272
1273                {_O "Untracked, not staged"}
1274                {A_ "Staged for commit"}
1275                {AM "Portions staged for commit"}
1276                {AD "Staged for commit, missing"}
1277
1278                {_D "Missing"}
1279                {D_ "Staged for removal"}
1280                {DO "Staged for removal, still present"}
1281
1282                {U_ "Requires merge resolution"}
1283                {UU "Requires merge resolution"}
1284                {UM "Requires merge resolution"}
1285                {UD "Requires merge resolution"}
1286        } {
1287        if {$max_status_desc < [string length [lindex $i 1]]} {
1288                set max_status_desc [string length [lindex $i 1]]
1289        }
1290        set all_descs([lindex $i 0]) [lindex $i 1]
1291}
1292unset i
1293
1294######################################################################
1295##
1296## util
1297
1298proc bind_button3 {w cmd} {
1299        bind $w <Any-Button-3> $cmd
1300        if {[is_MacOSX]} {
1301                bind $w <Control-Button-1> $cmd
1302        }
1303}
1304
1305proc scrollbar2many {list mode args} {
1306        foreach w $list {eval $w $mode $args}
1307}
1308
1309proc many2scrollbar {list mode sb top bottom} {
1310        $sb set $top $bottom
1311        foreach w $list {$w $mode moveto $top}
1312}
1313
1314proc incr_font_size {font {amt 1}} {
1315        set sz [font configure $font -size]
1316        incr sz $amt
1317        font configure $font -size $sz
1318        font configure ${font}bold -size $sz
1319        font configure ${font}italic -size $sz
1320}
1321
1322######################################################################
1323##
1324## ui commands
1325
1326set starting_gitk_msg {Starting gitk... please wait...}
1327
1328proc do_gitk {revs} {
1329        # -- Always start gitk through whatever we were loaded with.  This
1330        #    lets us bypass using shell process on Windows systems.
1331        #
1332        set exe [file join [file dirname $::_git] gitk]
1333        set cmd [list [info nameofexecutable] $exe]
1334        if {! [file exists $exe]} {
1335                error_popup "Unable to start gitk:\n\n$exe does not exist"
1336        } else {
1337                eval exec $cmd $revs &
1338                ui_status $::starting_gitk_msg
1339                after 10000 {
1340                        ui_ready $starting_gitk_msg
1341                }
1342        }
1343}
1344
1345set is_quitting 0
1346
1347proc do_quit {} {
1348        global ui_comm is_quitting repo_config commit_type
1349
1350        if {$is_quitting} return
1351        set is_quitting 1
1352
1353        if {[winfo exists $ui_comm]} {
1354                # -- Stash our current commit buffer.
1355                #
1356                set save [gitdir GITGUI_MSG]
1357                set msg [string trim [$ui_comm get 0.0 end]]
1358                regsub -all -line {[ \r\t]+$} $msg {} msg
1359                if {(![string match amend* $commit_type]
1360                        || [$ui_comm edit modified])
1361                        && $msg ne {}} {
1362                        catch {
1363                                set fd [open $save w]
1364                                puts -nonewline $fd $msg
1365                                close $fd
1366                        }
1367                } else {
1368                        catch {file delete $save}
1369                }
1370
1371                # -- Stash our current window geometry into this repository.
1372                #
1373                set cfg_geometry [list]
1374                lappend cfg_geometry [wm geometry .]
1375                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1376                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1377                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1378                        set rc_geometry {}
1379                }
1380                if {$cfg_geometry ne $rc_geometry} {
1381                        catch {git config gui.geometry $cfg_geometry}
1382                }
1383        }
1384
1385        destroy .
1386}
1387
1388proc do_rescan {} {
1389        rescan ui_ready
1390}
1391
1392proc do_commit {} {
1393        commit_tree
1394}
1395
1396proc toggle_or_diff {w x y} {
1397        global file_states file_lists current_diff_path ui_index ui_workdir
1398        global last_clicked selected_paths
1399
1400        set pos [split [$w index @$x,$y] .]
1401        set lno [lindex $pos 0]
1402        set col [lindex $pos 1]
1403        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1404        if {$path eq {}} {
1405                set last_clicked {}
1406                return
1407        }
1408
1409        set last_clicked [list $w $lno]
1410        array unset selected_paths
1411        $ui_index tag remove in_sel 0.0 end
1412        $ui_workdir tag remove in_sel 0.0 end
1413
1414        if {$col == 0} {
1415                if {$current_diff_path eq $path} {
1416                        set after {reshow_diff;}
1417                } else {
1418                        set after {}
1419                }
1420                if {$w eq $ui_index} {
1421                        update_indexinfo \
1422                                "Unstaging [short_path $path] from commit" \
1423                                [list $path] \
1424                                [concat $after [list ui_ready]]
1425                } elseif {$w eq $ui_workdir} {
1426                        update_index \
1427                                "Adding [short_path $path]" \
1428                                [list $path] \
1429                                [concat $after [list ui_ready]]
1430                }
1431        } else {
1432                show_diff $path $w $lno
1433        }
1434}
1435
1436proc add_one_to_selection {w x y} {
1437        global file_lists last_clicked selected_paths
1438
1439        set lno [lindex [split [$w index @$x,$y] .] 0]
1440        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1441        if {$path eq {}} {
1442                set last_clicked {}
1443                return
1444        }
1445
1446        if {$last_clicked ne {}
1447                && [lindex $last_clicked 0] ne $w} {
1448                array unset selected_paths
1449                [lindex $last_clicked 0] tag remove in_sel 0.0 end
1450        }
1451
1452        set last_clicked [list $w $lno]
1453        if {[catch {set in_sel $selected_paths($path)}]} {
1454                set in_sel 0
1455        }
1456        if {$in_sel} {
1457                unset selected_paths($path)
1458                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1459        } else {
1460                set selected_paths($path) 1
1461                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1462        }
1463}
1464
1465proc add_range_to_selection {w x y} {
1466        global file_lists last_clicked selected_paths
1467
1468        if {[lindex $last_clicked 0] ne $w} {
1469                toggle_or_diff $w $x $y
1470                return
1471        }
1472
1473        set lno [lindex [split [$w index @$x,$y] .] 0]
1474        set lc [lindex $last_clicked 1]
1475        if {$lc < $lno} {
1476                set begin $lc
1477                set end $lno
1478        } else {
1479                set begin $lno
1480                set end $lc
1481        }
1482
1483        foreach path [lrange $file_lists($w) \
1484                [expr {$begin - 1}] \
1485                [expr {$end - 1}]] {
1486                set selected_paths($path) 1
1487        }
1488        $w tag add in_sel $begin.0 [expr {$end + 1}].0
1489}
1490
1491######################################################################
1492##
1493## config defaults
1494
1495set cursor_ptr arrow
1496font create font_diff -family Courier -size 10
1497font create font_ui
1498catch {
1499        label .dummy
1500        eval font configure font_ui [font actual [.dummy cget -font]]
1501        destroy .dummy
1502}
1503
1504font create font_uiitalic
1505font create font_uibold
1506font create font_diffbold
1507font create font_diffitalic
1508
1509foreach class {Button Checkbutton Entry Label
1510                Labelframe Listbox Menu Message
1511                Radiobutton Spinbox Text} {
1512        option add *$class.font font_ui
1513}
1514unset class
1515
1516if {[is_Windows] || [is_MacOSX]} {
1517        option add *Menu.tearOff 0
1518}
1519
1520if {[is_MacOSX]} {
1521        set M1B M1
1522        set M1T Cmd
1523} else {
1524        set M1B Control
1525        set M1T Ctrl
1526}
1527
1528proc apply_config {} {
1529        global repo_config font_descs
1530
1531        foreach option $font_descs {
1532                set name [lindex $option 0]
1533                set font [lindex $option 1]
1534                if {[catch {
1535                        foreach {cn cv} $repo_config(gui.$name) {
1536                                font configure $font $cn $cv
1537                        }
1538                        } err]} {
1539                        error_popup "Invalid font specified in gui.$name:\n\n$err"
1540                }
1541                foreach {cn cv} [font configure $font] {
1542                        font configure ${font}bold $cn $cv
1543                        font configure ${font}italic $cn $cv
1544                }
1545                font configure ${font}bold -weight bold
1546                font configure ${font}italic -slant italic
1547        }
1548}
1549
1550set default_config(merge.diffstat) true
1551set default_config(merge.summary) false
1552set default_config(merge.verbosity) 2
1553set default_config(user.name) {}
1554set default_config(user.email) {}
1555
1556set default_config(gui.matchtrackingbranch) false
1557set default_config(gui.pruneduringfetch) false
1558set default_config(gui.trustmtime) false
1559set default_config(gui.diffcontext) 5
1560set default_config(gui.newbranchtemplate) {}
1561set default_config(gui.fontui) [font configure font_ui]
1562set default_config(gui.fontdiff) [font configure font_diff]
1563set font_descs {
1564        {fontui   font_ui   {Main Font}}
1565        {fontdiff font_diff {Diff/Console Font}}
1566}
1567load_config 0
1568apply_config
1569
1570######################################################################
1571##
1572## feature option selection
1573
1574if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1575        unset _junk
1576} else {
1577        set subcommand gui
1578}
1579if {$subcommand eq {gui.sh}} {
1580        set subcommand gui
1581}
1582if {$subcommand eq {gui} && [llength $argv] > 0} {
1583        set subcommand [lindex $argv 0]
1584        set argv [lrange $argv 1 end]
1585}
1586
1587enable_option multicommit
1588enable_option branch
1589enable_option transport
1590
1591switch -- $subcommand {
1592browser -
1593blame {
1594        disable_option multicommit
1595        disable_option branch
1596        disable_option transport
1597}
1598citool {
1599        enable_option singlecommit
1600
1601        disable_option multicommit
1602        disable_option branch
1603        disable_option transport
1604}
1605}
1606
1607######################################################################
1608##
1609## ui construction
1610
1611set ui_comm {}
1612
1613# -- Menu Bar
1614#
1615menu .mbar -tearoff 0
1616.mbar add cascade -label Repository -menu .mbar.repository
1617.mbar add cascade -label Edit -menu .mbar.edit
1618if {[is_enabled branch]} {
1619        .mbar add cascade -label Branch -menu .mbar.branch
1620}
1621if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1622        .mbar add cascade -label Commit -menu .mbar.commit
1623}
1624if {[is_enabled transport]} {
1625        .mbar add cascade -label Merge -menu .mbar.merge
1626        .mbar add cascade -label Fetch -menu .mbar.fetch
1627        .mbar add cascade -label Push -menu .mbar.push
1628}
1629. configure -menu .mbar
1630
1631# -- Repository Menu
1632#
1633menu .mbar.repository
1634
1635.mbar.repository add command \
1636        -label {Browse Current Branch} \
1637        -command {browser::new $current_branch}
1638trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1639.mbar.repository add separator
1640
1641.mbar.repository add command \
1642        -label {Visualize Current Branch} \
1643        -command {do_gitk $current_branch}
1644trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1645.mbar.repository add command \
1646        -label {Visualize All Branches} \
1647        -command {do_gitk --all}
1648.mbar.repository add separator
1649
1650if {[is_enabled multicommit]} {
1651        .mbar.repository add command -label {Database Statistics} \
1652                -command do_stats
1653
1654        .mbar.repository add command -label {Compress Database} \
1655                -command do_gc
1656
1657        .mbar.repository add command -label {Verify Database} \
1658                -command do_fsck_objects
1659
1660        .mbar.repository add separator
1661
1662        if {[is_Cygwin]} {
1663                .mbar.repository add command \
1664                        -label {Create Desktop Icon} \
1665                        -command do_cygwin_shortcut
1666        } elseif {[is_Windows]} {
1667                .mbar.repository add command \
1668                        -label {Create Desktop Icon} \
1669                        -command do_windows_shortcut
1670        } elseif {[is_MacOSX]} {
1671                .mbar.repository add command \
1672                        -label {Create Desktop Icon} \
1673                        -command do_macosx_app
1674        }
1675}
1676
1677.mbar.repository add command -label Quit \
1678        -command do_quit \
1679        -accelerator $M1T-Q
1680
1681# -- Edit Menu
1682#
1683menu .mbar.edit
1684.mbar.edit add command -label Undo \
1685        -command {catch {[focus] edit undo}} \
1686        -accelerator $M1T-Z
1687.mbar.edit add command -label Redo \
1688        -command {catch {[focus] edit redo}} \
1689        -accelerator $M1T-Y
1690.mbar.edit add separator
1691.mbar.edit add command -label Cut \
1692        -command {catch {tk_textCut [focus]}} \
1693        -accelerator $M1T-X
1694.mbar.edit add command -label Copy \
1695        -command {catch {tk_textCopy [focus]}} \
1696        -accelerator $M1T-C
1697.mbar.edit add command -label Paste \
1698        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1699        -accelerator $M1T-V
1700.mbar.edit add command -label Delete \
1701        -command {catch {[focus] delete sel.first sel.last}} \
1702        -accelerator Del
1703.mbar.edit add separator
1704.mbar.edit add command -label {Select All} \
1705        -command {catch {[focus] tag add sel 0.0 end}} \
1706        -accelerator $M1T-A
1707
1708# -- Branch Menu
1709#
1710if {[is_enabled branch]} {
1711        menu .mbar.branch
1712
1713        .mbar.branch add command -label {Create...} \
1714                -command branch_create::dialog \
1715                -accelerator $M1T-N
1716        lappend disable_on_lock [list .mbar.branch entryconf \
1717                [.mbar.branch index last] -state]
1718
1719        .mbar.branch add command -label {Checkout...} \
1720                -command branch_checkout::dialog \
1721                -accelerator $M1T-O
1722        lappend disable_on_lock [list .mbar.branch entryconf \
1723                [.mbar.branch index last] -state]
1724
1725        .mbar.branch add command -label {Rename...} \
1726                -command branch_rename::dialog
1727        lappend disable_on_lock [list .mbar.branch entryconf \
1728                [.mbar.branch index last] -state]
1729
1730        .mbar.branch add command -label {Delete...} \
1731                -command branch_delete::dialog
1732        lappend disable_on_lock [list .mbar.branch entryconf \
1733                [.mbar.branch index last] -state]
1734
1735        .mbar.branch add command -label {Reset...} \
1736                -command merge::reset_hard
1737        lappend disable_on_lock [list .mbar.branch entryconf \
1738                [.mbar.branch index last] -state]
1739}
1740
1741# -- Commit Menu
1742#
1743if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1744        menu .mbar.commit
1745
1746        .mbar.commit add radiobutton \
1747                -label {New Commit} \
1748                -command do_select_commit_type \
1749                -variable selected_commit_type \
1750                -value new
1751        lappend disable_on_lock \
1752                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1753
1754        .mbar.commit add radiobutton \
1755                -label {Amend Last Commit} \
1756                -command do_select_commit_type \
1757                -variable selected_commit_type \
1758                -value amend
1759        lappend disable_on_lock \
1760                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1761
1762        .mbar.commit add separator
1763
1764        .mbar.commit add command -label Rescan \
1765                -command do_rescan \
1766                -accelerator F5
1767        lappend disable_on_lock \
1768                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1769
1770        .mbar.commit add command -label {Add To Commit} \
1771                -command do_add_selection
1772        lappend disable_on_lock \
1773                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1774
1775        .mbar.commit add command -label {Add Existing To Commit} \
1776                -command do_add_all \
1777                -accelerator $M1T-I
1778        lappend disable_on_lock \
1779                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1780
1781        .mbar.commit add command -label {Unstage From Commit} \
1782                -command do_unstage_selection
1783        lappend disable_on_lock \
1784                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1785
1786        .mbar.commit add command -label {Revert Changes} \
1787                -command do_revert_selection
1788        lappend disable_on_lock \
1789                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1790
1791        .mbar.commit add separator
1792
1793        .mbar.commit add command -label {Sign Off} \
1794                -command do_signoff \
1795                -accelerator $M1T-S
1796
1797        .mbar.commit add command -label Commit \
1798                -command do_commit \
1799                -accelerator $M1T-Return
1800        lappend disable_on_lock \
1801                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1802}
1803
1804# -- Merge Menu
1805#
1806if {[is_enabled branch]} {
1807        menu .mbar.merge
1808        .mbar.merge add command -label {Local Merge...} \
1809                -command merge::dialog
1810        lappend disable_on_lock \
1811                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1812        .mbar.merge add command -label {Abort Merge...} \
1813                -command merge::reset_hard
1814        lappend disable_on_lock \
1815                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1816
1817}
1818
1819# -- Transport Menu
1820#
1821if {[is_enabled transport]} {
1822        menu .mbar.fetch
1823
1824        menu .mbar.push
1825        .mbar.push add command -label {Push...} \
1826                -command do_push_anywhere \
1827                -accelerator $M1T-P
1828        .mbar.push add command -label {Delete...} \
1829                -command remote_branch_delete::dialog
1830}
1831
1832if {[is_MacOSX]} {
1833        # -- Apple Menu (Mac OS X only)
1834        #
1835        .mbar add cascade -label Apple -menu .mbar.apple
1836        menu .mbar.apple
1837
1838        .mbar.apple add command -label "About [appname]" \
1839                -command do_about
1840        .mbar.apple add command -label "Options..." \
1841                -command do_options
1842} else {
1843        # -- Edit Menu
1844        #
1845        .mbar.edit add separator
1846        .mbar.edit add command -label {Options...} \
1847                -command do_options
1848
1849        # -- Tools Menu
1850        #
1851        if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1852        proc do_miga {} {
1853                if {![lock_index update]} return
1854                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1855                set miga_fd [open "|$cmd" r]
1856                fconfigure $miga_fd -blocking 0
1857                fileevent $miga_fd readable [list miga_done $miga_fd]
1858                ui_status {Running miga...}
1859        }
1860        proc miga_done {fd} {
1861                read $fd 512
1862                if {[eof $fd]} {
1863                        close $fd
1864                        unlock_index
1865                        rescan ui_ready
1866                }
1867        }
1868        .mbar add cascade -label Tools -menu .mbar.tools
1869        menu .mbar.tools
1870        .mbar.tools add command -label "Migrate" \
1871                -command do_miga
1872        lappend disable_on_lock \
1873                [list .mbar.tools entryconf [.mbar.tools index last] -state]
1874        }
1875}
1876
1877# -- Help Menu
1878#
1879.mbar add cascade -label Help -menu .mbar.help
1880menu .mbar.help
1881
1882if {![is_MacOSX]} {
1883        .mbar.help add command -label "About [appname]" \
1884                -command do_about
1885}
1886
1887set browser {}
1888catch {set browser $repo_config(instaweb.browser)}
1889set doc_path [file dirname [gitexec]]
1890set doc_path [file join $doc_path Documentation index.html]
1891
1892if {[is_Cygwin]} {
1893        set doc_path [exec cygpath --mixed $doc_path]
1894}
1895
1896if {$browser eq {}} {
1897        if {[is_MacOSX]} {
1898                set browser open
1899        } elseif {[is_Cygwin]} {
1900                set program_files [file dirname [exec cygpath --windir]]
1901                set program_files [file join $program_files {Program Files}]
1902                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1903                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1904                if {[file exists $firefox]} {
1905                        set browser $firefox
1906                } elseif {[file exists $ie]} {
1907                        set browser $ie
1908                }
1909                unset program_files firefox ie
1910        }
1911}
1912
1913if {[file isfile $doc_path]} {
1914        set doc_url "file:$doc_path"
1915} else {
1916        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1917}
1918
1919if {$browser ne {}} {
1920        .mbar.help add command -label {Online Documentation} \
1921                -command [list exec $browser $doc_url &]
1922}
1923unset browser doc_path doc_url
1924
1925# -- Standard bindings
1926#
1927wm protocol . WM_DELETE_WINDOW do_quit
1928bind all <$M1B-Key-q> do_quit
1929bind all <$M1B-Key-Q> do_quit
1930bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1931bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1932
1933set subcommand_args {}
1934proc usage {} {
1935        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1936        exit 1
1937}
1938
1939# -- Not a normal commit type invocation?  Do that instead!
1940#
1941switch -- $subcommand {
1942browser {
1943        set subcommand_args {rev?}
1944        switch [llength $argv] {
1945        0 { load_current_branch }
1946        1 {
1947                set current_branch [lindex $argv 0]
1948                if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1949                        if {[catch {
1950                                        set current_branch \
1951                                        [git rev-parse --verify $current_branch]
1952                                } err]} {
1953                                puts stderr $err
1954                                exit 1
1955                        }
1956                }
1957        }
1958        default usage
1959        }
1960        browser::new $current_branch
1961        return
1962}
1963blame {
1964        set subcommand_args {rev? path?}
1965        set head {}
1966        set path {}
1967        set is_path 0
1968        foreach a $argv {
1969                if {$is_path || [file exists $_prefix$a]} {
1970                        if {$path ne {}} usage
1971                        set path $_prefix$a
1972                        break
1973                } elseif {$a eq {--}} {
1974                        if {$path ne {}} {
1975                                if {$head ne {}} usage
1976                                set head $path
1977                                set path {}
1978                        }
1979                        set is_path 1
1980                } elseif {$head eq {}} {
1981                        if {$head ne {}} usage
1982                        set head $a
1983                } else {
1984                        usage
1985                }
1986        }
1987        unset is_path
1988
1989        if {$head eq {}} {
1990                load_current_branch
1991        } else {
1992                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
1993                        if {[catch {
1994                                        set head [git rev-parse --verify $head]
1995                                } err]} {
1996                                puts stderr $err
1997                                exit 1
1998                        }
1999                }
2000                set current_branch $head
2001        }
2002
2003        if {$path eq {}} usage
2004        blame::new $head $path
2005        return
2006}
2007citool -
2008gui {
2009        if {[llength $argv] != 0} {
2010                puts -nonewline stderr "usage: $argv0"
2011                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2012                        puts -nonewline stderr " $subcommand"
2013                }
2014                puts stderr {}
2015                exit 1
2016        }
2017        # fall through to setup UI for commits
2018}
2019default {
2020        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2021        exit 1
2022}
2023}
2024
2025# -- Branch Control
2026#
2027frame .branch \
2028        -borderwidth 1 \
2029        -relief sunken
2030label .branch.l1 \
2031        -text {Current Branch:} \
2032        -anchor w \
2033        -justify left
2034label .branch.cb \
2035        -textvariable current_branch \
2036        -anchor w \
2037        -justify left
2038pack .branch.l1 -side left
2039pack .branch.cb -side left -fill x
2040pack .branch -side top -fill x
2041
2042# -- Main Window Layout
2043#
2044panedwindow .vpane -orient vertical
2045panedwindow .vpane.files -orient horizontal
2046.vpane add .vpane.files -sticky nsew -height 100 -width 200
2047pack .vpane -anchor n -side top -fill both -expand 1
2048
2049# -- Index File List
2050#
2051frame .vpane.files.index -height 100 -width 200
2052label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2053        -background lightgreen
2054text $ui_index -background white -borderwidth 0 \
2055        -width 20 -height 10 \
2056        -wrap none \
2057        -cursor $cursor_ptr \
2058        -xscrollcommand {.vpane.files.index.sx set} \
2059        -yscrollcommand {.vpane.files.index.sy set} \
2060        -state disabled
2061scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2062scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2063pack .vpane.files.index.title -side top -fill x
2064pack .vpane.files.index.sx -side bottom -fill x
2065pack .vpane.files.index.sy -side right -fill y
2066pack $ui_index -side left -fill both -expand 1
2067.vpane.files add .vpane.files.index -sticky nsew
2068
2069# -- Working Directory File List
2070#
2071frame .vpane.files.workdir -height 100 -width 200
2072label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2073        -background lightsalmon
2074text $ui_workdir -background white -borderwidth 0 \
2075        -width 20 -height 10 \
2076        -wrap none \
2077        -cursor $cursor_ptr \
2078        -xscrollcommand {.vpane.files.workdir.sx set} \
2079        -yscrollcommand {.vpane.files.workdir.sy set} \
2080        -state disabled
2081scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2082scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2083pack .vpane.files.workdir.title -side top -fill x
2084pack .vpane.files.workdir.sx -side bottom -fill x
2085pack .vpane.files.workdir.sy -side right -fill y
2086pack $ui_workdir -side left -fill both -expand 1
2087.vpane.files add .vpane.files.workdir -sticky nsew
2088
2089foreach i [list $ui_index $ui_workdir] {
2090        $i tag conf in_diff -background lightgray
2091        $i tag conf in_sel  -background lightgray
2092}
2093unset i
2094
2095# -- Diff and Commit Area
2096#
2097frame .vpane.lower -height 300 -width 400
2098frame .vpane.lower.commarea
2099frame .vpane.lower.diff -relief sunken -borderwidth 1
2100pack .vpane.lower.commarea -side top -fill x
2101pack .vpane.lower.diff -side bottom -fill both -expand 1
2102.vpane add .vpane.lower -sticky nsew
2103
2104# -- Commit Area Buttons
2105#
2106frame .vpane.lower.commarea.buttons
2107label .vpane.lower.commarea.buttons.l -text {} \
2108        -anchor w \
2109        -justify left
2110pack .vpane.lower.commarea.buttons.l -side top -fill x
2111pack .vpane.lower.commarea.buttons -side left -fill y
2112
2113button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2114        -command do_rescan
2115pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2116lappend disable_on_lock \
2117        {.vpane.lower.commarea.buttons.rescan conf -state}
2118
2119button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2120        -command do_add_all
2121pack .vpane.lower.commarea.buttons.incall -side top -fill x
2122lappend disable_on_lock \
2123        {.vpane.lower.commarea.buttons.incall conf -state}
2124
2125button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2126        -command do_signoff
2127pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2128
2129button .vpane.lower.commarea.buttons.commit -text {Commit} \
2130        -command do_commit
2131pack .vpane.lower.commarea.buttons.commit -side top -fill x
2132lappend disable_on_lock \
2133        {.vpane.lower.commarea.buttons.commit conf -state}
2134
2135button .vpane.lower.commarea.buttons.push -text {Push} \
2136        -command do_push_anywhere
2137pack .vpane.lower.commarea.buttons.push -side top -fill x
2138
2139# -- Commit Message Buffer
2140#
2141frame .vpane.lower.commarea.buffer
2142frame .vpane.lower.commarea.buffer.header
2143set ui_comm .vpane.lower.commarea.buffer.t
2144set ui_coml .vpane.lower.commarea.buffer.header.l
2145radiobutton .vpane.lower.commarea.buffer.header.new \
2146        -text {New Commit} \
2147        -command do_select_commit_type \
2148        -variable selected_commit_type \
2149        -value new
2150lappend disable_on_lock \
2151        [list .vpane.lower.commarea.buffer.header.new conf -state]
2152radiobutton .vpane.lower.commarea.buffer.header.amend \
2153        -text {Amend Last Commit} \
2154        -command do_select_commit_type \
2155        -variable selected_commit_type \
2156        -value amend
2157lappend disable_on_lock \
2158        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2159label $ui_coml \
2160        -anchor w \
2161        -justify left
2162proc trace_commit_type {varname args} {
2163        global ui_coml commit_type
2164        switch -glob -- $commit_type {
2165        initial       {set txt {Initial Commit Message:}}
2166        amend         {set txt {Amended Commit Message:}}
2167        amend-initial {set txt {Amended Initial Commit Message:}}
2168        amend-merge   {set txt {Amended Merge Commit Message:}}
2169        merge         {set txt {Merge Commit Message:}}
2170        *             {set txt {Commit Message:}}
2171        }
2172        $ui_coml conf -text $txt
2173}
2174trace add variable commit_type write trace_commit_type
2175pack $ui_coml -side left -fill x
2176pack .vpane.lower.commarea.buffer.header.amend -side right
2177pack .vpane.lower.commarea.buffer.header.new -side right
2178
2179text $ui_comm -background white -borderwidth 1 \
2180        -undo true \
2181        -maxundo 20 \
2182        -autoseparators true \
2183        -relief sunken \
2184        -width 75 -height 9 -wrap none \
2185        -font font_diff \
2186        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2187scrollbar .vpane.lower.commarea.buffer.sby \
2188        -command [list $ui_comm yview]
2189pack .vpane.lower.commarea.buffer.header -side top -fill x
2190pack .vpane.lower.commarea.buffer.sby -side right -fill y
2191pack $ui_comm -side left -fill y
2192pack .vpane.lower.commarea.buffer -side left -fill y
2193
2194# -- Commit Message Buffer Context Menu
2195#
2196set ctxm .vpane.lower.commarea.buffer.ctxm
2197menu $ctxm -tearoff 0
2198$ctxm add command \
2199        -label {Cut} \
2200        -command {tk_textCut $ui_comm}
2201$ctxm add command \
2202        -label {Copy} \
2203        -command {tk_textCopy $ui_comm}
2204$ctxm add command \
2205        -label {Paste} \
2206        -command {tk_textPaste $ui_comm}
2207$ctxm add command \
2208        -label {Delete} \
2209        -command {$ui_comm delete sel.first sel.last}
2210$ctxm add separator
2211$ctxm add command \
2212        -label {Select All} \
2213        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2214$ctxm add command \
2215        -label {Copy All} \
2216        -command {
2217                $ui_comm tag add sel 0.0 end
2218                tk_textCopy $ui_comm
2219                $ui_comm tag remove sel 0.0 end
2220        }
2221$ctxm add separator
2222$ctxm add command \
2223        -label {Sign Off} \
2224        -command do_signoff
2225bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2226
2227# -- Diff Header
2228#
2229proc trace_current_diff_path {varname args} {
2230        global current_diff_path diff_actions file_states
2231        if {$current_diff_path eq {}} {
2232                set s {}
2233                set f {}
2234                set p {}
2235                set o disabled
2236        } else {
2237                set p $current_diff_path
2238                set s [mapdesc [lindex $file_states($p) 0] $p]
2239                set f {File:}
2240                set p [escape_path $p]
2241                set o normal
2242        }
2243
2244        .vpane.lower.diff.header.status configure -text $s
2245        .vpane.lower.diff.header.file configure -text $f
2246        .vpane.lower.diff.header.path configure -text $p
2247        foreach w $diff_actions {
2248                uplevel #0 $w $o
2249        }
2250}
2251trace add variable current_diff_path write trace_current_diff_path
2252
2253frame .vpane.lower.diff.header -background gold
2254label .vpane.lower.diff.header.status \
2255        -background gold \
2256        -width $max_status_desc \
2257        -anchor w \
2258        -justify left
2259label .vpane.lower.diff.header.file \
2260        -background gold \
2261        -anchor w \
2262        -justify left
2263label .vpane.lower.diff.header.path \
2264        -background gold \
2265        -anchor w \
2266        -justify left
2267pack .vpane.lower.diff.header.status -side left
2268pack .vpane.lower.diff.header.file -side left
2269pack .vpane.lower.diff.header.path -fill x
2270set ctxm .vpane.lower.diff.header.ctxm
2271menu $ctxm -tearoff 0
2272$ctxm add command \
2273        -label {Copy} \
2274        -command {
2275                clipboard clear
2276                clipboard append \
2277                        -format STRING \
2278                        -type STRING \
2279                        -- $current_diff_path
2280        }
2281lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2282bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2283
2284# -- Diff Body
2285#
2286frame .vpane.lower.diff.body
2287set ui_diff .vpane.lower.diff.body.t
2288text $ui_diff -background white -borderwidth 0 \
2289        -width 80 -height 15 -wrap none \
2290        -font font_diff \
2291        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2292        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2293        -state disabled
2294scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2295        -command [list $ui_diff xview]
2296scrollbar .vpane.lower.diff.body.sby -orient vertical \
2297        -command [list $ui_diff yview]
2298pack .vpane.lower.diff.body.sbx -side bottom -fill x
2299pack .vpane.lower.diff.body.sby -side right -fill y
2300pack $ui_diff -side left -fill both -expand 1
2301pack .vpane.lower.diff.header -side top -fill x
2302pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2303
2304$ui_diff tag conf d_cr -elide true
2305$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2306$ui_diff tag conf d_+ -foreground {#00a000}
2307$ui_diff tag conf d_- -foreground red
2308
2309$ui_diff tag conf d_++ -foreground {#00a000}
2310$ui_diff tag conf d_-- -foreground red
2311$ui_diff tag conf d_+s \
2312        -foreground {#00a000} \
2313        -background {#e2effa}
2314$ui_diff tag conf d_-s \
2315        -foreground red \
2316        -background {#e2effa}
2317$ui_diff tag conf d_s+ \
2318        -foreground {#00a000} \
2319        -background ivory1
2320$ui_diff tag conf d_s- \
2321        -foreground red \
2322        -background ivory1
2323
2324$ui_diff tag conf d<<<<<<< \
2325        -foreground orange \
2326        -font font_diffbold
2327$ui_diff tag conf d======= \
2328        -foreground orange \
2329        -font font_diffbold
2330$ui_diff tag conf d>>>>>>> \
2331        -foreground orange \
2332        -font font_diffbold
2333
2334$ui_diff tag raise sel
2335
2336# -- Diff Body Context Menu
2337#
2338set ctxm .vpane.lower.diff.body.ctxm
2339menu $ctxm -tearoff 0
2340$ctxm add command \
2341        -label {Refresh} \
2342        -command reshow_diff
2343lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2344$ctxm add command \
2345        -label {Copy} \
2346        -command {tk_textCopy $ui_diff}
2347lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2348$ctxm add command \
2349        -label {Select All} \
2350        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2351lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2352$ctxm add command \
2353        -label {Copy All} \
2354        -command {
2355                $ui_diff tag add sel 0.0 end
2356                tk_textCopy $ui_diff
2357                $ui_diff tag remove sel 0.0 end
2358        }
2359lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2360$ctxm add separator
2361$ctxm add command \
2362        -label {Apply/Reverse Hunk} \
2363        -command {apply_hunk $cursorX $cursorY}
2364set ui_diff_applyhunk [$ctxm index last]
2365lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2366$ctxm add separator
2367$ctxm add command \
2368        -label {Decrease Font Size} \
2369        -command {incr_font_size font_diff -1}
2370lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2371$ctxm add command \
2372        -label {Increase Font Size} \
2373        -command {incr_font_size font_diff 1}
2374lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2375$ctxm add separator
2376$ctxm add command \
2377        -label {Show Less Context} \
2378        -command {if {$repo_config(gui.diffcontext) >= 1} {
2379                incr repo_config(gui.diffcontext) -1
2380                reshow_diff
2381        }}
2382lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2383$ctxm add command \
2384        -label {Show More Context} \
2385        -command {if {$repo_config(gui.diffcontext) < 99} {
2386                incr repo_config(gui.diffcontext)
2387                reshow_diff
2388        }}
2389lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2390$ctxm add separator
2391$ctxm add command -label {Options...} \
2392        -command do_options
2393bind_button3 $ui_diff "
2394        set cursorX %x
2395        set cursorY %y
2396        if {\$ui_index eq \$current_diff_side} {
2397                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2398        } else {
2399                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2400        }
2401        tk_popup $ctxm %X %Y
2402"
2403unset ui_diff_applyhunk
2404
2405# -- Status Bar
2406#
2407set main_status [::status_bar::new .status]
2408pack .status -anchor w -side bottom -fill x
2409$main_status show {Initializing...}
2410
2411# -- Load geometry
2412#
2413catch {
2414set gm $repo_config(gui.geometry)
2415wm geometry . [lindex $gm 0]
2416.vpane sash place 0 \
2417        [lindex [.vpane sash coord 0] 0] \
2418        [lindex $gm 1]
2419.vpane.files sash place 0 \
2420        [lindex $gm 2] \
2421        [lindex [.vpane.files sash coord 0] 1]
2422unset gm
2423}
2424
2425# -- Key Bindings
2426#
2427bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2428bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2429bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2430bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2431bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2432bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2433bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2434bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2435bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2436bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2437bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2438
2439bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2440bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2441bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2442bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2443bind $ui_diff <$M1B-Key-v> {break}
2444bind $ui_diff <$M1B-Key-V> {break}
2445bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2446bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2447bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2448bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2449bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2450bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2451bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2452bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2453bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2454bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2455bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2456bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2457bind $ui_diff <Button-1>   {focus %W}
2458
2459if {[is_enabled branch]} {
2460        bind . <$M1B-Key-n> branch_create::dialog
2461        bind . <$M1B-Key-N> branch_create::dialog
2462        bind . <$M1B-Key-o> branch_checkout::dialog
2463        bind . <$M1B-Key-O> branch_checkout::dialog
2464}
2465if {[is_enabled transport]} {
2466        bind . <$M1B-Key-p> do_push_anywhere
2467        bind . <$M1B-Key-P> do_push_anywhere
2468}
2469
2470bind .   <Key-F5>     do_rescan
2471bind .   <$M1B-Key-r> do_rescan
2472bind .   <$M1B-Key-R> do_rescan
2473bind .   <$M1B-Key-s> do_signoff
2474bind .   <$M1B-Key-S> do_signoff
2475bind .   <$M1B-Key-i> do_add_all
2476bind .   <$M1B-Key-I> do_add_all
2477bind .   <$M1B-Key-Return> do_commit
2478foreach i [list $ui_index $ui_workdir] {
2479        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2480        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2481        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2482}
2483unset i
2484
2485set file_lists($ui_index) [list]
2486set file_lists($ui_workdir) [list]
2487
2488wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2489focus -force $ui_comm
2490
2491# -- Warn the user about environmental problems.  Cygwin's Tcl
2492#    does *not* pass its env array onto any processes it spawns.
2493#    This means that git processes get none of our environment.
2494#
2495if {[is_Cygwin]} {
2496        set ignored_env 0
2497        set suggest_user {}
2498        set msg "Possible environment issues exist.
2499
2500The following environment variables are probably
2501going to be ignored by any Git subprocess run
2502by [appname]:
2503
2504"
2505        foreach name [array names env] {
2506                switch -regexp -- $name {
2507                {^GIT_INDEX_FILE$} -
2508                {^GIT_OBJECT_DIRECTORY$} -
2509                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2510                {^GIT_DIFF_OPTS$} -
2511                {^GIT_EXTERNAL_DIFF$} -
2512                {^GIT_PAGER$} -
2513                {^GIT_TRACE$} -
2514                {^GIT_CONFIG$} -
2515                {^GIT_CONFIG_LOCAL$} -
2516                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2517                        append msg " - $name\n"
2518                        incr ignored_env
2519                }
2520                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2521                        append msg " - $name\n"
2522                        incr ignored_env
2523                        set suggest_user $name
2524                }
2525                }
2526        }
2527        if {$ignored_env > 0} {
2528                append msg "
2529This is due to a known issue with the
2530Tcl binary distributed by Cygwin."
2531
2532                if {$suggest_user ne {}} {
2533                        append msg "
2534
2535A good replacement for $suggest_user
2536is placing values for the user.name and
2537user.email settings into your personal
2538~/.gitconfig file.
2539"
2540                }
2541                warn_popup $msg
2542        }
2543        unset ignored_env msg suggest_user name
2544}
2545
2546# -- Only initialize complex UI if we are going to stay running.
2547#
2548if {[is_enabled transport]} {
2549        load_all_remotes
2550
2551        populate_fetch_menu
2552        populate_push_menu
2553}
2554
2555# -- Only suggest a gc run if we are going to stay running.
2556#
2557if {[is_enabled multicommit]} {
2558        set object_limit 2000
2559        if {[is_Windows]} {set object_limit 200}
2560        regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2561        if {$objects_current >= $object_limit} {
2562                if {[ask_popup \
2563                        "This repository currently has $objects_current loose objects.
2564
2565To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2566
2567Compress the database now?"] eq yes} {
2568                        do_gc
2569                }
2570        }
2571        unset object_limit _junk objects_current
2572}
2573
2574lock_index begin-read
2575after 1 do_rescan