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