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