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