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