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