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