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