559b62be0338b1b39fa73ef0813e436a8e4dc577
   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 {![is_enabled bare]} {
 707        if {[lindex [file split $_gitdir] end] ne {.git}} {
 708                catch {wm withdraw .}
 709                error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 710                exit 1
 711        }
 712        if {[catch {cd [file dirname $_gitdir]} err]} {
 713                catch {wm withdraw .}
 714                error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 715                exit 1
 716        }
 717}
 718set _reponame [file split [file normalize $_gitdir]]
 719if {[lindex $_reponame end] eq {.git}} {
 720        set _reponame [lindex $_reponame end-1]
 721} else {
 722        set _reponame [lindex $_reponame end]
 723}
 724
 725######################################################################
 726##
 727## global init
 728
 729set current_diff_path {}
 730set current_diff_side {}
 731set diff_actions [list]
 732
 733set HEAD {}
 734set PARENT {}
 735set MERGE_HEAD [list]
 736set commit_type {}
 737set empty_tree {}
 738set current_branch {}
 739set is_detached 0
 740set current_diff_path {}
 741set selected_commit_type new
 742
 743######################################################################
 744##
 745## task management
 746
 747set rescan_active 0
 748set diff_active 0
 749set last_clicked {}
 750
 751set disable_on_lock [list]
 752set index_lock_type none
 753
 754proc lock_index {type} {
 755        global index_lock_type disable_on_lock
 756
 757        if {$index_lock_type eq {none}} {
 758                set index_lock_type $type
 759                foreach w $disable_on_lock {
 760                        uplevel #0 $w disabled
 761                }
 762                return 1
 763        } elseif {$index_lock_type eq "begin-$type"} {
 764                set index_lock_type $type
 765                return 1
 766        }
 767        return 0
 768}
 769
 770proc unlock_index {} {
 771        global index_lock_type disable_on_lock
 772
 773        set index_lock_type none
 774        foreach w $disable_on_lock {
 775                uplevel #0 $w normal
 776        }
 777}
 778
 779######################################################################
 780##
 781## status
 782
 783proc repository_state {ctvar hdvar mhvar} {
 784        global current_branch
 785        upvar $ctvar ct $hdvar hd $mhvar mh
 786
 787        set mh [list]
 788
 789        load_current_branch
 790        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 791                set hd {}
 792                set ct initial
 793                return
 794        }
 795
 796        set merge_head [gitdir MERGE_HEAD]
 797        if {[file exists $merge_head]} {
 798                set ct merge
 799                set fd_mh [open $merge_head r]
 800                while {[gets $fd_mh line] >= 0} {
 801                        lappend mh $line
 802                }
 803                close $fd_mh
 804                return
 805        }
 806
 807        set ct normal
 808}
 809
 810proc PARENT {} {
 811        global PARENT empty_tree
 812
 813        set p [lindex $PARENT 0]
 814        if {$p ne {}} {
 815                return $p
 816        }
 817        if {$empty_tree eq {}} {
 818                set empty_tree [git mktree << {}]
 819        }
 820        return $empty_tree
 821}
 822
 823proc rescan {after {honor_trustmtime 1}} {
 824        global HEAD PARENT MERGE_HEAD commit_type
 825        global ui_index ui_workdir ui_comm
 826        global rescan_active file_states
 827        global repo_config
 828
 829        if {$rescan_active > 0 || ![lock_index read]} return
 830
 831        repository_state newType newHEAD newMERGE_HEAD
 832        if {[string match amend* $commit_type]
 833                && $newType eq {normal}
 834                && $newHEAD eq $HEAD} {
 835        } else {
 836                set HEAD $newHEAD
 837                set PARENT $newHEAD
 838                set MERGE_HEAD $newMERGE_HEAD
 839                set commit_type $newType
 840        }
 841
 842        array unset file_states
 843
 844        if {!$::GITGUI_BCK_exists &&
 845                (![$ui_comm edit modified]
 846                || [string trim [$ui_comm get 0.0 end]] eq {})} {
 847                if {[string match amend* $commit_type]} {
 848                } elseif {[load_message GITGUI_MSG]} {
 849                } elseif {[load_message MERGE_MSG]} {
 850                } elseif {[load_message SQUASH_MSG]} {
 851                }
 852                $ui_comm edit reset
 853                $ui_comm edit modified false
 854        }
 855
 856        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 857                rescan_stage2 {} $after
 858        } else {
 859                set rescan_active 1
 860                ui_status {Refreshing file status...}
 861                set fd_rf [git_read update-index \
 862                        -q \
 863                        --unmerged \
 864                        --ignore-missing \
 865                        --refresh \
 866                        ]
 867                fconfigure $fd_rf -blocking 0 -translation binary
 868                fileevent $fd_rf readable \
 869                        [list rescan_stage2 $fd_rf $after]
 870        }
 871}
 872
 873proc rescan_stage2 {fd after} {
 874        global rescan_active buf_rdi buf_rdf buf_rlo
 875
 876        if {$fd ne {}} {
 877                read $fd
 878                if {![eof $fd]} return
 879                close $fd
 880        }
 881
 882        set ls_others [list --exclude-per-directory=.gitignore]
 883        set info_exclude [gitdir info exclude]
 884        if {[file readable $info_exclude]} {
 885                lappend ls_others "--exclude-from=$info_exclude"
 886        }
 887        set user_exclude [get_config core.excludesfile]
 888        if {$user_exclude ne {} && [file readable $user_exclude]} {
 889                lappend ls_others "--exclude-from=$user_exclude"
 890        }
 891
 892        set buf_rdi {}
 893        set buf_rdf {}
 894        set buf_rlo {}
 895
 896        set rescan_active 3
 897        ui_status {Scanning for modified files ...}
 898        set fd_di [git_read diff-index --cached -z [PARENT]]
 899        set fd_df [git_read diff-files -z]
 900        set fd_lo [eval git_read ls-files --others -z $ls_others]
 901
 902        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 903        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 904        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 905        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 906        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 907        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 908}
 909
 910proc load_message {file} {
 911        global ui_comm
 912
 913        set f [gitdir $file]
 914        if {[file isfile $f]} {
 915                if {[catch {set fd [open $f r]}]} {
 916                        return 0
 917                }
 918                fconfigure $fd -eofchar {}
 919                set content [string trim [read $fd]]
 920                close $fd
 921                regsub -all -line {[ \r\t]+$} $content {} content
 922                $ui_comm delete 0.0 end
 923                $ui_comm insert end $content
 924                return 1
 925        }
 926        return 0
 927}
 928
 929proc read_diff_index {fd after} {
 930        global buf_rdi
 931
 932        append buf_rdi [read $fd]
 933        set c 0
 934        set n [string length $buf_rdi]
 935        while {$c < $n} {
 936                set z1 [string first "\0" $buf_rdi $c]
 937                if {$z1 == -1} break
 938                incr z1
 939                set z2 [string first "\0" $buf_rdi $z1]
 940                if {$z2 == -1} break
 941
 942                incr c
 943                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 944                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 945                merge_state \
 946                        [encoding convertfrom $p] \
 947                        [lindex $i 4]? \
 948                        [list [lindex $i 0] [lindex $i 2]] \
 949                        [list]
 950                set c $z2
 951                incr c
 952        }
 953        if {$c < $n} {
 954                set buf_rdi [string range $buf_rdi $c end]
 955        } else {
 956                set buf_rdi {}
 957        }
 958
 959        rescan_done $fd buf_rdi $after
 960}
 961
 962proc read_diff_files {fd after} {
 963        global buf_rdf
 964
 965        append buf_rdf [read $fd]
 966        set c 0
 967        set n [string length $buf_rdf]
 968        while {$c < $n} {
 969                set z1 [string first "\0" $buf_rdf $c]
 970                if {$z1 == -1} break
 971                incr z1
 972                set z2 [string first "\0" $buf_rdf $z1]
 973                if {$z2 == -1} break
 974
 975                incr c
 976                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 977                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 978                merge_state \
 979                        [encoding convertfrom $p] \
 980                        ?[lindex $i 4] \
 981                        [list] \
 982                        [list [lindex $i 0] [lindex $i 2]]
 983                set c $z2
 984                incr c
 985        }
 986        if {$c < $n} {
 987                set buf_rdf [string range $buf_rdf $c end]
 988        } else {
 989                set buf_rdf {}
 990        }
 991
 992        rescan_done $fd buf_rdf $after
 993}
 994
 995proc read_ls_others {fd after} {
 996        global buf_rlo
 997
 998        append buf_rlo [read $fd]
 999        set pck [split $buf_rlo "\0"]
1000        set buf_rlo [lindex $pck end]
1001        foreach p [lrange $pck 0 end-1] {
1002                merge_state [encoding convertfrom $p] ?O
1003        }
1004        rescan_done $fd buf_rlo $after
1005}
1006
1007proc rescan_done {fd buf after} {
1008        global rescan_active current_diff_path
1009        global file_states repo_config
1010        upvar $buf to_clear
1011
1012        if {![eof $fd]} return
1013        set to_clear {}
1014        close $fd
1015        if {[incr rescan_active -1] > 0} return
1016
1017        prune_selection
1018        unlock_index
1019        display_all_files
1020        if {$current_diff_path ne {}} reshow_diff
1021        uplevel #0 $after
1022}
1023
1024proc prune_selection {} {
1025        global file_states selected_paths
1026
1027        foreach path [array names selected_paths] {
1028                if {[catch {set still_here $file_states($path)}]} {
1029                        unset selected_paths($path)
1030                }
1031        }
1032}
1033
1034######################################################################
1035##
1036## ui helpers
1037
1038proc mapicon {w state path} {
1039        global all_icons
1040
1041        if {[catch {set r $all_icons($state$w)}]} {
1042                puts "error: no icon for $w state={$state} $path"
1043                return file_plain
1044        }
1045        return $r
1046}
1047
1048proc mapdesc {state path} {
1049        global all_descs
1050
1051        if {[catch {set r $all_descs($state)}]} {
1052                puts "error: no desc for state={$state} $path"
1053                return $state
1054        }
1055        return $r
1056}
1057
1058proc ui_status {msg} {
1059        $::main_status show $msg
1060}
1061
1062proc ui_ready {{test {}}} {
1063        $::main_status show {Ready.} $test
1064}
1065
1066proc escape_path {path} {
1067        regsub -all {\\} $path "\\\\" path
1068        regsub -all "\n" $path "\\n" path
1069        return $path
1070}
1071
1072proc short_path {path} {
1073        return [escape_path [lindex [file split $path] end]]
1074}
1075
1076set next_icon_id 0
1077set null_sha1 [string repeat 0 40]
1078
1079proc merge_state {path new_state {head_info {}} {index_info {}}} {
1080        global file_states next_icon_id null_sha1
1081
1082        set s0 [string index $new_state 0]
1083        set s1 [string index $new_state 1]
1084
1085        if {[catch {set info $file_states($path)}]} {
1086                set state __
1087                set icon n[incr next_icon_id]
1088        } else {
1089                set state [lindex $info 0]
1090                set icon [lindex $info 1]
1091                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1092                if {$index_info eq {}} {set index_info [lindex $info 3]}
1093        }
1094
1095        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1096        elseif {$s0 eq {_}} {set s0 _}
1097
1098        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1099        elseif {$s1 eq {_}} {set s1 _}
1100
1101        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1102                set head_info [list 0 $null_sha1]
1103        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1104                && $head_info eq {}} {
1105                set head_info $index_info
1106        }
1107
1108        set file_states($path) [list $s0$s1 $icon \
1109                $head_info $index_info \
1110                ]
1111        return $state
1112}
1113
1114proc display_file_helper {w path icon_name old_m new_m} {
1115        global file_lists
1116
1117        if {$new_m eq {_}} {
1118                set lno [lsearch -sorted -exact $file_lists($w) $path]
1119                if {$lno >= 0} {
1120                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1121                        incr lno
1122                        $w conf -state normal
1123                        $w delete $lno.0 [expr {$lno + 1}].0
1124                        $w conf -state disabled
1125                }
1126        } elseif {$old_m eq {_} && $new_m ne {_}} {
1127                lappend file_lists($w) $path
1128                set file_lists($w) [lsort -unique $file_lists($w)]
1129                set lno [lsearch -sorted -exact $file_lists($w) $path]
1130                incr lno
1131                $w conf -state normal
1132                $w image create $lno.0 \
1133                        -align center -padx 5 -pady 1 \
1134                        -name $icon_name \
1135                        -image [mapicon $w $new_m $path]
1136                $w insert $lno.1 "[escape_path $path]\n"
1137                $w conf -state disabled
1138        } elseif {$old_m ne $new_m} {
1139                $w conf -state normal
1140                $w image conf $icon_name -image [mapicon $w $new_m $path]
1141                $w conf -state disabled
1142        }
1143}
1144
1145proc display_file {path state} {
1146        global file_states selected_paths
1147        global ui_index ui_workdir
1148
1149        set old_m [merge_state $path $state]
1150        set s $file_states($path)
1151        set new_m [lindex $s 0]
1152        set icon_name [lindex $s 1]
1153
1154        set o [string index $old_m 0]
1155        set n [string index $new_m 0]
1156        if {$o eq {U}} {
1157                set o _
1158        }
1159        if {$n eq {U}} {
1160                set n _
1161        }
1162        display_file_helper     $ui_index $path $icon_name $o $n
1163
1164        if {[string index $old_m 0] eq {U}} {
1165                set o U
1166        } else {
1167                set o [string index $old_m 1]
1168        }
1169        if {[string index $new_m 0] eq {U}} {
1170                set n U
1171        } else {
1172                set n [string index $new_m 1]
1173        }
1174        display_file_helper     $ui_workdir $path $icon_name $o $n
1175
1176        if {$new_m eq {__}} {
1177                unset file_states($path)
1178                catch {unset selected_paths($path)}
1179        }
1180}
1181
1182proc display_all_files_helper {w path icon_name m} {
1183        global file_lists
1184
1185        lappend file_lists($w) $path
1186        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1187        $w image create end \
1188                -align center -padx 5 -pady 1 \
1189                -name $icon_name \
1190                -image [mapicon $w $m $path]
1191        $w insert end "[escape_path $path]\n"
1192}
1193
1194proc display_all_files {} {
1195        global ui_index ui_workdir
1196        global file_states file_lists
1197        global last_clicked
1198
1199        $ui_index conf -state normal
1200        $ui_workdir conf -state normal
1201
1202        $ui_index delete 0.0 end
1203        $ui_workdir delete 0.0 end
1204        set last_clicked {}
1205
1206        set file_lists($ui_index) [list]
1207        set file_lists($ui_workdir) [list]
1208
1209        foreach path [lsort [array names file_states]] {
1210                set s $file_states($path)
1211                set m [lindex $s 0]
1212                set icon_name [lindex $s 1]
1213
1214                set s [string index $m 0]
1215                if {$s ne {U} && $s ne {_}} {
1216                        display_all_files_helper $ui_index $path \
1217                                $icon_name $s
1218                }
1219
1220                if {[string index $m 0] eq {U}} {
1221                        set s U
1222                } else {
1223                        set s [string index $m 1]
1224                }
1225                if {$s ne {_}} {
1226                        display_all_files_helper $ui_workdir $path \
1227                                $icon_name $s
1228                }
1229        }
1230
1231        $ui_index conf -state disabled
1232        $ui_workdir conf -state disabled
1233}
1234
1235######################################################################
1236##
1237## icons
1238
1239set filemask {
1240#define mask_width 14
1241#define mask_height 15
1242static unsigned char mask_bits[] = {
1243   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1244   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1245   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1246}
1247
1248image create bitmap file_plain -background white -foreground black -data {
1249#define plain_width 14
1250#define plain_height 15
1251static unsigned char plain_bits[] = {
1252   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1253   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1254   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1255} -maskdata $filemask
1256
1257image create bitmap file_mod -background white -foreground blue -data {
1258#define mod_width 14
1259#define mod_height 15
1260static unsigned char mod_bits[] = {
1261   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1262   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1263   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1264} -maskdata $filemask
1265
1266image create bitmap file_fulltick -background white -foreground "#007000" -data {
1267#define file_fulltick_width 14
1268#define file_fulltick_height 15
1269static unsigned char file_fulltick_bits[] = {
1270   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1271   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1272   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1273} -maskdata $filemask
1274
1275image create bitmap file_parttick -background white -foreground "#005050" -data {
1276#define parttick_width 14
1277#define parttick_height 15
1278static unsigned char parttick_bits[] = {
1279   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1280   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1281   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1282} -maskdata $filemask
1283
1284image create bitmap file_question -background white -foreground black -data {
1285#define file_question_width 14
1286#define file_question_height 15
1287static unsigned char file_question_bits[] = {
1288   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1289   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1290   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1291} -maskdata $filemask
1292
1293image create bitmap file_removed -background white -foreground red -data {
1294#define file_removed_width 14
1295#define file_removed_height 15
1296static unsigned char file_removed_bits[] = {
1297   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1298   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1299   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1300} -maskdata $filemask
1301
1302image create bitmap file_merge -background white -foreground blue -data {
1303#define file_merge_width 14
1304#define file_merge_height 15
1305static unsigned char file_merge_bits[] = {
1306   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1307   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1308   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1309} -maskdata $filemask
1310
1311set ui_index .vpane.files.index.list
1312set ui_workdir .vpane.files.workdir.list
1313
1314set all_icons(_$ui_index)   file_plain
1315set all_icons(A$ui_index)   file_fulltick
1316set all_icons(M$ui_index)   file_fulltick
1317set all_icons(D$ui_index)   file_removed
1318set all_icons(U$ui_index)   file_merge
1319
1320set all_icons(_$ui_workdir) file_plain
1321set all_icons(M$ui_workdir) file_mod
1322set all_icons(D$ui_workdir) file_question
1323set all_icons(U$ui_workdir) file_merge
1324set all_icons(O$ui_workdir) file_plain
1325
1326set max_status_desc 0
1327foreach i {
1328                {__ "Unmodified"}
1329
1330                {_M "Modified, not staged"}
1331                {M_ "Staged for commit"}
1332                {MM "Portions staged for commit"}
1333                {MD "Staged for commit, missing"}
1334
1335                {_O "Untracked, not staged"}
1336                {A_ "Staged for commit"}
1337                {AM "Portions staged for commit"}
1338                {AD "Staged for commit, missing"}
1339
1340                {_D "Missing"}
1341                {D_ "Staged for removal"}
1342                {DO "Staged for removal, still present"}
1343
1344                {U_ "Requires merge resolution"}
1345                {UU "Requires merge resolution"}
1346                {UM "Requires merge resolution"}
1347                {UD "Requires merge resolution"}
1348        } {
1349        if {$max_status_desc < [string length [lindex $i 1]]} {
1350                set max_status_desc [string length [lindex $i 1]]
1351        }
1352        set all_descs([lindex $i 0]) [lindex $i 1]
1353}
1354unset i
1355
1356######################################################################
1357##
1358## util
1359
1360proc bind_button3 {w cmd} {
1361        bind $w <Any-Button-3> $cmd
1362        if {[is_MacOSX]} {
1363                # Mac OS X sends Button-2 on right click through three-button mouse,
1364                # or through trackpad right-clicking (two-finger touch + click).
1365                bind $w <Any-Button-2> $cmd
1366                bind $w <Control-Button-1> $cmd
1367        }
1368}
1369
1370proc scrollbar2many {list mode args} {
1371        foreach w $list {eval $w $mode $args}
1372}
1373
1374proc many2scrollbar {list mode sb top bottom} {
1375        $sb set $top $bottom
1376        foreach w $list {$w $mode moveto $top}
1377}
1378
1379proc incr_font_size {font {amt 1}} {
1380        set sz [font configure $font -size]
1381        incr sz $amt
1382        font configure $font -size $sz
1383        font configure ${font}bold -size $sz
1384        font configure ${font}italic -size $sz
1385}
1386
1387######################################################################
1388##
1389## ui commands
1390
1391set starting_gitk_msg {Starting gitk... please wait...}
1392
1393proc do_gitk {revs} {
1394        # -- Always start gitk through whatever we were loaded with.  This
1395        #    lets us bypass using shell process on Windows systems.
1396        #
1397        set exe [file join [file dirname $::_git] gitk]
1398        set cmd [list [info nameofexecutable] $exe]
1399        if {! [file exists $exe]} {
1400                error_popup "Unable to start gitk:\n\n$exe does not exist"
1401        } else {
1402                eval exec $cmd $revs &
1403                ui_status $::starting_gitk_msg
1404                after 10000 {
1405                        ui_ready $starting_gitk_msg
1406                }
1407        }
1408}
1409
1410set is_quitting 0
1411
1412proc do_quit {} {
1413        global ui_comm is_quitting repo_config commit_type
1414        global GITGUI_BCK_exists GITGUI_BCK_i
1415
1416        if {$is_quitting} return
1417        set is_quitting 1
1418
1419        if {[winfo exists $ui_comm]} {
1420                # -- Stash our current commit buffer.
1421                #
1422                set save [gitdir GITGUI_MSG]
1423                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1424                        file rename -force [gitdir GITGUI_BCK] $save
1425                        set GITGUI_BCK_exists 0
1426                } else {
1427                        set msg [string trim [$ui_comm get 0.0 end]]
1428                        regsub -all -line {[ \r\t]+$} $msg {} msg
1429                        if {(![string match amend* $commit_type]
1430                                || [$ui_comm edit modified])
1431                                && $msg ne {}} {
1432                                catch {
1433                                        set fd [open $save w]
1434                                        puts -nonewline $fd $msg
1435                                        close $fd
1436                                }
1437                        } else {
1438                                catch {file delete $save}
1439                        }
1440                }
1441
1442                # -- Remove our editor backup, its not needed.
1443                #
1444                after cancel $GITGUI_BCK_i
1445                if {$GITGUI_BCK_exists} {
1446                        catch {file delete [gitdir GITGUI_BCK]}
1447                }
1448
1449                # -- Stash our current window geometry into this repository.
1450                #
1451                set cfg_geometry [list]
1452                lappend cfg_geometry [wm geometry .]
1453                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1454                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1455                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1456                        set rc_geometry {}
1457                }
1458                if {$cfg_geometry ne $rc_geometry} {
1459                        catch {git config gui.geometry $cfg_geometry}
1460                }
1461        }
1462
1463        destroy .
1464}
1465
1466proc do_rescan {} {
1467        rescan ui_ready
1468}
1469
1470proc do_commit {} {
1471        commit_tree
1472}
1473
1474proc toggle_or_diff {w x y} {
1475        global file_states file_lists current_diff_path ui_index ui_workdir
1476        global last_clicked selected_paths
1477
1478        set pos [split [$w index @$x,$y] .]
1479        set lno [lindex $pos 0]
1480        set col [lindex $pos 1]
1481        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1482        if {$path eq {}} {
1483                set last_clicked {}
1484                return
1485        }
1486
1487        set last_clicked [list $w $lno]
1488        array unset selected_paths
1489        $ui_index tag remove in_sel 0.0 end
1490        $ui_workdir tag remove in_sel 0.0 end
1491
1492        if {$col == 0} {
1493                if {$current_diff_path eq $path} {
1494                        set after {reshow_diff;}
1495                } else {
1496                        set after {}
1497                }
1498                if {$w eq $ui_index} {
1499                        update_indexinfo \
1500                                "Unstaging [short_path $path] from commit" \
1501                                [list $path] \
1502                                [concat $after [list ui_ready]]
1503                } elseif {$w eq $ui_workdir} {
1504                        update_index \
1505                                "Adding [short_path $path]" \
1506                                [list $path] \
1507                                [concat $after [list ui_ready]]
1508                }
1509        } else {
1510                show_diff $path $w $lno
1511        }
1512}
1513
1514proc add_one_to_selection {w x y} {
1515        global file_lists last_clicked selected_paths
1516
1517        set lno [lindex [split [$w index @$x,$y] .] 0]
1518        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1519        if {$path eq {}} {
1520                set last_clicked {}
1521                return
1522        }
1523
1524        if {$last_clicked ne {}
1525                && [lindex $last_clicked 0] ne $w} {
1526                array unset selected_paths
1527                [lindex $last_clicked 0] tag remove in_sel 0.0 end
1528        }
1529
1530        set last_clicked [list $w $lno]
1531        if {[catch {set in_sel $selected_paths($path)}]} {
1532                set in_sel 0
1533        }
1534        if {$in_sel} {
1535                unset selected_paths($path)
1536                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1537        } else {
1538                set selected_paths($path) 1
1539                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1540        }
1541}
1542
1543proc add_range_to_selection {w x y} {
1544        global file_lists last_clicked selected_paths
1545
1546        if {[lindex $last_clicked 0] ne $w} {
1547                toggle_or_diff $w $x $y
1548                return
1549        }
1550
1551        set lno [lindex [split [$w index @$x,$y] .] 0]
1552        set lc [lindex $last_clicked 1]
1553        if {$lc < $lno} {
1554                set begin $lc
1555                set end $lno
1556        } else {
1557                set begin $lno
1558                set end $lc
1559        }
1560
1561        foreach path [lrange $file_lists($w) \
1562                [expr {$begin - 1}] \
1563                [expr {$end - 1}]] {
1564                set selected_paths($path) 1
1565        }
1566        $w tag add in_sel $begin.0 [expr {$end + 1}].0
1567}
1568
1569######################################################################
1570##
1571## config defaults
1572
1573set cursor_ptr arrow
1574font create font_diff -family Courier -size 10
1575font create font_ui
1576catch {
1577        label .dummy
1578        eval font configure font_ui [font actual [.dummy cget -font]]
1579        destroy .dummy
1580}
1581
1582font create font_uiitalic
1583font create font_uibold
1584font create font_diffbold
1585font create font_diffitalic
1586
1587foreach class {Button Checkbutton Entry Label
1588                Labelframe Listbox Menu Message
1589                Radiobutton Spinbox Text} {
1590        option add *$class.font font_ui
1591}
1592unset class
1593
1594if {[is_Windows] || [is_MacOSX]} {
1595        option add *Menu.tearOff 0
1596}
1597
1598if {[is_MacOSX]} {
1599        set M1B M1
1600        set M1T Cmd
1601} else {
1602        set M1B Control
1603        set M1T Ctrl
1604}
1605
1606proc apply_config {} {
1607        global repo_config font_descs
1608
1609        foreach option $font_descs {
1610                set name [lindex $option 0]
1611                set font [lindex $option 1]
1612                if {[catch {
1613                        foreach {cn cv} $repo_config(gui.$name) {
1614                                font configure $font $cn $cv
1615                        }
1616                        } err]} {
1617                        error_popup "Invalid font specified in gui.$name:\n\n$err"
1618                }
1619                foreach {cn cv} [font configure $font] {
1620                        font configure ${font}bold $cn $cv
1621                        font configure ${font}italic $cn $cv
1622                }
1623                font configure ${font}bold -weight bold
1624                font configure ${font}italic -slant italic
1625        }
1626}
1627
1628set default_config(merge.diffstat) true
1629set default_config(merge.summary) false
1630set default_config(merge.verbosity) 2
1631set default_config(user.name) {}
1632set default_config(user.email) {}
1633
1634set default_config(gui.matchtrackingbranch) false
1635set default_config(gui.pruneduringfetch) false
1636set default_config(gui.trustmtime) false
1637set default_config(gui.diffcontext) 5
1638set default_config(gui.newbranchtemplate) {}
1639set default_config(gui.fontui) [font configure font_ui]
1640set default_config(gui.fontdiff) [font configure font_diff]
1641set font_descs {
1642        {fontui   font_ui   {Main Font}}
1643        {fontdiff font_diff {Diff/Console Font}}
1644}
1645load_config 0
1646apply_config
1647
1648######################################################################
1649##
1650## ui construction
1651
1652set ui_comm {}
1653
1654# -- Menu Bar
1655#
1656menu .mbar -tearoff 0
1657.mbar add cascade -label Repository -menu .mbar.repository
1658.mbar add cascade -label Edit -menu .mbar.edit
1659if {[is_enabled branch]} {
1660        .mbar add cascade -label Branch -menu .mbar.branch
1661}
1662if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1663        .mbar add cascade -label Commit -menu .mbar.commit
1664}
1665if {[is_enabled transport]} {
1666        .mbar add cascade -label Merge -menu .mbar.merge
1667        .mbar add cascade -label Fetch -menu .mbar.fetch
1668        .mbar add cascade -label Push -menu .mbar.push
1669}
1670. configure -menu .mbar
1671
1672# -- Repository Menu
1673#
1674menu .mbar.repository
1675
1676.mbar.repository add command \
1677        -label {Browse Current Branch's Files} \
1678        -command {browser::new $current_branch}
1679set ui_browse_current [.mbar.repository index last]
1680.mbar.repository add command \
1681        -label {Browse Branch Files...} \
1682        -command browser_open::dialog
1683.mbar.repository add separator
1684
1685.mbar.repository add command \
1686        -label {Visualize Current Branch's History} \
1687        -command {do_gitk $current_branch}
1688set ui_visualize_current [.mbar.repository index last]
1689.mbar.repository add command \
1690        -label {Visualize All Branch History} \
1691        -command {do_gitk --all}
1692.mbar.repository add separator
1693
1694proc current_branch_write {args} {
1695        global current_branch
1696        .mbar.repository entryconf $::ui_browse_current \
1697                -label "Browse $current_branch's Files"
1698        .mbar.repository entryconf $::ui_visualize_current \
1699                -label "Visualize $current_branch's History"
1700}
1701trace add variable current_branch write current_branch_write
1702
1703if {[is_enabled multicommit]} {
1704        .mbar.repository add command -label {Database Statistics} \
1705                -command do_stats
1706
1707        .mbar.repository add command -label {Compress Database} \
1708                -command do_gc
1709
1710        .mbar.repository add command -label {Verify Database} \
1711                -command do_fsck_objects
1712
1713        .mbar.repository add separator
1714
1715        if {[is_Cygwin]} {
1716                .mbar.repository add command \
1717                        -label {Create Desktop Icon} \
1718                        -command do_cygwin_shortcut
1719        } elseif {[is_Windows]} {
1720                .mbar.repository add command \
1721                        -label {Create Desktop Icon} \
1722                        -command do_windows_shortcut
1723        } elseif {[is_MacOSX]} {
1724                .mbar.repository add command \
1725                        -label {Create Desktop Icon} \
1726                        -command do_macosx_app
1727        }
1728}
1729
1730.mbar.repository add command -label Quit \
1731        -command do_quit \
1732        -accelerator $M1T-Q
1733
1734# -- Edit Menu
1735#
1736menu .mbar.edit
1737.mbar.edit add command -label Undo \
1738        -command {catch {[focus] edit undo}} \
1739        -accelerator $M1T-Z
1740.mbar.edit add command -label Redo \
1741        -command {catch {[focus] edit redo}} \
1742        -accelerator $M1T-Y
1743.mbar.edit add separator
1744.mbar.edit add command -label Cut \
1745        -command {catch {tk_textCut [focus]}} \
1746        -accelerator $M1T-X
1747.mbar.edit add command -label Copy \
1748        -command {catch {tk_textCopy [focus]}} \
1749        -accelerator $M1T-C
1750.mbar.edit add command -label Paste \
1751        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1752        -accelerator $M1T-V
1753.mbar.edit add command -label Delete \
1754        -command {catch {[focus] delete sel.first sel.last}} \
1755        -accelerator Del
1756.mbar.edit add separator
1757.mbar.edit add command -label {Select All} \
1758        -command {catch {[focus] tag add sel 0.0 end}} \
1759        -accelerator $M1T-A
1760
1761# -- Branch Menu
1762#
1763if {[is_enabled branch]} {
1764        menu .mbar.branch
1765
1766        .mbar.branch add command -label {Create...} \
1767                -command branch_create::dialog \
1768                -accelerator $M1T-N
1769        lappend disable_on_lock [list .mbar.branch entryconf \
1770                [.mbar.branch index last] -state]
1771
1772        .mbar.branch add command -label {Checkout...} \
1773                -command branch_checkout::dialog \
1774                -accelerator $M1T-O
1775        lappend disable_on_lock [list .mbar.branch entryconf \
1776                [.mbar.branch index last] -state]
1777
1778        .mbar.branch add command -label {Rename...} \
1779                -command branch_rename::dialog
1780        lappend disable_on_lock [list .mbar.branch entryconf \
1781                [.mbar.branch index last] -state]
1782
1783        .mbar.branch add command -label {Delete...} \
1784                -command branch_delete::dialog
1785        lappend disable_on_lock [list .mbar.branch entryconf \
1786                [.mbar.branch index last] -state]
1787
1788        .mbar.branch add command -label {Reset...} \
1789                -command merge::reset_hard
1790        lappend disable_on_lock [list .mbar.branch entryconf \
1791                [.mbar.branch index last] -state]
1792}
1793
1794# -- Commit Menu
1795#
1796if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1797        menu .mbar.commit
1798
1799        .mbar.commit add radiobutton \
1800                -label {New Commit} \
1801                -command do_select_commit_type \
1802                -variable selected_commit_type \
1803                -value new
1804        lappend disable_on_lock \
1805                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1806
1807        .mbar.commit add radiobutton \
1808                -label {Amend Last Commit} \
1809                -command do_select_commit_type \
1810                -variable selected_commit_type \
1811                -value amend
1812        lappend disable_on_lock \
1813                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1814
1815        .mbar.commit add separator
1816
1817        .mbar.commit add command -label Rescan \
1818                -command do_rescan \
1819                -accelerator F5
1820        lappend disable_on_lock \
1821                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1822
1823        .mbar.commit add command -label {Stage To Commit} \
1824                -command do_add_selection
1825        lappend disable_on_lock \
1826                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1827
1828        .mbar.commit add command -label {Stage Changed Files To Commit} \
1829                -command do_add_all \
1830                -accelerator $M1T-I
1831        lappend disable_on_lock \
1832                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1833
1834        .mbar.commit add command -label {Unstage From Commit} \
1835                -command do_unstage_selection
1836        lappend disable_on_lock \
1837                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1838
1839        .mbar.commit add command -label {Revert Changes} \
1840                -command do_revert_selection
1841        lappend disable_on_lock \
1842                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1843
1844        .mbar.commit add separator
1845
1846        .mbar.commit add command -label {Sign Off} \
1847                -command do_signoff \
1848                -accelerator $M1T-S
1849
1850        .mbar.commit add command -label Commit \
1851                -command do_commit \
1852                -accelerator $M1T-Return
1853        lappend disable_on_lock \
1854                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1855}
1856
1857# -- Merge Menu
1858#
1859if {[is_enabled branch]} {
1860        menu .mbar.merge
1861        .mbar.merge add command -label {Local Merge...} \
1862                -command merge::dialog \
1863                -accelerator $M1T-M
1864        lappend disable_on_lock \
1865                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1866        .mbar.merge add command -label {Abort Merge...} \
1867                -command merge::reset_hard
1868        lappend disable_on_lock \
1869                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1870}
1871
1872# -- Transport Menu
1873#
1874if {[is_enabled transport]} {
1875        menu .mbar.fetch
1876
1877        menu .mbar.push
1878        .mbar.push add command -label {Push...} \
1879                -command do_push_anywhere \
1880                -accelerator $M1T-P
1881        .mbar.push add command -label {Delete...} \
1882                -command remote_branch_delete::dialog
1883}
1884
1885if {[is_MacOSX]} {
1886        # -- Apple Menu (Mac OS X only)
1887        #
1888        .mbar add cascade -label Apple -menu .mbar.apple
1889        menu .mbar.apple
1890
1891        .mbar.apple add command -label "About [appname]" \
1892                -command do_about
1893        .mbar.apple add command -label "Options..." \
1894                -command do_options
1895} else {
1896        # -- Edit Menu
1897        #
1898        .mbar.edit add separator
1899        .mbar.edit add command -label {Options...} \
1900                -command do_options
1901}
1902
1903# -- Help Menu
1904#
1905.mbar add cascade -label Help -menu .mbar.help
1906menu .mbar.help
1907
1908if {![is_MacOSX]} {
1909        .mbar.help add command -label "About [appname]" \
1910                -command do_about
1911}
1912
1913set browser {}
1914catch {set browser $repo_config(instaweb.browser)}
1915set doc_path [file dirname [gitexec]]
1916set doc_path [file join $doc_path Documentation index.html]
1917
1918if {[is_Cygwin]} {
1919        set doc_path [exec cygpath --mixed $doc_path]
1920}
1921
1922if {$browser eq {}} {
1923        if {[is_MacOSX]} {
1924                set browser open
1925        } elseif {[is_Cygwin]} {
1926                set program_files [file dirname [exec cygpath --windir]]
1927                set program_files [file join $program_files {Program Files}]
1928                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1929                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1930                if {[file exists $firefox]} {
1931                        set browser $firefox
1932                } elseif {[file exists $ie]} {
1933                        set browser $ie
1934                }
1935                unset program_files firefox ie
1936        }
1937}
1938
1939if {[file isfile $doc_path]} {
1940        set doc_url "file:$doc_path"
1941} else {
1942        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1943}
1944
1945if {$browser ne {}} {
1946        .mbar.help add command -label {Online Documentation} \
1947                -command [list exec $browser $doc_url &]
1948}
1949unset browser doc_path doc_url
1950
1951set root_exists 0
1952bind . <Visibility> {
1953        bind . <Visibility> {}
1954        set root_exists 1
1955}
1956
1957# -- Standard bindings
1958#
1959wm protocol . WM_DELETE_WINDOW do_quit
1960bind all <$M1B-Key-q> do_quit
1961bind all <$M1B-Key-Q> do_quit
1962bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1963bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1964
1965set subcommand_args {}
1966proc usage {} {
1967        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1968        exit 1
1969}
1970
1971# -- Not a normal commit type invocation?  Do that instead!
1972#
1973switch -- $subcommand {
1974browser -
1975blame {
1976        set subcommand_args {rev? path}
1977        if {$argv eq {}} usage
1978        set head {}
1979        set path {}
1980        set is_path 0
1981        foreach a $argv {
1982                if {$is_path || [file exists $_prefix$a]} {
1983                        if {$path ne {}} usage
1984                        set path $_prefix$a
1985                        break
1986                } elseif {$a eq {--}} {
1987                        if {$path ne {}} {
1988                                if {$head ne {}} usage
1989                                set head $path
1990                                set path {}
1991                        }
1992                        set is_path 1
1993                } elseif {$head eq {}} {
1994                        if {$head ne {}} usage
1995                        set head $a
1996                        set is_path 1
1997                } else {
1998                        usage
1999                }
2000        }
2001        unset is_path
2002
2003        if {$head ne {} && $path eq {}} {
2004                set path $_prefix$head
2005                set head {}
2006        }
2007
2008        if {$head eq {}} {
2009                load_current_branch
2010        } else {
2011                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2012                        if {[catch {
2013                                        set head [git rev-parse --verify $head]
2014                                } err]} {
2015                                puts stderr $err
2016                                exit 1
2017                        }
2018                }
2019                set current_branch $head
2020        }
2021
2022        switch -- $subcommand {
2023        browser {
2024                if {$head eq {}} {
2025                        if {$path ne {} && [file isdirectory $path]} {
2026                                set head $current_branch
2027                        } else {
2028                                set head $path
2029                                set path {}
2030                        }
2031                }
2032                browser::new $head $path
2033        }
2034        blame   {
2035                if {$head eq {} && ![file exists $path]} {
2036                        puts stderr "fatal: cannot stat path $path: No such file or directory"
2037                        exit 1
2038                }
2039                blame::new $head $path
2040        }
2041        }
2042        return
2043}
2044citool -
2045gui {
2046        if {[llength $argv] != 0} {
2047                puts -nonewline stderr "usage: $argv0"
2048                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2049                        puts -nonewline stderr " $subcommand"
2050                }
2051                puts stderr {}
2052                exit 1
2053        }
2054        # fall through to setup UI for commits
2055}
2056default {
2057        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2058        exit 1
2059}
2060}
2061
2062# -- Branch Control
2063#
2064frame .branch \
2065        -borderwidth 1 \
2066        -relief sunken
2067label .branch.l1 \
2068        -text {Current Branch:} \
2069        -anchor w \
2070        -justify left
2071label .branch.cb \
2072        -textvariable current_branch \
2073        -anchor w \
2074        -justify left
2075pack .branch.l1 -side left
2076pack .branch.cb -side left -fill x
2077pack .branch -side top -fill x
2078
2079# -- Main Window Layout
2080#
2081panedwindow .vpane -orient vertical
2082panedwindow .vpane.files -orient horizontal
2083.vpane add .vpane.files -sticky nsew -height 100 -width 200
2084pack .vpane -anchor n -side top -fill both -expand 1
2085
2086# -- Index File List
2087#
2088frame .vpane.files.index -height 100 -width 200
2089label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2090        -background lightgreen
2091text $ui_index -background white -borderwidth 0 \
2092        -width 20 -height 10 \
2093        -wrap none \
2094        -cursor $cursor_ptr \
2095        -xscrollcommand {.vpane.files.index.sx set} \
2096        -yscrollcommand {.vpane.files.index.sy set} \
2097        -state disabled
2098scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2099scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2100pack .vpane.files.index.title -side top -fill x
2101pack .vpane.files.index.sx -side bottom -fill x
2102pack .vpane.files.index.sy -side right -fill y
2103pack $ui_index -side left -fill both -expand 1
2104.vpane.files add .vpane.files.index -sticky nsew
2105
2106# -- Working Directory File List
2107#
2108frame .vpane.files.workdir -height 100 -width 200
2109label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2110        -background lightsalmon
2111text $ui_workdir -background white -borderwidth 0 \
2112        -width 20 -height 10 \
2113        -wrap none \
2114        -cursor $cursor_ptr \
2115        -xscrollcommand {.vpane.files.workdir.sx set} \
2116        -yscrollcommand {.vpane.files.workdir.sy set} \
2117        -state disabled
2118scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2119scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2120pack .vpane.files.workdir.title -side top -fill x
2121pack .vpane.files.workdir.sx -side bottom -fill x
2122pack .vpane.files.workdir.sy -side right -fill y
2123pack $ui_workdir -side left -fill both -expand 1
2124.vpane.files add .vpane.files.workdir -sticky nsew
2125
2126foreach i [list $ui_index $ui_workdir] {
2127        $i tag conf in_diff -background lightgray
2128        $i tag conf in_sel  -background lightgray
2129}
2130unset i
2131
2132# -- Diff and Commit Area
2133#
2134frame .vpane.lower -height 300 -width 400
2135frame .vpane.lower.commarea
2136frame .vpane.lower.diff -relief sunken -borderwidth 1
2137pack .vpane.lower.commarea -side top -fill x
2138pack .vpane.lower.diff -side bottom -fill both -expand 1
2139.vpane add .vpane.lower -sticky nsew
2140
2141# -- Commit Area Buttons
2142#
2143frame .vpane.lower.commarea.buttons
2144label .vpane.lower.commarea.buttons.l -text {} \
2145        -anchor w \
2146        -justify left
2147pack .vpane.lower.commarea.buttons.l -side top -fill x
2148pack .vpane.lower.commarea.buttons -side left -fill y
2149
2150button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2151        -command do_rescan
2152pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2153lappend disable_on_lock \
2154        {.vpane.lower.commarea.buttons.rescan conf -state}
2155
2156button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2157        -command do_add_all
2158pack .vpane.lower.commarea.buttons.incall -side top -fill x
2159lappend disable_on_lock \
2160        {.vpane.lower.commarea.buttons.incall conf -state}
2161
2162button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2163        -command do_signoff
2164pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2165
2166button .vpane.lower.commarea.buttons.commit -text {Commit} \
2167        -command do_commit
2168pack .vpane.lower.commarea.buttons.commit -side top -fill x
2169lappend disable_on_lock \
2170        {.vpane.lower.commarea.buttons.commit conf -state}
2171
2172button .vpane.lower.commarea.buttons.push -text {Push} \
2173        -command do_push_anywhere
2174pack .vpane.lower.commarea.buttons.push -side top -fill x
2175
2176# -- Commit Message Buffer
2177#
2178frame .vpane.lower.commarea.buffer
2179frame .vpane.lower.commarea.buffer.header
2180set ui_comm .vpane.lower.commarea.buffer.t
2181set ui_coml .vpane.lower.commarea.buffer.header.l
2182radiobutton .vpane.lower.commarea.buffer.header.new \
2183        -text {New Commit} \
2184        -command do_select_commit_type \
2185        -variable selected_commit_type \
2186        -value new
2187lappend disable_on_lock \
2188        [list .vpane.lower.commarea.buffer.header.new conf -state]
2189radiobutton .vpane.lower.commarea.buffer.header.amend \
2190        -text {Amend Last Commit} \
2191        -command do_select_commit_type \
2192        -variable selected_commit_type \
2193        -value amend
2194lappend disable_on_lock \
2195        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2196label $ui_coml \
2197        -anchor w \
2198        -justify left
2199proc trace_commit_type {varname args} {
2200        global ui_coml commit_type
2201        switch -glob -- $commit_type {
2202        initial       {set txt {Initial Commit Message:}}
2203        amend         {set txt {Amended Commit Message:}}
2204        amend-initial {set txt {Amended Initial Commit Message:}}
2205        amend-merge   {set txt {Amended Merge Commit Message:}}
2206        merge         {set txt {Merge Commit Message:}}
2207        *             {set txt {Commit Message:}}
2208        }
2209        $ui_coml conf -text $txt
2210}
2211trace add variable commit_type write trace_commit_type
2212pack $ui_coml -side left -fill x
2213pack .vpane.lower.commarea.buffer.header.amend -side right
2214pack .vpane.lower.commarea.buffer.header.new -side right
2215
2216text $ui_comm -background white -borderwidth 1 \
2217        -undo true \
2218        -maxundo 20 \
2219        -autoseparators true \
2220        -relief sunken \
2221        -width 75 -height 9 -wrap none \
2222        -font font_diff \
2223        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2224scrollbar .vpane.lower.commarea.buffer.sby \
2225        -command [list $ui_comm yview]
2226pack .vpane.lower.commarea.buffer.header -side top -fill x
2227pack .vpane.lower.commarea.buffer.sby -side right -fill y
2228pack $ui_comm -side left -fill y
2229pack .vpane.lower.commarea.buffer -side left -fill y
2230
2231# -- Commit Message Buffer Context Menu
2232#
2233set ctxm .vpane.lower.commarea.buffer.ctxm
2234menu $ctxm -tearoff 0
2235$ctxm add command \
2236        -label {Cut} \
2237        -command {tk_textCut $ui_comm}
2238$ctxm add command \
2239        -label {Copy} \
2240        -command {tk_textCopy $ui_comm}
2241$ctxm add command \
2242        -label {Paste} \
2243        -command {tk_textPaste $ui_comm}
2244$ctxm add command \
2245        -label {Delete} \
2246        -command {$ui_comm delete sel.first sel.last}
2247$ctxm add separator
2248$ctxm add command \
2249        -label {Select All} \
2250        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2251$ctxm add command \
2252        -label {Copy All} \
2253        -command {
2254                $ui_comm tag add sel 0.0 end
2255                tk_textCopy $ui_comm
2256                $ui_comm tag remove sel 0.0 end
2257        }
2258$ctxm add separator
2259$ctxm add command \
2260        -label {Sign Off} \
2261        -command do_signoff
2262bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2263
2264# -- Diff Header
2265#
2266proc trace_current_diff_path {varname args} {
2267        global current_diff_path diff_actions file_states
2268        if {$current_diff_path eq {}} {
2269                set s {}
2270                set f {}
2271                set p {}
2272                set o disabled
2273        } else {
2274                set p $current_diff_path
2275                set s [mapdesc [lindex $file_states($p) 0] $p]
2276                set f {File:}
2277                set p [escape_path $p]
2278                set o normal
2279        }
2280
2281        .vpane.lower.diff.header.status configure -text $s
2282        .vpane.lower.diff.header.file configure -text $f
2283        .vpane.lower.diff.header.path configure -text $p
2284        foreach w $diff_actions {
2285                uplevel #0 $w $o
2286        }
2287}
2288trace add variable current_diff_path write trace_current_diff_path
2289
2290frame .vpane.lower.diff.header -background gold
2291label .vpane.lower.diff.header.status \
2292        -background gold \
2293        -width $max_status_desc \
2294        -anchor w \
2295        -justify left
2296label .vpane.lower.diff.header.file \
2297        -background gold \
2298        -anchor w \
2299        -justify left
2300label .vpane.lower.diff.header.path \
2301        -background gold \
2302        -anchor w \
2303        -justify left
2304pack .vpane.lower.diff.header.status -side left
2305pack .vpane.lower.diff.header.file -side left
2306pack .vpane.lower.diff.header.path -fill x
2307set ctxm .vpane.lower.diff.header.ctxm
2308menu $ctxm -tearoff 0
2309$ctxm add command \
2310        -label {Copy} \
2311        -command {
2312                clipboard clear
2313                clipboard append \
2314                        -format STRING \
2315                        -type STRING \
2316                        -- $current_diff_path
2317        }
2318lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2319bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2320
2321# -- Diff Body
2322#
2323frame .vpane.lower.diff.body
2324set ui_diff .vpane.lower.diff.body.t
2325text $ui_diff -background white -borderwidth 0 \
2326        -width 80 -height 15 -wrap none \
2327        -font font_diff \
2328        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2329        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2330        -state disabled
2331scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2332        -command [list $ui_diff xview]
2333scrollbar .vpane.lower.diff.body.sby -orient vertical \
2334        -command [list $ui_diff yview]
2335pack .vpane.lower.diff.body.sbx -side bottom -fill x
2336pack .vpane.lower.diff.body.sby -side right -fill y
2337pack $ui_diff -side left -fill both -expand 1
2338pack .vpane.lower.diff.header -side top -fill x
2339pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2340
2341$ui_diff tag conf d_cr -elide true
2342$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2343$ui_diff tag conf d_+ -foreground {#00a000}
2344$ui_diff tag conf d_- -foreground red
2345
2346$ui_diff tag conf d_++ -foreground {#00a000}
2347$ui_diff tag conf d_-- -foreground red
2348$ui_diff tag conf d_+s \
2349        -foreground {#00a000} \
2350        -background {#e2effa}
2351$ui_diff tag conf d_-s \
2352        -foreground red \
2353        -background {#e2effa}
2354$ui_diff tag conf d_s+ \
2355        -foreground {#00a000} \
2356        -background ivory1
2357$ui_diff tag conf d_s- \
2358        -foreground red \
2359        -background ivory1
2360
2361$ui_diff tag conf d<<<<<<< \
2362        -foreground orange \
2363        -font font_diffbold
2364$ui_diff tag conf d======= \
2365        -foreground orange \
2366        -font font_diffbold
2367$ui_diff tag conf d>>>>>>> \
2368        -foreground orange \
2369        -font font_diffbold
2370
2371$ui_diff tag raise sel
2372
2373# -- Diff Body Context Menu
2374#
2375set ctxm .vpane.lower.diff.body.ctxm
2376menu $ctxm -tearoff 0
2377$ctxm add command \
2378        -label {Refresh} \
2379        -command reshow_diff
2380lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2381$ctxm add command \
2382        -label {Copy} \
2383        -command {tk_textCopy $ui_diff}
2384lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2385$ctxm add command \
2386        -label {Select All} \
2387        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2388lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2389$ctxm add command \
2390        -label {Copy All} \
2391        -command {
2392                $ui_diff tag add sel 0.0 end
2393                tk_textCopy $ui_diff
2394                $ui_diff tag remove sel 0.0 end
2395        }
2396lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2397$ctxm add separator
2398$ctxm add command \
2399        -label {Apply/Reverse Hunk} \
2400        -command {apply_hunk $cursorX $cursorY}
2401set ui_diff_applyhunk [$ctxm index last]
2402lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2403$ctxm add separator
2404$ctxm add command \
2405        -label {Decrease Font Size} \
2406        -command {incr_font_size font_diff -1}
2407lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2408$ctxm add command \
2409        -label {Increase Font Size} \
2410        -command {incr_font_size font_diff 1}
2411lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2412$ctxm add separator
2413$ctxm add command \
2414        -label {Show Less Context} \
2415        -command {if {$repo_config(gui.diffcontext) >= 1} {
2416                incr repo_config(gui.diffcontext) -1
2417                reshow_diff
2418        }}
2419lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2420$ctxm add command \
2421        -label {Show More Context} \
2422        -command {if {$repo_config(gui.diffcontext) < 99} {
2423                incr repo_config(gui.diffcontext)
2424                reshow_diff
2425        }}
2426lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2427$ctxm add separator
2428$ctxm add command -label {Options...} \
2429        -command do_options
2430proc popup_diff_menu {ctxm x y X Y} {
2431        global current_diff_path file_states
2432        set ::cursorX $x
2433        set ::cursorY $y
2434        if {$::ui_index eq $::current_diff_side} {
2435                set s normal
2436                set l "Unstage Hunk From Commit"
2437        } else {
2438                if {$current_diff_path eq {}
2439                        || ![info exists file_states($current_diff_path)]
2440                        || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2441                        set s disabled
2442                } else {
2443                        set s normal
2444                }
2445                set l "Stage Hunk For Commit"
2446        }
2447        $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2448        tk_popup $ctxm $X $Y
2449}
2450bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2451
2452# -- Status Bar
2453#
2454set main_status [::status_bar::new .status]
2455pack .status -anchor w -side bottom -fill x
2456$main_status show {Initializing...}
2457
2458# -- Load geometry
2459#
2460catch {
2461set gm $repo_config(gui.geometry)
2462wm geometry . [lindex $gm 0]
2463.vpane sash place 0 \
2464        [lindex [.vpane sash coord 0] 0] \
2465        [lindex $gm 1]
2466.vpane.files sash place 0 \
2467        [lindex $gm 2] \
2468        [lindex [.vpane.files sash coord 0] 1]
2469unset gm
2470}
2471
2472# -- Key Bindings
2473#
2474bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2475bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2476bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2477bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2478bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2479bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2480bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2481bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2482bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2483bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2484bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2485
2486bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2487bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2488bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2489bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2490bind $ui_diff <$M1B-Key-v> {break}
2491bind $ui_diff <$M1B-Key-V> {break}
2492bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2493bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2494bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2495bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2496bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2497bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2498bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2499bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2500bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2501bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2502bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2503bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2504bind $ui_diff <Button-1>   {focus %W}
2505
2506if {[is_enabled branch]} {
2507        bind . <$M1B-Key-n> branch_create::dialog
2508        bind . <$M1B-Key-N> branch_create::dialog
2509        bind . <$M1B-Key-o> branch_checkout::dialog
2510        bind . <$M1B-Key-O> branch_checkout::dialog
2511        bind . <$M1B-Key-m> merge::dialog
2512        bind . <$M1B-Key-M> merge::dialog
2513}
2514if {[is_enabled transport]} {
2515        bind . <$M1B-Key-p> do_push_anywhere
2516        bind . <$M1B-Key-P> do_push_anywhere
2517}
2518
2519bind .   <Key-F5>     do_rescan
2520bind .   <$M1B-Key-r> do_rescan
2521bind .   <$M1B-Key-R> do_rescan
2522bind .   <$M1B-Key-s> do_signoff
2523bind .   <$M1B-Key-S> do_signoff
2524bind .   <$M1B-Key-i> do_add_all
2525bind .   <$M1B-Key-I> do_add_all
2526bind .   <$M1B-Key-Return> do_commit
2527foreach i [list $ui_index $ui_workdir] {
2528        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2529        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2530        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2531}
2532unset i
2533
2534set file_lists($ui_index) [list]
2535set file_lists($ui_workdir) [list]
2536
2537wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2538focus -force $ui_comm
2539
2540# -- Warn the user about environmental problems.  Cygwin's Tcl
2541#    does *not* pass its env array onto any processes it spawns.
2542#    This means that git processes get none of our environment.
2543#
2544if {[is_Cygwin]} {
2545        set ignored_env 0
2546        set suggest_user {}
2547        set msg "Possible environment issues exist.
2548
2549The following environment variables are probably
2550going to be ignored by any Git subprocess run
2551by [appname]:
2552
2553"
2554        foreach name [array names env] {
2555                switch -regexp -- $name {
2556                {^GIT_INDEX_FILE$} -
2557                {^GIT_OBJECT_DIRECTORY$} -
2558                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2559                {^GIT_DIFF_OPTS$} -
2560                {^GIT_EXTERNAL_DIFF$} -
2561                {^GIT_PAGER$} -
2562                {^GIT_TRACE$} -
2563                {^GIT_CONFIG$} -
2564                {^GIT_CONFIG_LOCAL$} -
2565                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2566                        append msg " - $name\n"
2567                        incr ignored_env
2568                }
2569                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2570                        append msg " - $name\n"
2571                        incr ignored_env
2572                        set suggest_user $name
2573                }
2574                }
2575        }
2576        if {$ignored_env > 0} {
2577                append msg "
2578This is due to a known issue with the
2579Tcl binary distributed by Cygwin."
2580
2581                if {$suggest_user ne {}} {
2582                        append msg "
2583
2584A good replacement for $suggest_user
2585is placing values for the user.name and
2586user.email settings into your personal
2587~/.gitconfig file.
2588"
2589                }
2590                warn_popup $msg
2591        }
2592        unset ignored_env msg suggest_user name
2593}
2594
2595# -- Only initialize complex UI if we are going to stay running.
2596#
2597if {[is_enabled transport]} {
2598        load_all_remotes
2599
2600        populate_fetch_menu
2601        populate_push_menu
2602}
2603
2604if {[winfo exists $ui_comm]} {
2605        set GITGUI_BCK_exists [load_message GITGUI_BCK]
2606
2607        # -- If both our backup and message files exist use the
2608        #    newer of the two files to initialize the buffer.
2609        #
2610        if {$GITGUI_BCK_exists} {
2611                set m [gitdir GITGUI_MSG]
2612                if {[file isfile $m]} {
2613                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2614                                catch {file delete [gitdir GITGUI_MSG]}
2615                        } else {
2616                                $ui_comm delete 0.0 end
2617                                $ui_comm edit reset
2618                                $ui_comm edit modified false
2619                                catch {file delete [gitdir GITGUI_BCK]}
2620                                set GITGUI_BCK_exists 0
2621                        }
2622                }
2623                unset m
2624        }
2625
2626        proc backup_commit_buffer {} {
2627                global ui_comm GITGUI_BCK_exists
2628
2629                set m [$ui_comm edit modified]
2630                if {$m || $GITGUI_BCK_exists} {
2631                        set msg [string trim [$ui_comm get 0.0 end]]
2632                        regsub -all -line {[ \r\t]+$} $msg {} msg
2633
2634                        if {$msg eq {}} {
2635                                if {$GITGUI_BCK_exists} {
2636                                        catch {file delete [gitdir GITGUI_BCK]}
2637                                        set GITGUI_BCK_exists 0
2638                                }
2639                        } elseif {$m} {
2640                                catch {
2641                                        set fd [open [gitdir GITGUI_BCK] w]
2642                                        puts -nonewline $fd $msg
2643                                        close $fd
2644                                        set GITGUI_BCK_exists 1
2645                                }
2646                        }
2647
2648                        $ui_comm edit modified false
2649                }
2650
2651                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2652        }
2653
2654        backup_commit_buffer
2655}
2656
2657lock_index begin-read
2658if {![winfo ismapped .]} {
2659        wm deiconify .
2660}
2661after 1 do_rescan
2662if {[is_enabled multicommit]} {
2663        after 1000 hint_gc
2664}