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