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