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