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