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