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