cf88a0d8247e8578e5740d290ee1e72b011f2fe2
   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        global main_status
1129        if {[info exists main_status]} {
1130                $main_status show $msg
1131        }
1132}
1133
1134proc ui_ready {{test {}}} {
1135        global main_status
1136        if {[info exists main_status]} {
1137                $main_status show [mc "Ready."] $test
1138        }
1139}
1140
1141proc escape_path {path} {
1142        regsub -all {\\} $path "\\\\" path
1143        regsub -all "\n" $path "\\n" path
1144        return $path
1145}
1146
1147proc short_path {path} {
1148        return [escape_path [lindex [file split $path] end]]
1149}
1150
1151set next_icon_id 0
1152set null_sha1 [string repeat 0 40]
1153
1154proc merge_state {path new_state {head_info {}} {index_info {}}} {
1155        global file_states next_icon_id null_sha1
1156
1157        set s0 [string index $new_state 0]
1158        set s1 [string index $new_state 1]
1159
1160        if {[catch {set info $file_states($path)}]} {
1161                set state __
1162                set icon n[incr next_icon_id]
1163        } else {
1164                set state [lindex $info 0]
1165                set icon [lindex $info 1]
1166                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1167                if {$index_info eq {}} {set index_info [lindex $info 3]}
1168        }
1169
1170        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1171        elseif {$s0 eq {_}} {set s0 _}
1172
1173        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1174        elseif {$s1 eq {_}} {set s1 _}
1175
1176        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1177                set head_info [list 0 $null_sha1]
1178        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1179                && $head_info eq {}} {
1180                set head_info $index_info
1181        }
1182
1183        set file_states($path) [list $s0$s1 $icon \
1184                $head_info $index_info \
1185                ]
1186        return $state
1187}
1188
1189proc display_file_helper {w path icon_name old_m new_m} {
1190        global file_lists
1191
1192        if {$new_m eq {_}} {
1193                set lno [lsearch -sorted -exact $file_lists($w) $path]
1194                if {$lno >= 0} {
1195                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1196                        incr lno
1197                        $w conf -state normal
1198                        $w delete $lno.0 [expr {$lno + 1}].0
1199                        $w conf -state disabled
1200                }
1201        } elseif {$old_m eq {_} && $new_m ne {_}} {
1202                lappend file_lists($w) $path
1203                set file_lists($w) [lsort -unique $file_lists($w)]
1204                set lno [lsearch -sorted -exact $file_lists($w) $path]
1205                incr lno
1206                $w conf -state normal
1207                $w image create $lno.0 \
1208                        -align center -padx 5 -pady 1 \
1209                        -name $icon_name \
1210                        -image [mapicon $w $new_m $path]
1211                $w insert $lno.1 "[escape_path $path]\n"
1212                $w conf -state disabled
1213        } elseif {$old_m ne $new_m} {
1214                $w conf -state normal
1215                $w image conf $icon_name -image [mapicon $w $new_m $path]
1216                $w conf -state disabled
1217        }
1218}
1219
1220proc display_file {path state} {
1221        global file_states selected_paths
1222        global ui_index ui_workdir
1223
1224        set old_m [merge_state $path $state]
1225        set s $file_states($path)
1226        set new_m [lindex $s 0]
1227        set icon_name [lindex $s 1]
1228
1229        set o [string index $old_m 0]
1230        set n [string index $new_m 0]
1231        if {$o eq {U}} {
1232                set o _
1233        }
1234        if {$n eq {U}} {
1235                set n _
1236        }
1237        display_file_helper     $ui_index $path $icon_name $o $n
1238
1239        if {[string index $old_m 0] eq {U}} {
1240                set o U
1241        } else {
1242                set o [string index $old_m 1]
1243        }
1244        if {[string index $new_m 0] eq {U}} {
1245                set n U
1246        } else {
1247                set n [string index $new_m 1]
1248        }
1249        display_file_helper     $ui_workdir $path $icon_name $o $n
1250
1251        if {$new_m eq {__}} {
1252                unset file_states($path)
1253                catch {unset selected_paths($path)}
1254        }
1255}
1256
1257proc display_all_files_helper {w path icon_name m} {
1258        global file_lists
1259
1260        lappend file_lists($w) $path
1261        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1262        $w image create end \
1263                -align center -padx 5 -pady 1 \
1264                -name $icon_name \
1265                -image [mapicon $w $m $path]
1266        $w insert end "[escape_path $path]\n"
1267}
1268
1269proc display_all_files {} {
1270        global ui_index ui_workdir
1271        global file_states file_lists
1272        global last_clicked
1273
1274        $ui_index conf -state normal
1275        $ui_workdir conf -state normal
1276
1277        $ui_index delete 0.0 end
1278        $ui_workdir delete 0.0 end
1279        set last_clicked {}
1280
1281        set file_lists($ui_index) [list]
1282        set file_lists($ui_workdir) [list]
1283
1284        foreach path [lsort [array names file_states]] {
1285                set s $file_states($path)
1286                set m [lindex $s 0]
1287                set icon_name [lindex $s 1]
1288
1289                set s [string index $m 0]
1290                if {$s ne {U} && $s ne {_}} {
1291                        display_all_files_helper $ui_index $path \
1292                                $icon_name $s
1293                }
1294
1295                if {[string index $m 0] eq {U}} {
1296                        set s U
1297                } else {
1298                        set s [string index $m 1]
1299                }
1300                if {$s ne {_}} {
1301                        display_all_files_helper $ui_workdir $path \
1302                                $icon_name $s
1303                }
1304        }
1305
1306        $ui_index conf -state disabled
1307        $ui_workdir conf -state disabled
1308}
1309
1310######################################################################
1311##
1312## icons
1313
1314set filemask {
1315#define mask_width 14
1316#define mask_height 15
1317static unsigned char mask_bits[] = {
1318   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1319   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1320   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1321}
1322
1323image create bitmap file_plain -background white -foreground black -data {
1324#define plain_width 14
1325#define plain_height 15
1326static unsigned char plain_bits[] = {
1327   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1328   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1329   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1330} -maskdata $filemask
1331
1332image create bitmap file_mod -background white -foreground blue -data {
1333#define mod_width 14
1334#define mod_height 15
1335static unsigned char mod_bits[] = {
1336   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1337   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1338   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1339} -maskdata $filemask
1340
1341image create bitmap file_fulltick -background white -foreground "#007000" -data {
1342#define file_fulltick_width 14
1343#define file_fulltick_height 15
1344static unsigned char file_fulltick_bits[] = {
1345   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1346   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1347   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1348} -maskdata $filemask
1349
1350image create bitmap file_parttick -background white -foreground "#005050" -data {
1351#define parttick_width 14
1352#define parttick_height 15
1353static unsigned char parttick_bits[] = {
1354   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1355   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1356   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1357} -maskdata $filemask
1358
1359image create bitmap file_question -background white -foreground black -data {
1360#define file_question_width 14
1361#define file_question_height 15
1362static unsigned char file_question_bits[] = {
1363   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1364   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1365   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1366} -maskdata $filemask
1367
1368image create bitmap file_removed -background white -foreground red -data {
1369#define file_removed_width 14
1370#define file_removed_height 15
1371static unsigned char file_removed_bits[] = {
1372   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1373   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1374   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1375} -maskdata $filemask
1376
1377image create bitmap file_merge -background white -foreground blue -data {
1378#define file_merge_width 14
1379#define file_merge_height 15
1380static unsigned char file_merge_bits[] = {
1381   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1382   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1383   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1384} -maskdata $filemask
1385
1386set ui_index .vpane.files.index.list
1387set ui_workdir .vpane.files.workdir.list
1388
1389set all_icons(_$ui_index)   file_plain
1390set all_icons(A$ui_index)   file_fulltick
1391set all_icons(M$ui_index)   file_fulltick
1392set all_icons(D$ui_index)   file_removed
1393set all_icons(U$ui_index)   file_merge
1394
1395set all_icons(_$ui_workdir) file_plain
1396set all_icons(M$ui_workdir) file_mod
1397set all_icons(D$ui_workdir) file_question
1398set all_icons(U$ui_workdir) file_merge
1399set all_icons(O$ui_workdir) file_plain
1400
1401set max_status_desc 0
1402foreach i {
1403                {__ "Unmodified"}
1404
1405                {_M "Modified, not staged"}
1406                {M_ "Staged for commit"}
1407                {MM "Portions staged for commit"}
1408                {MD "Staged for commit, missing"}
1409
1410                {_O "Untracked, not staged"}
1411                {A_ "Staged for commit"}
1412                {AM "Portions staged for commit"}
1413                {AD "Staged for commit, missing"}
1414
1415                {_D "Missing"}
1416                {D_ "Staged for removal"}
1417                {DO "Staged for removal, still present"}
1418
1419                {U_ "Requires merge resolution"}
1420                {UU "Requires merge resolution"}
1421                {UM "Requires merge resolution"}
1422                {UD "Requires merge resolution"}
1423        } {
1424        if {$max_status_desc < [string length [lindex $i 1]]} {
1425                set max_status_desc [string length [lindex $i 1]]
1426        }
1427        set all_descs([lindex $i 0]) [lindex $i 1]
1428}
1429unset i
1430
1431######################################################################
1432##
1433## util
1434
1435proc bind_button3 {w cmd} {
1436        bind $w <Any-Button-3> $cmd
1437        if {[is_MacOSX]} {
1438                # Mac OS X sends Button-2 on right click through three-button mouse,
1439                # or through trackpad right-clicking (two-finger touch + click).
1440                bind $w <Any-Button-2> $cmd
1441                bind $w <Control-Button-1> $cmd
1442        }
1443}
1444
1445proc scrollbar2many {list mode args} {
1446        foreach w $list {eval $w $mode $args}
1447}
1448
1449proc many2scrollbar {list mode sb top bottom} {
1450        $sb set $top $bottom
1451        foreach w $list {$w $mode moveto $top}
1452}
1453
1454proc incr_font_size {font {amt 1}} {
1455        set sz [font configure $font -size]
1456        incr sz $amt
1457        font configure $font -size $sz
1458        font configure ${font}bold -size $sz
1459        font configure ${font}italic -size $sz
1460}
1461
1462######################################################################
1463##
1464## ui commands
1465
1466set starting_gitk_msg {Starting gitk... please wait...}
1467
1468proc do_gitk {revs} {
1469        # -- Always start gitk through whatever we were loaded with.  This
1470        #    lets us bypass using shell process on Windows systems.
1471        #
1472        set exe [file join [file dirname $::_git] gitk]
1473        set cmd [list [info nameofexecutable] $exe]
1474        if {! [file exists $exe]} {
1475                error_popup "Unable to start gitk:\n\n$exe does not exist"
1476        } else {
1477                global env
1478
1479                if {[info exists env(GIT_DIR)]} {
1480                        set old_GIT_DIR $env(GIT_DIR)
1481                } else {
1482                        set old_GIT_DIR {}
1483                }
1484
1485                set pwd [pwd]
1486                cd [file dirname [gitdir]]
1487                set env(GIT_DIR) [file tail [gitdir]]
1488
1489                eval exec $cmd $revs &
1490
1491                if {$old_GIT_DIR eq {}} {
1492                        unset env(GIT_DIR)
1493                } else {
1494                        set env(GIT_DIR) $old_GIT_DIR
1495                }
1496                cd $pwd
1497
1498                ui_status $::starting_gitk_msg
1499                after 10000 {
1500                        ui_ready $starting_gitk_msg
1501                }
1502        }
1503}
1504
1505set is_quitting 0
1506
1507proc do_quit {} {
1508        global ui_comm is_quitting repo_config commit_type
1509        global GITGUI_BCK_exists GITGUI_BCK_i
1510
1511        if {$is_quitting} return
1512        set is_quitting 1
1513
1514        if {[winfo exists $ui_comm]} {
1515                # -- Stash our current commit buffer.
1516                #
1517                set save [gitdir GITGUI_MSG]
1518                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1519                        file rename -force [gitdir GITGUI_BCK] $save
1520                        set GITGUI_BCK_exists 0
1521                } else {
1522                        set msg [string trim [$ui_comm get 0.0 end]]
1523                        regsub -all -line {[ \r\t]+$} $msg {} msg
1524                        if {(![string match amend* $commit_type]
1525                                || [$ui_comm edit modified])
1526                                && $msg ne {}} {
1527                                catch {
1528                                        set fd [open $save w]
1529                                        puts -nonewline $fd $msg
1530                                        close $fd
1531                                }
1532                        } else {
1533                                catch {file delete $save}
1534                        }
1535                }
1536
1537                # -- Remove our editor backup, its not needed.
1538                #
1539                after cancel $GITGUI_BCK_i
1540                if {$GITGUI_BCK_exists} {
1541                        catch {file delete [gitdir GITGUI_BCK]}
1542                }
1543
1544                # -- Stash our current window geometry into this repository.
1545                #
1546                set cfg_geometry [list]
1547                lappend cfg_geometry [wm geometry .]
1548                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1549                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1550                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1551                        set rc_geometry {}
1552                }
1553                if {$cfg_geometry ne $rc_geometry} {
1554                        catch {git config gui.geometry $cfg_geometry}
1555                }
1556        }
1557
1558        destroy .
1559}
1560
1561proc do_rescan {} {
1562        rescan ui_ready
1563}
1564
1565proc do_commit {} {
1566        commit_tree
1567}
1568
1569proc toggle_or_diff {w x y} {
1570        global file_states file_lists current_diff_path ui_index ui_workdir
1571        global last_clicked selected_paths
1572
1573        set pos [split [$w index @$x,$y] .]
1574        set lno [lindex $pos 0]
1575        set col [lindex $pos 1]
1576        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1577        if {$path eq {}} {
1578                set last_clicked {}
1579                return
1580        }
1581
1582        set last_clicked [list $w $lno]
1583        array unset selected_paths
1584        $ui_index tag remove in_sel 0.0 end
1585        $ui_workdir tag remove in_sel 0.0 end
1586
1587        if {$col == 0} {
1588                if {$current_diff_path eq $path} {
1589                        set after {reshow_diff;}
1590                } else {
1591                        set after {}
1592                }
1593                if {$w eq $ui_index} {
1594                        update_indexinfo \
1595                                "Unstaging [short_path $path] from commit" \
1596                                [list $path] \
1597                                [concat $after [list ui_ready]]
1598                } elseif {$w eq $ui_workdir} {
1599                        update_index \
1600                                "Adding [short_path $path]" \
1601                                [list $path] \
1602                                [concat $after [list ui_ready]]
1603                }
1604        } else {
1605                show_diff $path $w $lno
1606        }
1607}
1608
1609proc add_one_to_selection {w x y} {
1610        global file_lists last_clicked selected_paths
1611
1612        set lno [lindex [split [$w index @$x,$y] .] 0]
1613        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1614        if {$path eq {}} {
1615                set last_clicked {}
1616                return
1617        }
1618
1619        if {$last_clicked ne {}
1620                && [lindex $last_clicked 0] ne $w} {
1621                array unset selected_paths
1622                [lindex $last_clicked 0] tag remove in_sel 0.0 end
1623        }
1624
1625        set last_clicked [list $w $lno]
1626        if {[catch {set in_sel $selected_paths($path)}]} {
1627                set in_sel 0
1628        }
1629        if {$in_sel} {
1630                unset selected_paths($path)
1631                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1632        } else {
1633                set selected_paths($path) 1
1634                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1635        }
1636}
1637
1638proc add_range_to_selection {w x y} {
1639        global file_lists last_clicked selected_paths
1640
1641        if {[lindex $last_clicked 0] ne $w} {
1642                toggle_or_diff $w $x $y
1643                return
1644        }
1645
1646        set lno [lindex [split [$w index @$x,$y] .] 0]
1647        set lc [lindex $last_clicked 1]
1648        if {$lc < $lno} {
1649                set begin $lc
1650                set end $lno
1651        } else {
1652                set begin $lno
1653                set end $lc
1654        }
1655
1656        foreach path [lrange $file_lists($w) \
1657                [expr {$begin - 1}] \
1658                [expr {$end - 1}]] {
1659                set selected_paths($path) 1
1660        }
1661        $w tag add in_sel $begin.0 [expr {$end + 1}].0
1662}
1663
1664######################################################################
1665##
1666## config defaults
1667
1668set cursor_ptr arrow
1669font create font_diff -family Courier -size 10
1670font create font_ui
1671catch {
1672        label .dummy
1673        eval font configure font_ui [font actual [.dummy cget -font]]
1674        destroy .dummy
1675}
1676
1677font create font_uiitalic
1678font create font_uibold
1679font create font_diffbold
1680font create font_diffitalic
1681
1682foreach class {Button Checkbutton Entry Label
1683                Labelframe Listbox Menu Message
1684                Radiobutton Spinbox Text} {
1685        option add *$class.font font_ui
1686}
1687unset class
1688
1689if {[is_Windows] || [is_MacOSX]} {
1690        option add *Menu.tearOff 0
1691}
1692
1693if {[is_MacOSX]} {
1694        set M1B M1
1695        set M1T Cmd
1696} else {
1697        set M1B Control
1698        set M1T Ctrl
1699}
1700
1701proc apply_config {} {
1702        global repo_config font_descs
1703
1704        foreach option $font_descs {
1705                set name [lindex $option 0]
1706                set font [lindex $option 1]
1707                if {[catch {
1708                        foreach {cn cv} $repo_config(gui.$name) {
1709                                font configure $font $cn $cv -weight normal
1710                        }
1711                        } err]} {
1712                        error_popup "Invalid font specified in gui.$name:\n\n$err"
1713                }
1714                foreach {cn cv} [font configure $font] {
1715                        font configure ${font}bold $cn $cv
1716                        font configure ${font}italic $cn $cv
1717                }
1718                font configure ${font}bold -weight bold
1719                font configure ${font}italic -slant italic
1720        }
1721}
1722
1723set default_config(merge.diffstat) true
1724set default_config(merge.summary) false
1725set default_config(merge.verbosity) 2
1726set default_config(user.name) {}
1727set default_config(user.email) {}
1728
1729set default_config(gui.matchtrackingbranch) false
1730set default_config(gui.pruneduringfetch) false
1731set default_config(gui.trustmtime) false
1732set default_config(gui.diffcontext) 5
1733set default_config(gui.newbranchtemplate) {}
1734set default_config(gui.fontui) [font configure font_ui]
1735set default_config(gui.fontdiff) [font configure font_diff]
1736set font_descs {
1737        {fontui   font_ui   {Main Font}}
1738        {fontdiff font_diff {Diff/Console Font}}
1739}
1740load_config 0
1741apply_config
1742
1743######################################################################
1744##
1745## ui construction
1746
1747set ui_comm {}
1748
1749# -- Menu Bar
1750#
1751menu .mbar -tearoff 0
1752.mbar add cascade -label Repository -menu .mbar.repository
1753.mbar add cascade -label Edit -menu .mbar.edit
1754if {[is_enabled branch]} {
1755        .mbar add cascade -label Branch -menu .mbar.branch
1756}
1757if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1758        .mbar add cascade -label Commit -menu .mbar.commit
1759}
1760if {[is_enabled transport]} {
1761        .mbar add cascade -label Merge -menu .mbar.merge
1762        .mbar add cascade -label Fetch -menu .mbar.fetch
1763        .mbar add cascade -label Push -menu .mbar.push
1764}
1765. configure -menu .mbar
1766
1767# -- Repository Menu
1768#
1769menu .mbar.repository
1770
1771.mbar.repository add command \
1772        -label {Browse Current Branch's Files} \
1773        -command {browser::new $current_branch}
1774set ui_browse_current [.mbar.repository index last]
1775.mbar.repository add command \
1776        -label {Browse Branch Files...} \
1777        -command browser_open::dialog
1778.mbar.repository add separator
1779
1780.mbar.repository add command \
1781        -label {Visualize Current Branch's History} \
1782        -command {do_gitk $current_branch}
1783set ui_visualize_current [.mbar.repository index last]
1784.mbar.repository add command \
1785        -label {Visualize All Branch History} \
1786        -command {do_gitk --all}
1787.mbar.repository add separator
1788
1789proc current_branch_write {args} {
1790        global current_branch
1791        .mbar.repository entryconf $::ui_browse_current \
1792                -label "Browse $current_branch's Files"
1793        .mbar.repository entryconf $::ui_visualize_current \
1794                -label "Visualize $current_branch's History"
1795}
1796trace add variable current_branch write current_branch_write
1797
1798if {[is_enabled multicommit]} {
1799        .mbar.repository add command -label {Database Statistics} \
1800                -command do_stats
1801
1802        .mbar.repository add command -label {Compress Database} \
1803                -command do_gc
1804
1805        .mbar.repository add command -label {Verify Database} \
1806                -command do_fsck_objects
1807
1808        .mbar.repository add separator
1809
1810        if {[is_Cygwin]} {
1811                .mbar.repository add command \
1812                        -label {Create Desktop Icon} \
1813                        -command do_cygwin_shortcut
1814        } elseif {[is_Windows]} {
1815                .mbar.repository add command \
1816                        -label {Create Desktop Icon} \
1817                        -command do_windows_shortcut
1818        } elseif {[is_MacOSX]} {
1819                .mbar.repository add command \
1820                        -label {Create Desktop Icon} \
1821                        -command do_macosx_app
1822        }
1823}
1824
1825.mbar.repository add command -label Quit \
1826        -command do_quit \
1827        -accelerator $M1T-Q
1828
1829# -- Edit Menu
1830#
1831menu .mbar.edit
1832.mbar.edit add command -label Undo \
1833        -command {catch {[focus] edit undo}} \
1834        -accelerator $M1T-Z
1835.mbar.edit add command -label Redo \
1836        -command {catch {[focus] edit redo}} \
1837        -accelerator $M1T-Y
1838.mbar.edit add separator
1839.mbar.edit add command -label Cut \
1840        -command {catch {tk_textCut [focus]}} \
1841        -accelerator $M1T-X
1842.mbar.edit add command -label Copy \
1843        -command {catch {tk_textCopy [focus]}} \
1844        -accelerator $M1T-C
1845.mbar.edit add command -label Paste \
1846        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1847        -accelerator $M1T-V
1848.mbar.edit add command -label Delete \
1849        -command {catch {[focus] delete sel.first sel.last}} \
1850        -accelerator Del
1851.mbar.edit add separator
1852.mbar.edit add command -label {Select All} \
1853        -command {catch {[focus] tag add sel 0.0 end}} \
1854        -accelerator $M1T-A
1855
1856# -- Branch Menu
1857#
1858if {[is_enabled branch]} {
1859        menu .mbar.branch
1860
1861        .mbar.branch add command -label {Create...} \
1862                -command branch_create::dialog \
1863                -accelerator $M1T-N
1864        lappend disable_on_lock [list .mbar.branch entryconf \
1865                [.mbar.branch index last] -state]
1866
1867        .mbar.branch add command -label {Checkout...} \
1868                -command branch_checkout::dialog \
1869                -accelerator $M1T-O
1870        lappend disable_on_lock [list .mbar.branch entryconf \
1871                [.mbar.branch index last] -state]
1872
1873        .mbar.branch add command -label {Rename...} \
1874                -command branch_rename::dialog
1875        lappend disable_on_lock [list .mbar.branch entryconf \
1876                [.mbar.branch index last] -state]
1877
1878        .mbar.branch add command -label {Delete...} \
1879                -command branch_delete::dialog
1880        lappend disable_on_lock [list .mbar.branch entryconf \
1881                [.mbar.branch index last] -state]
1882
1883        .mbar.branch add command -label {Reset...} \
1884                -command merge::reset_hard
1885        lappend disable_on_lock [list .mbar.branch entryconf \
1886                [.mbar.branch index last] -state]
1887}
1888
1889# -- Commit Menu
1890#
1891if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1892        menu .mbar.commit
1893
1894        .mbar.commit add radiobutton \
1895                -label {New Commit} \
1896                -command do_select_commit_type \
1897                -variable selected_commit_type \
1898                -value new
1899        lappend disable_on_lock \
1900                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1901
1902        .mbar.commit add radiobutton \
1903                -label {Amend Last Commit} \
1904                -command do_select_commit_type \
1905                -variable selected_commit_type \
1906                -value amend
1907        lappend disable_on_lock \
1908                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1909
1910        .mbar.commit add separator
1911
1912        .mbar.commit add command -label Rescan \
1913                -command do_rescan \
1914                -accelerator F5
1915        lappend disable_on_lock \
1916                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1917
1918        .mbar.commit add command -label {Stage To Commit} \
1919                -command do_add_selection
1920        lappend disable_on_lock \
1921                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1922
1923        .mbar.commit add command -label {Stage Changed Files To Commit} \
1924                -command do_add_all \
1925                -accelerator $M1T-I
1926        lappend disable_on_lock \
1927                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1928
1929        .mbar.commit add command -label {Unstage From Commit} \
1930                -command do_unstage_selection
1931        lappend disable_on_lock \
1932                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1933
1934        .mbar.commit add command -label {Revert Changes} \
1935                -command do_revert_selection
1936        lappend disable_on_lock \
1937                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1938
1939        .mbar.commit add separator
1940
1941        .mbar.commit add command -label {Sign Off} \
1942                -command do_signoff \
1943                -accelerator $M1T-S
1944
1945        .mbar.commit add command -label Commit \
1946                -command do_commit \
1947                -accelerator $M1T-Return
1948        lappend disable_on_lock \
1949                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1950}
1951
1952# -- Merge Menu
1953#
1954if {[is_enabled branch]} {
1955        menu .mbar.merge
1956        .mbar.merge add command -label {Local Merge...} \
1957                -command merge::dialog \
1958                -accelerator $M1T-M
1959        lappend disable_on_lock \
1960                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1961        .mbar.merge add command -label {Abort Merge...} \
1962                -command merge::reset_hard
1963        lappend disable_on_lock \
1964                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1965}
1966
1967# -- Transport Menu
1968#
1969if {[is_enabled transport]} {
1970        menu .mbar.fetch
1971
1972        menu .mbar.push
1973        .mbar.push add command -label {Push...} \
1974                -command do_push_anywhere \
1975                -accelerator $M1T-P
1976        .mbar.push add command -label {Delete...} \
1977                -command remote_branch_delete::dialog
1978}
1979
1980if {[is_MacOSX]} {
1981        # -- Apple Menu (Mac OS X only)
1982        #
1983        .mbar add cascade -label Apple -menu .mbar.apple
1984        menu .mbar.apple
1985
1986        .mbar.apple add command -label "About [appname]" \
1987                -command do_about
1988        .mbar.apple add command -label "Options..." \
1989                -command do_options
1990} else {
1991        # -- Edit Menu
1992        #
1993        .mbar.edit add separator
1994        .mbar.edit add command -label {Options...} \
1995                -command do_options
1996}
1997
1998# -- Help Menu
1999#
2000.mbar add cascade -label Help -menu .mbar.help
2001menu .mbar.help
2002
2003if {![is_MacOSX]} {
2004        .mbar.help add command -label "About [appname]" \
2005                -command do_about
2006}
2007
2008set browser {}
2009catch {set browser $repo_config(instaweb.browser)}
2010set doc_path [file dirname [gitexec]]
2011set doc_path [file join $doc_path Documentation index.html]
2012
2013if {[is_Cygwin]} {
2014        set doc_path [exec cygpath --mixed $doc_path]
2015}
2016
2017if {$browser eq {}} {
2018        if {[is_MacOSX]} {
2019                set browser open
2020        } elseif {[is_Cygwin]} {
2021                set program_files [file dirname [exec cygpath --windir]]
2022                set program_files [file join $program_files {Program Files}]
2023                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2024                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2025                if {[file exists $firefox]} {
2026                        set browser $firefox
2027                } elseif {[file exists $ie]} {
2028                        set browser $ie
2029                }
2030                unset program_files firefox ie
2031        }
2032}
2033
2034if {[file isfile $doc_path]} {
2035        set doc_url "file:$doc_path"
2036} else {
2037        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2038}
2039
2040if {$browser ne {}} {
2041        .mbar.help add command -label {Online Documentation} \
2042                -command [list exec $browser $doc_url &]
2043}
2044unset browser doc_path doc_url
2045
2046set root_exists 0
2047bind . <Visibility> {
2048        bind . <Visibility> {}
2049        set root_exists 1
2050}
2051
2052# -- Standard bindings
2053#
2054wm protocol . WM_DELETE_WINDOW do_quit
2055bind all <$M1B-Key-q> do_quit
2056bind all <$M1B-Key-Q> do_quit
2057bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2058bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2059
2060set subcommand_args {}
2061proc usage {} {
2062        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2063        exit 1
2064}
2065
2066# -- Not a normal commit type invocation?  Do that instead!
2067#
2068switch -- $subcommand {
2069browser -
2070blame {
2071        set subcommand_args {rev? path}
2072        if {$argv eq {}} usage
2073        set head {}
2074        set path {}
2075        set is_path 0
2076        foreach a $argv {
2077                if {$is_path || [file exists $_prefix$a]} {
2078                        if {$path ne {}} usage
2079                        set path $_prefix$a
2080                        break
2081                } elseif {$a eq {--}} {
2082                        if {$path ne {}} {
2083                                if {$head ne {}} usage
2084                                set head $path
2085                                set path {}
2086                        }
2087                        set is_path 1
2088                } elseif {$head eq {}} {
2089                        if {$head ne {}} usage
2090                        set head $a
2091                        set is_path 1
2092                } else {
2093                        usage
2094                }
2095        }
2096        unset is_path
2097
2098        if {$head ne {} && $path eq {}} {
2099                set path $_prefix$head
2100                set head {}
2101        }
2102
2103        if {$head eq {}} {
2104                load_current_branch
2105        } else {
2106                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2107                        if {[catch {
2108                                        set head [git rev-parse --verify $head]
2109                                } err]} {
2110                                puts stderr $err
2111                                exit 1
2112                        }
2113                }
2114                set current_branch $head
2115        }
2116
2117        switch -- $subcommand {
2118        browser {
2119                if {$head eq {}} {
2120                        if {$path ne {} && [file isdirectory $path]} {
2121                                set head $current_branch
2122                        } else {
2123                                set head $path
2124                                set path {}
2125                        }
2126                }
2127                browser::new $head $path
2128        }
2129        blame   {
2130                if {$head eq {} && ![file exists $path]} {
2131                        puts stderr "fatal: cannot stat path $path: No such file or directory"
2132                        exit 1
2133                }
2134                blame::new $head $path
2135        }
2136        }
2137        return
2138}
2139citool -
2140gui {
2141        if {[llength $argv] != 0} {
2142                puts -nonewline stderr "usage: $argv0"
2143                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2144                        puts -nonewline stderr " $subcommand"
2145                }
2146                puts stderr {}
2147                exit 1
2148        }
2149        # fall through to setup UI for commits
2150}
2151default {
2152        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2153        exit 1
2154}
2155}
2156
2157# -- Branch Control
2158#
2159frame .branch \
2160        -borderwidth 1 \
2161        -relief sunken
2162label .branch.l1 \
2163        -text {Current Branch:} \
2164        -anchor w \
2165        -justify left
2166label .branch.cb \
2167        -textvariable current_branch \
2168        -anchor w \
2169        -justify left
2170pack .branch.l1 -side left
2171pack .branch.cb -side left -fill x
2172pack .branch -side top -fill x
2173
2174# -- Main Window Layout
2175#
2176panedwindow .vpane -orient vertical
2177panedwindow .vpane.files -orient horizontal
2178.vpane add .vpane.files -sticky nsew -height 100 -width 200
2179pack .vpane -anchor n -side top -fill both -expand 1
2180
2181# -- Index File List
2182#
2183frame .vpane.files.index -height 100 -width 200
2184label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2185        -background lightgreen
2186text $ui_index -background white -borderwidth 0 \
2187        -width 20 -height 10 \
2188        -wrap none \
2189        -cursor $cursor_ptr \
2190        -xscrollcommand {.vpane.files.index.sx set} \
2191        -yscrollcommand {.vpane.files.index.sy set} \
2192        -state disabled
2193scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2194scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2195pack .vpane.files.index.title -side top -fill x
2196pack .vpane.files.index.sx -side bottom -fill x
2197pack .vpane.files.index.sy -side right -fill y
2198pack $ui_index -side left -fill both -expand 1
2199.vpane.files add .vpane.files.index -sticky nsew
2200
2201# -- Working Directory File List
2202#
2203frame .vpane.files.workdir -height 100 -width 200
2204label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2205        -background lightsalmon
2206text $ui_workdir -background white -borderwidth 0 \
2207        -width 20 -height 10 \
2208        -wrap none \
2209        -cursor $cursor_ptr \
2210        -xscrollcommand {.vpane.files.workdir.sx set} \
2211        -yscrollcommand {.vpane.files.workdir.sy set} \
2212        -state disabled
2213scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2214scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2215pack .vpane.files.workdir.title -side top -fill x
2216pack .vpane.files.workdir.sx -side bottom -fill x
2217pack .vpane.files.workdir.sy -side right -fill y
2218pack $ui_workdir -side left -fill both -expand 1
2219.vpane.files add .vpane.files.workdir -sticky nsew
2220
2221foreach i [list $ui_index $ui_workdir] {
2222        rmsel_tag $i
2223        $i tag conf in_diff -background [$i tag cget in_sel -background]
2224}
2225unset i
2226
2227# -- Diff and Commit Area
2228#
2229frame .vpane.lower -height 300 -width 400
2230frame .vpane.lower.commarea
2231frame .vpane.lower.diff -relief sunken -borderwidth 1
2232pack .vpane.lower.commarea -side top -fill x
2233pack .vpane.lower.diff -side bottom -fill both -expand 1
2234.vpane add .vpane.lower -sticky nsew
2235
2236# -- Commit Area Buttons
2237#
2238frame .vpane.lower.commarea.buttons
2239label .vpane.lower.commarea.buttons.l -text {} \
2240        -anchor w \
2241        -justify left
2242pack .vpane.lower.commarea.buttons.l -side top -fill x
2243pack .vpane.lower.commarea.buttons -side left -fill y
2244
2245button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2246        -command do_rescan
2247pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2248lappend disable_on_lock \
2249        {.vpane.lower.commarea.buttons.rescan conf -state}
2250
2251button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2252        -command do_add_all
2253pack .vpane.lower.commarea.buttons.incall -side top -fill x
2254lappend disable_on_lock \
2255        {.vpane.lower.commarea.buttons.incall conf -state}
2256
2257button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2258        -command do_signoff
2259pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2260
2261button .vpane.lower.commarea.buttons.commit -text {Commit} \
2262        -command do_commit
2263pack .vpane.lower.commarea.buttons.commit -side top -fill x
2264lappend disable_on_lock \
2265        {.vpane.lower.commarea.buttons.commit conf -state}
2266
2267button .vpane.lower.commarea.buttons.push -text {Push} \
2268        -command do_push_anywhere
2269pack .vpane.lower.commarea.buttons.push -side top -fill x
2270
2271# -- Commit Message Buffer
2272#
2273frame .vpane.lower.commarea.buffer
2274frame .vpane.lower.commarea.buffer.header
2275set ui_comm .vpane.lower.commarea.buffer.t
2276set ui_coml .vpane.lower.commarea.buffer.header.l
2277radiobutton .vpane.lower.commarea.buffer.header.new \
2278        -text {New Commit} \
2279        -command do_select_commit_type \
2280        -variable selected_commit_type \
2281        -value new
2282lappend disable_on_lock \
2283        [list .vpane.lower.commarea.buffer.header.new conf -state]
2284radiobutton .vpane.lower.commarea.buffer.header.amend \
2285        -text {Amend Last Commit} \
2286        -command do_select_commit_type \
2287        -variable selected_commit_type \
2288        -value amend
2289lappend disable_on_lock \
2290        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2291label $ui_coml \
2292        -anchor w \
2293        -justify left
2294proc trace_commit_type {varname args} {
2295        global ui_coml commit_type
2296        switch -glob -- $commit_type {
2297        initial       {set txt {Initial Commit Message:}}
2298        amend         {set txt {Amended Commit Message:}}
2299        amend-initial {set txt {Amended Initial Commit Message:}}
2300        amend-merge   {set txt {Amended Merge Commit Message:}}
2301        merge         {set txt {Merge Commit Message:}}
2302        *             {set txt {Commit Message:}}
2303        }
2304        $ui_coml conf -text $txt
2305}
2306trace add variable commit_type write trace_commit_type
2307pack $ui_coml -side left -fill x
2308pack .vpane.lower.commarea.buffer.header.amend -side right
2309pack .vpane.lower.commarea.buffer.header.new -side right
2310
2311text $ui_comm -background white -borderwidth 1 \
2312        -undo true \
2313        -maxundo 20 \
2314        -autoseparators true \
2315        -relief sunken \
2316        -width 75 -height 9 -wrap none \
2317        -font font_diff \
2318        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2319scrollbar .vpane.lower.commarea.buffer.sby \
2320        -command [list $ui_comm yview]
2321pack .vpane.lower.commarea.buffer.header -side top -fill x
2322pack .vpane.lower.commarea.buffer.sby -side right -fill y
2323pack $ui_comm -side left -fill y
2324pack .vpane.lower.commarea.buffer -side left -fill y
2325
2326# -- Commit Message Buffer Context Menu
2327#
2328set ctxm .vpane.lower.commarea.buffer.ctxm
2329menu $ctxm -tearoff 0
2330$ctxm add command \
2331        -label {Cut} \
2332        -command {tk_textCut $ui_comm}
2333$ctxm add command \
2334        -label {Copy} \
2335        -command {tk_textCopy $ui_comm}
2336$ctxm add command \
2337        -label {Paste} \
2338        -command {tk_textPaste $ui_comm}
2339$ctxm add command \
2340        -label {Delete} \
2341        -command {$ui_comm delete sel.first sel.last}
2342$ctxm add separator
2343$ctxm add command \
2344        -label {Select All} \
2345        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2346$ctxm add command \
2347        -label {Copy All} \
2348        -command {
2349                $ui_comm tag add sel 0.0 end
2350                tk_textCopy $ui_comm
2351                $ui_comm tag remove sel 0.0 end
2352        }
2353$ctxm add separator
2354$ctxm add command \
2355        -label {Sign Off} \
2356        -command do_signoff
2357bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2358
2359# -- Diff Header
2360#
2361proc trace_current_diff_path {varname args} {
2362        global current_diff_path diff_actions file_states
2363        if {$current_diff_path eq {}} {
2364                set s {}
2365                set f {}
2366                set p {}
2367                set o disabled
2368        } else {
2369                set p $current_diff_path
2370                set s [mapdesc [lindex $file_states($p) 0] $p]
2371                set f {File:}
2372                set p [escape_path $p]
2373                set o normal
2374        }
2375
2376        .vpane.lower.diff.header.status configure -text $s
2377        .vpane.lower.diff.header.file configure -text $f
2378        .vpane.lower.diff.header.path configure -text $p
2379        foreach w $diff_actions {
2380                uplevel #0 $w $o
2381        }
2382}
2383trace add variable current_diff_path write trace_current_diff_path
2384
2385frame .vpane.lower.diff.header -background gold
2386label .vpane.lower.diff.header.status \
2387        -background gold \
2388        -width $max_status_desc \
2389        -anchor w \
2390        -justify left
2391label .vpane.lower.diff.header.file \
2392        -background gold \
2393        -anchor w \
2394        -justify left
2395label .vpane.lower.diff.header.path \
2396        -background gold \
2397        -anchor w \
2398        -justify left
2399pack .vpane.lower.diff.header.status -side left
2400pack .vpane.lower.diff.header.file -side left
2401pack .vpane.lower.diff.header.path -fill x
2402set ctxm .vpane.lower.diff.header.ctxm
2403menu $ctxm -tearoff 0
2404$ctxm add command \
2405        -label {Copy} \
2406        -command {
2407                clipboard clear
2408                clipboard append \
2409                        -format STRING \
2410                        -type STRING \
2411                        -- $current_diff_path
2412        }
2413lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2414bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2415
2416# -- Diff Body
2417#
2418frame .vpane.lower.diff.body
2419set ui_diff .vpane.lower.diff.body.t
2420text $ui_diff -background white -borderwidth 0 \
2421        -width 80 -height 15 -wrap none \
2422        -font font_diff \
2423        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2424        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2425        -state disabled
2426scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2427        -command [list $ui_diff xview]
2428scrollbar .vpane.lower.diff.body.sby -orient vertical \
2429        -command [list $ui_diff yview]
2430pack .vpane.lower.diff.body.sbx -side bottom -fill x
2431pack .vpane.lower.diff.body.sby -side right -fill y
2432pack $ui_diff -side left -fill both -expand 1
2433pack .vpane.lower.diff.header -side top -fill x
2434pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2435
2436$ui_diff tag conf d_cr -elide true
2437$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2438$ui_diff tag conf d_+ -foreground {#00a000}
2439$ui_diff tag conf d_- -foreground red
2440
2441$ui_diff tag conf d_++ -foreground {#00a000}
2442$ui_diff tag conf d_-- -foreground red
2443$ui_diff tag conf d_+s \
2444        -foreground {#00a000} \
2445        -background {#e2effa}
2446$ui_diff tag conf d_-s \
2447        -foreground red \
2448        -background {#e2effa}
2449$ui_diff tag conf d_s+ \
2450        -foreground {#00a000} \
2451        -background ivory1
2452$ui_diff tag conf d_s- \
2453        -foreground red \
2454        -background ivory1
2455
2456$ui_diff tag conf d<<<<<<< \
2457        -foreground orange \
2458        -font font_diffbold
2459$ui_diff tag conf d======= \
2460        -foreground orange \
2461        -font font_diffbold
2462$ui_diff tag conf d>>>>>>> \
2463        -foreground orange \
2464        -font font_diffbold
2465
2466$ui_diff tag raise sel
2467
2468# -- Diff Body Context Menu
2469#
2470set ctxm .vpane.lower.diff.body.ctxm
2471menu $ctxm -tearoff 0
2472$ctxm add command \
2473        -label {Refresh} \
2474        -command reshow_diff
2475lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2476$ctxm add command \
2477        -label {Copy} \
2478        -command {tk_textCopy $ui_diff}
2479lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2480$ctxm add command \
2481        -label {Select All} \
2482        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2483lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2484$ctxm add command \
2485        -label {Copy All} \
2486        -command {
2487                $ui_diff tag add sel 0.0 end
2488                tk_textCopy $ui_diff
2489                $ui_diff tag remove sel 0.0 end
2490        }
2491lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2492$ctxm add separator
2493$ctxm add command \
2494        -label {Apply/Reverse Hunk} \
2495        -command {apply_hunk $cursorX $cursorY}
2496set ui_diff_applyhunk [$ctxm index last]
2497lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2498$ctxm add separator
2499$ctxm add command \
2500        -label {Decrease Font Size} \
2501        -command {incr_font_size font_diff -1}
2502lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2503$ctxm add command \
2504        -label {Increase Font Size} \
2505        -command {incr_font_size font_diff 1}
2506lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2507$ctxm add separator
2508$ctxm add command \
2509        -label {Show Less Context} \
2510        -command {if {$repo_config(gui.diffcontext) >= 1} {
2511                incr repo_config(gui.diffcontext) -1
2512                reshow_diff
2513        }}
2514lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2515$ctxm add command \
2516        -label {Show More Context} \
2517        -command {if {$repo_config(gui.diffcontext) < 99} {
2518                incr repo_config(gui.diffcontext)
2519                reshow_diff
2520        }}
2521lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2522$ctxm add separator
2523$ctxm add command -label {Options...} \
2524        -command do_options
2525proc popup_diff_menu {ctxm x y X Y} {
2526        global current_diff_path file_states
2527        set ::cursorX $x
2528        set ::cursorY $y
2529        if {$::ui_index eq $::current_diff_side} {
2530                set l "Unstage Hunk From Commit"
2531        } else {
2532                set l "Stage Hunk For Commit"
2533        }
2534        if {$::is_3way_diff
2535                || $current_diff_path eq {}
2536                || ![info exists file_states($current_diff_path)]
2537                || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2538                set s disabled
2539        } else {
2540                set s normal
2541        }
2542        $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2543        tk_popup $ctxm $X $Y
2544}
2545bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2546
2547# -- Status Bar
2548#
2549set main_status [::status_bar::new .status]
2550pack .status -anchor w -side bottom -fill x
2551$main_status show {Initializing...}
2552
2553# -- Load geometry
2554#
2555catch {
2556set gm $repo_config(gui.geometry)
2557wm geometry . [lindex $gm 0]
2558.vpane sash place 0 \
2559        [lindex [.vpane sash coord 0] 0] \
2560        [lindex $gm 1]
2561.vpane.files sash place 0 \
2562        [lindex $gm 2] \
2563        [lindex [.vpane.files sash coord 0] 1]
2564unset gm
2565}
2566
2567# -- Key Bindings
2568#
2569bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2570bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2571bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2572bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2573bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2574bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2575bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2576bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2577bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2578bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2579bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2580
2581bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2582bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2583bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2584bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2585bind $ui_diff <$M1B-Key-v> {break}
2586bind $ui_diff <$M1B-Key-V> {break}
2587bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2588bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2589bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2590bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2591bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2592bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2593bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2594bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2595bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2596bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2597bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2598bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2599bind $ui_diff <Button-1>   {focus %W}
2600
2601if {[is_enabled branch]} {
2602        bind . <$M1B-Key-n> branch_create::dialog
2603        bind . <$M1B-Key-N> branch_create::dialog
2604        bind . <$M1B-Key-o> branch_checkout::dialog
2605        bind . <$M1B-Key-O> branch_checkout::dialog
2606        bind . <$M1B-Key-m> merge::dialog
2607        bind . <$M1B-Key-M> merge::dialog
2608}
2609if {[is_enabled transport]} {
2610        bind . <$M1B-Key-p> do_push_anywhere
2611        bind . <$M1B-Key-P> do_push_anywhere
2612}
2613
2614bind .   <Key-F5>     do_rescan
2615bind .   <$M1B-Key-r> do_rescan
2616bind .   <$M1B-Key-R> do_rescan
2617bind .   <$M1B-Key-s> do_signoff
2618bind .   <$M1B-Key-S> do_signoff
2619bind .   <$M1B-Key-i> do_add_all
2620bind .   <$M1B-Key-I> do_add_all
2621bind .   <$M1B-Key-Return> do_commit
2622foreach i [list $ui_index $ui_workdir] {
2623        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2624        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2625        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2626}
2627unset i
2628
2629set file_lists($ui_index) [list]
2630set file_lists($ui_workdir) [list]
2631
2632wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2633focus -force $ui_comm
2634
2635# -- Warn the user about environmental problems.  Cygwin's Tcl
2636#    does *not* pass its env array onto any processes it spawns.
2637#    This means that git processes get none of our environment.
2638#
2639if {[is_Cygwin]} {
2640        set ignored_env 0
2641        set suggest_user {}
2642        set msg "Possible environment issues exist.
2643
2644The following environment variables are probably
2645going to be ignored by any Git subprocess run
2646by [appname]:
2647
2648"
2649        foreach name [array names env] {
2650                switch -regexp -- $name {
2651                {^GIT_INDEX_FILE$} -
2652                {^GIT_OBJECT_DIRECTORY$} -
2653                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2654                {^GIT_DIFF_OPTS$} -
2655                {^GIT_EXTERNAL_DIFF$} -
2656                {^GIT_PAGER$} -
2657                {^GIT_TRACE$} -
2658                {^GIT_CONFIG$} -
2659                {^GIT_CONFIG_LOCAL$} -
2660                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2661                        append msg " - $name\n"
2662                        incr ignored_env
2663                }
2664                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2665                        append msg " - $name\n"
2666                        incr ignored_env
2667                        set suggest_user $name
2668                }
2669                }
2670        }
2671        if {$ignored_env > 0} {
2672                append msg "
2673This is due to a known issue with the
2674Tcl binary distributed by Cygwin."
2675
2676                if {$suggest_user ne {}} {
2677                        append msg "
2678
2679A good replacement for $suggest_user
2680is placing values for the user.name and
2681user.email settings into your personal
2682~/.gitconfig file.
2683"
2684                }
2685                warn_popup $msg
2686        }
2687        unset ignored_env msg suggest_user name
2688}
2689
2690# -- Only initialize complex UI if we are going to stay running.
2691#
2692if {[is_enabled transport]} {
2693        load_all_remotes
2694
2695        populate_fetch_menu
2696        populate_push_menu
2697}
2698
2699if {[winfo exists $ui_comm]} {
2700        set GITGUI_BCK_exists [load_message GITGUI_BCK]
2701
2702        # -- If both our backup and message files exist use the
2703        #    newer of the two files to initialize the buffer.
2704        #
2705        if {$GITGUI_BCK_exists} {
2706                set m [gitdir GITGUI_MSG]
2707                if {[file isfile $m]} {
2708                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2709                                catch {file delete [gitdir GITGUI_MSG]}
2710                        } else {
2711                                $ui_comm delete 0.0 end
2712                                $ui_comm edit reset
2713                                $ui_comm edit modified false
2714                                catch {file delete [gitdir GITGUI_BCK]}
2715                                set GITGUI_BCK_exists 0
2716                        }
2717                }
2718                unset m
2719        }
2720
2721        proc backup_commit_buffer {} {
2722                global ui_comm GITGUI_BCK_exists
2723
2724                set m [$ui_comm edit modified]
2725                if {$m || $GITGUI_BCK_exists} {
2726                        set msg [string trim [$ui_comm get 0.0 end]]
2727                        regsub -all -line {[ \r\t]+$} $msg {} msg
2728
2729                        if {$msg eq {}} {
2730                                if {$GITGUI_BCK_exists} {
2731                                        catch {file delete [gitdir GITGUI_BCK]}
2732                                        set GITGUI_BCK_exists 0
2733                                }
2734                        } elseif {$m} {
2735                                catch {
2736                                        set fd [open [gitdir GITGUI_BCK] w]
2737                                        puts -nonewline $fd $msg
2738                                        close $fd
2739                                        set GITGUI_BCK_exists 1
2740                                }
2741                        }
2742
2743                        $ui_comm edit modified false
2744                }
2745
2746                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2747        }
2748
2749        backup_commit_buffer
2750}
2751
2752lock_index begin-read
2753if {![winfo ismapped .]} {
2754        wm deiconify .
2755}
2756after 1 do_rescan
2757if {[is_enabled multicommit]} {
2758        after 1000 hint_gc
2759}