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