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 argv0=$0; \
  10 exec wish "$argv0" -- "$@"
  11set appvers {@@GITGUI_VERSION@@}
  13set copyright [encoding convertfrom utf-8 {
  14Copyright © 2006, 2007 Shawn Pearce, et. al.
  15This program is free software; you can redistribute it and/or modify
  17it under the terms of the GNU General Public License as published by
  18the Free Software Foundation; either version 2 of the License, or
  19(at your option) any later version.
  20This program is distributed in the hope that it will be useful,
  22but WITHOUT ANY WARRANTY; without even the implied warranty of
  23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24GNU General Public License for more details.
  25You should have received a copy of the GNU General Public License
  27along with this program; if not, write to the Free Software
  28Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}]
  29######################################################################
  31##
  32## Tcl/Tk sanity check
  33if {[catch {package require Tcl 8.4} err]
  35 || [catch {package require Tk  8.4} err]
  36} {
  37        catch {wm withdraw .}
  38        tk_messageBox \
  39                -icon error \
  40                -type ok \
  41                -title [mc "git-gui: fatal error"] \
  42                -message $err
  43        exit 1
  44}
  45catch {rename send {}} ; # What an evil concept...
  47######################################################################
  49##
  50## locate our library
  51set oguilib {@@GITGUI_LIBDIR@@}
  53set oguirel {@@GITGUI_RELATIVE@@}
  54if {$oguirel eq {1}} {
  55        set oguilib [file dirname [file normalize $argv0]]
  56        if {[file tail $oguilib] eq {git-core}} {
  57                set oguilib [file dirname $oguilib]
  58        }
  59        set oguilib [file dirname $oguilib]
  60        set oguilib [file join $oguilib share git-gui lib]
  61        set oguimsg [file join $oguilib msgs]
  62} elseif {[string match @@* $oguirel]} {
  63        set oguilib [file join [file dirname [file normalize $argv0]] lib]
  64        set oguimsg [file join [file dirname [file normalize $argv0]] po]
  65} else {
  66        set oguimsg [file join $oguilib msgs]
  67}
  68unset oguirel
  69######################################################################
  71##
  72## enable verbose loading?
  73if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  75        unset _verbose
  76        rename auto_load real__auto_load
  77        proc auto_load {name args} {
  78                puts stderr "auto_load $name"
  79                return [uplevel 1 real__auto_load $name $args]
  80        }
  81        rename source real__source
  82        proc source {name} {
  83                puts stderr "source    $name"
  84                uplevel 1 real__source $name
  85        }
  86}
  87######################################################################
  89##
  90## Internationalization (i18n) through msgcat and gettext. See
  91## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  92package require msgcat
  94proc _mc_trim {fmt} {
  96        set cmk [string first @@ $fmt]
  97        if {$cmk > 0} {
  98                return [string range $fmt 0 [expr {$cmk - 1}]]
  99        }
 100        return $fmt
 101}
 102proc mc {en_fmt args} {
 104        set fmt [_mc_trim [::msgcat::mc $en_fmt]]
 105        if {[catch {set msg [eval [list format $fmt] $args]} err]} {
 106                set msg [eval [list format [_mc_trim $en_fmt]] $args]
 107        }
 108        return $msg
 109}
 110proc strcat {args} {
 112        return [join $args {}]
 113}
 114::msgcat::mcload $oguimsg
 116unset oguimsg
 117######################################################################
 119##
 120## read only globals
 121set _appname {Git Gui}
 123set _gitdir {}
 124set _gitexec {}
 125set _githtmldir {}
 126set _reponame {}
 127set _iscygwin {}
 128set _search_path {}
 129set _trace [lsearch -exact $argv --trace]
 131if {$_trace >= 0} {
 132        set argv [lreplace $argv $_trace $_trace]
 133        set _trace 1
 134} else {
 135        set _trace 0
 136}
 137proc appname {} {
 139        global _appname
 140        return $_appname
 141}
 142proc gitdir {args} {
 144        global _gitdir
 145        if {$args eq {}} {
 146                return $_gitdir
 147        }
 148        return [eval [list file join $_gitdir] $args]
 149}
 150proc gitexec {args} {
 152        global _gitexec
 153        if {$_gitexec eq {}} {
 154                if {[catch {set _gitexec [git --exec-path]} err]} {
 155                        error "Git not installed?\n\n$err"
 156                }
 157                if {[is_Cygwin]} {
 158                        set _gitexec [exec cygpath \
 159                                --windows \
 160                                --absolute \
 161                                $_gitexec]
 162                } else {
 163                        set _gitexec [file normalize $_gitexec]
 164                }
 165        }
 166        if {$args eq {}} {
 167                return $_gitexec
 168        }
 169        return [eval [list file join $_gitexec] $args]
 170}
 171proc githtmldir {args} {
 173        global _githtmldir
 174        if {$_githtmldir eq {}} {
 175                if {[catch {set _githtmldir [git --html-path]}]} {
 176                        # Git not installed or option not yet supported
 177                        return {}
 178                }
 179                if {[is_Cygwin]} {
 180                        set _githtmldir [exec cygpath \
 181                                --windows \
 182                                --absolute \
 183                                $_githtmldir]
 184                } else {
 185                        set _githtmldir [file normalize $_githtmldir]
 186                }
 187        }
 188        if {$args eq {}} {
 189                return $_githtmldir
 190        }
 191        return [eval [list file join $_githtmldir] $args]
 192}
 193proc reponame {} {
 195        return $::_reponame
 196}
 197proc is_MacOSX {} {
 199        if {[tk windowingsystem] eq {aqua}} {
 200                return 1
 201        }
 202        return 0
 203}
 204proc is_Windows {} {
 206        if {$::tcl_platform(platform) eq {windows}} {
 207                return 1
 208        }
 209        return 0
 210}
 211proc is_Cygwin {} {
 213        global _iscygwin
 214        if {$_iscygwin eq {}} {
 215                if {$::tcl_platform(platform) eq {windows}} {
 216                        if {[catch {set p [exec cygpath --windir]} err]} {
 217                                set _iscygwin 0
 218                        } else {
 219                                set _iscygwin 1
 220                        }
 221                } else {
 222                        set _iscygwin 0
 223                }
 224        }
 225        return $_iscygwin
 226}
 227proc is_enabled {option} {
 229        global enabled_options
 230        if {[catch {set on $enabled_options($option)}]} {return 0}
 231        return $on
 232}
 233proc enable_option {option} {
 235        global enabled_options
 236        set enabled_options($option) 1
 237}
 238proc disable_option {option} {
 240        global enabled_options
 241        set enabled_options($option) 0
 242}
 243######################################################################
 245##
 246## config
 247proc is_many_config {name} {
 249        switch -glob -- $name {
 250        gui.recentrepo -
 251        remote.*.fetch -
 252        remote.*.push
 253                {return 1}
 254        *
 255                {return 0}
 256        }
 257}
 258proc is_config_true {name} {
 260        global repo_config
 261        if {[catch {set v $repo_config($name)}]} {
 262                return 0
 263        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 264                return 1
 265        } else {
 266                return 0
 267        }
 268}
 269proc get_config {name} {
 271        global repo_config
 272        if {[catch {set v $repo_config($name)}]} {
 273                return {}
 274        } else {
 275                return $v
 276        }
 277}
 278######################################################################
 280##
 281## handy utils
 282proc _trace_exec {cmd} {
 284        if {!$::_trace} return
 285        set d {}
 286        foreach v $cmd {
 287                if {$d ne {}} {
 288                        append d { }
 289                }
 290                if {[regexp {[ \t\r\n'"$?*]} $v]} {
 291                        set v [sq $v]
 292                }
 293                append d $v
 294        }
 295        puts stderr $d
 296}
 297proc _git_cmd {name} {
 299        global _git_cmd_path
 300        if {[catch {set v $_git_cmd_path($name)}]} {
 302                switch -- $name {
 303                  version   -
 304                --version   -
 305                --exec-path { return [list $::_git $name] }
 306                }
 307                set p [gitexec git-$name$::_search_exe]
 309                if {[file exists $p]} {
 310                        set v [list $p]
 311                } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 312                        # Try to determine what sort of magic will make
 313                        # git-$name go and do its thing, because native
 314                        # Tcl on Windows doesn't know it.
 315                        #
 316                        set p [gitexec git-$name]
 317                        set f [open $p r]
 318                        set s [gets $f]
 319                        close $f
 320                        switch -glob -- [lindex $s 0] {
 322                        #!*sh     { set i sh     }
 323                        #!*perl   { set i perl   }
 324                        #!*python { set i python }
 325                        default   { error "git-$name is not supported: $s" }
 326                        }
 327                        upvar #0 _$i interp
 329                        if {![info exists interp]} {
 330                                set interp [_which $i]
 331                        }
 332                        if {$interp eq {}} {
 333                                error "git-$name requires $i (not in PATH)"
 334                        }
 335                        set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 336                } else {
 337                        # Assume it is builtin to git somehow and we
 338                        # aren't actually able to see a file for it.
 339                        #
 340                        set v [list $::_git $name]
 341                }
 342                set _git_cmd_path($name) $v
 343        }
 344        return $v
 345}
 346proc _which {what args} {
 348        global env _search_exe _search_path
 349        if {$_search_path eq {}} {
 351                if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 352                        set _search_path [split [exec cygpath \
 353                                --windows \
 354                                --path \
 355                                --absolute \
 356                                $env(PATH)] {;}]
 357                        set _search_exe .exe
 358                } elseif {[is_Windows]} {
 359                        set gitguidir [file dirname [info script]]
 360                        regsub -all ";" $gitguidir "\\;" gitguidir
 361                        set env(PATH) "$gitguidir;$env(PATH)"
 362                        set _search_path [split $env(PATH) {;}]
 363                        set _search_exe .exe
 364                } else {
 365                        set _search_path [split $env(PATH) :]
 366                        set _search_exe {}
 367                }
 368        }
 369        if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 371                set suffix {}
 372        } else {
 373                set suffix $_search_exe
 374        }
 375        foreach p $_search_path {
 377                set p [file join $p $what$suffix]
 378                if {[file exists $p]} {
 379                        return [file normalize $p]
 380                }
 381        }
 382        return {}
 383}
 384proc _lappend_nice {cmd_var} {
 386        global _nice
 387        upvar $cmd_var cmd
 388        if {![info exists _nice]} {
 390                set _nice [_which nice]
 391        }
 392        if {$_nice ne {}} {
 393                lappend cmd $_nice
 394        }
 395}
 396proc git {args} {
 398        set opt [list]
 399        while {1} {
 401                switch -- [lindex $args 0] {
 402                --nice {
 403                        _lappend_nice opt
 404                }
 405                default {
 407                        break
 408                }
 409                }
 411                set args [lrange $args 1 end]
 413        }
 414        set cmdp [_git_cmd [lindex $args 0]]
 416        set args [lrange $args 1 end]
 417        _trace_exec [concat $opt $cmdp $args]
 419        set result [eval exec $opt $cmdp $args]
 420        if {$::_trace} {
 421                puts stderr "< $result"
 422        }
 423        return $result
 424}
 425proc _open_stdout_stderr {cmd} {
 427        _trace_exec $cmd
 428        if {[catch {
 429                        set fd [open [concat [list | ] $cmd] r]
 430                } err]} {
 431                if {   [lindex $cmd end] eq {2>@1}
 432                    && $err eq {can not find channel named "1"}
 433                        } {
 434                        # Older versions of Tcl 8.4 don't have this 2>@1 IO
 435                        # redirect operator.  Fallback to |& cat for those.
 436                        # The command was not actually started, so its safe
 437                        # to try to start it a second time.
 438                        #
 439                        set fd [open [concat \
 440                                [list | ] \
 441                                [lrange $cmd 0 end-1] \
 442                                [list |& cat] \
 443                                ] r]
 444                } else {
 445                        error $err
 446                }
 447        }
 448        fconfigure $fd -eofchar {}
 449        return $fd
 450}
 451proc git_read {args} {
 453        set opt [list]
 454        while {1} {
 456                switch -- [lindex $args 0] {
 457                --nice {
 458                        _lappend_nice opt
 459                }
 460                --stderr {
 462                        lappend args 2>@1
 463                }
 464                default {
 466                        break
 467                }
 468                }
 470                set args [lrange $args 1 end]
 472        }
 473        set cmdp [_git_cmd [lindex $args 0]]
 475        set args [lrange $args 1 end]
 476        return [_open_stdout_stderr [concat $opt $cmdp $args]]
 478}
 479proc git_write {args} {
 481        set opt [list]
 482        while {1} {
 484                switch -- [lindex $args 0] {
 485                --nice {
 486                        _lappend_nice opt
 487                }
 488                default {
 490                        break
 491                }
 492                }
 494                set args [lrange $args 1 end]
 496        }
 497        set cmdp [_git_cmd [lindex $args 0]]
 499        set args [lrange $args 1 end]
 500        _trace_exec [concat $opt $cmdp $args]
 502        return [open [concat [list | ] $opt $cmdp $args] w]
 503}
 504proc githook_read {hook_name args} {
 506        set pchook [gitdir hooks $hook_name]
 507        lappend args 2>@1
 508        # On Windows [file executable] might lie so we need to ask
 510        # the shell if the hook is executable.  Yes that's annoying.
 511        #
 512        if {[is_Windows]} {
 513                upvar #0 _sh interp
 514                if {![info exists interp]} {
 515                        set interp [_which sh]
 516                }
 517                if {$interp eq {}} {
 518                        error "hook execution requires sh (not in PATH)"
 519                }
 520                set scr {if test -x "$1";then exec "$@";fi}
 522                set sh_c [list $interp -c $scr $interp $pchook]
 523                return [_open_stdout_stderr [concat $sh_c $args]]
 524        }
 525        if {[file executable $pchook]} {
 527                return [_open_stdout_stderr [concat [list $pchook] $args]]
 528        }
 529        return {}
 531}
 532proc kill_file_process {fd} {
 534        set process [pid $fd]
 535        catch {
 537                if {[is_Windows]} {
 538                        # Use a Cygwin-specific flag to allow killing
 539                        # native Windows processes
 540                        exec kill -f $process
 541                } else {
 542                        exec kill $process
 543                }
 544        }
 545}
 546proc gitattr {path attr default} {
 548        if {[catch {set r [git check-attr $attr -- $path]}]} {
 549                set r unspecified
 550        } else {
 551                set r [join [lrange [split $r :] 2 end] :]
 552                regsub {^ } $r {} r
 553        }
 554        if {$r eq {unspecified}} {
 555                return $default
 556        }
 557        return $r
 558}
 559proc sq {value} {
 561        regsub -all ' $value "'\\''" value
 562        return "'$value'"
 563}
 564proc load_current_branch {} {
 566        global current_branch is_detached
 567        set fd [open [gitdir HEAD] r]
 569        if {[gets $fd ref] < 1} {
 570                set ref {}
 571        }
 572        close $fd
 573        set pfx {ref: refs/heads/}
 575        set len [string length $pfx]
 576        if {[string equal -length $len $pfx $ref]} {
 577                # We're on a branch.  It might not exist.  But
 578                # HEAD looks good enough to be a branch.
 579                #
 580                set current_branch [string range $ref $len end]
 581                set is_detached 0
 582        } else {
 583                # Assume this is a detached head.
 584                #
 585                set current_branch HEAD
 586                set is_detached 1
 587        }
 588}
 589auto_load tk_optionMenu
 591rename tk_optionMenu real__tkOptionMenu
 592proc tk_optionMenu {w varName args} {
 593        set m [eval real__tkOptionMenu $w $varName $args]
 594        $m configure -font font_ui
 595        $w configure -font font_ui
 596        return $m
 597}
 598proc rmsel_tag {text} {
 600        $text tag conf sel \
 601                -background [$text cget -background] \
 602                -foreground [$text cget -foreground] \
 603                -borderwidth 0
 604        $text tag conf in_sel -background lightgray
 605        bind $text <Motion> break
 606        return $text
 607}
 608set root_exists 0
 610bind . <Visibility> {
 611        bind . <Visibility> {}
 612        set root_exists 1
 613}
 614if {[is_Windows]} {
 616        wm iconbitmap . -default $oguilib/git-gui.ico
 617        set ::tk::AlwaysShowSelection 1
 618        # Spoof an X11 display for SSH
 620        if {![info exists env(DISPLAY)]} {
 621                set env(DISPLAY) :9999
 622        }
 623} else {
 624        catch {
 625                image create photo gitlogo -width 16 -height 16
 626                gitlogo put #33CC33 -to  7  0  9  2
 628                gitlogo put #33CC33 -to  4  2 12  4
 629                gitlogo put #33CC33 -to  7  4  9  6
 630                gitlogo put #CC3333 -to  4  6 12  8
 631                gitlogo put gray26  -to  4  9  6 10
 632                gitlogo put gray26  -to  3 10  6 12
 633                gitlogo put gray26  -to  8  9 13 11
 634                gitlogo put gray26  -to  8 11 10 12
 635                gitlogo put gray26  -to 11 11 13 14
 636                gitlogo put gray26  -to  3 12  5 14
 637                gitlogo put gray26  -to  5 13
 638                gitlogo put gray26  -to 10 13
 639                gitlogo put gray26  -to  4 14 12 15
 640                gitlogo put gray26  -to  5 15 11 16
 641                gitlogo redither
 642                wm iconphoto . -default gitlogo
 644        }
 645}
 646######################################################################
 648##
 649## config defaults
 650set cursor_ptr arrow
 652font create font_diff -family Courier -size 10
 653font create font_ui
 654catch {
 655        label .dummy
 656        eval font configure font_ui [font actual [.dummy cget -font]]
 657        destroy .dummy
 658}
 659font create font_uiitalic
 661font create font_uibold
 662font create font_diffbold
 663font create font_diffitalic
 664foreach class {Button Checkbutton Entry Label
 666                Labelframe Listbox Message
 667                Radiobutton Spinbox Text} {
 668        option add *$class.font font_ui
 669}
 670if {![is_MacOSX]} {
 671        option add *Menu.font font_ui
 672}
 673unset class
 674if {[is_Windows] || [is_MacOSX]} {
 676        option add *Menu.tearOff 0
 677}
 678if {[is_MacOSX]} {
 680        set M1B M1
 681        set M1T Cmd
 682} else {
 683        set M1B Control
 684        set M1T Ctrl
 685}
 686proc bind_button3 {w cmd} {
 688        bind $w <Any-Button-3> $cmd
 689        if {[is_MacOSX]} {
 690                # Mac OS X sends Button-2 on right click through three-button mouse,
 691                # or through trackpad right-clicking (two-finger touch + click).
 692                bind $w <Any-Button-2> $cmd
 693                bind $w <Control-Button-1> $cmd
 694        }
 695}
 696proc apply_config {} {
 698        global repo_config font_descs
 699        foreach option $font_descs {
 701                set name [lindex $option 0]
 702                set font [lindex $option 1]
 703                if {[catch {
 704                        set need_weight 1
 705                        foreach {cn cv} $repo_config(gui.$name) {
 706                                if {$cn eq {-weight}} {
 707                                        set need_weight 0
 708                                }
 709                                font configure $font $cn $cv
 710                        }
 711                        if {$need_weight} {
 712                                font configure $font -weight normal
 713                        }
 714                        } err]} {
 715                        error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 716                }
 717                foreach {cn cv} [font configure $font] {
 718                        font configure ${font}bold $cn $cv
 719                        font configure ${font}italic $cn $cv
 720                }
 721                font configure ${font}bold -weight bold
 722                font configure ${font}italic -slant italic
 723        }
 724}
 725set default_config(branch.autosetupmerge) true
 727set default_config(merge.tool) {}
 728set default_config(mergetool.keepbackup) true
 729set default_config(merge.diffstat) true
 730set default_config(merge.summary) false
 731set default_config(merge.verbosity) 2
 732set default_config(user.name) {}
 733set default_config(user.email) {}
 734set default_config(gui.encoding) [encoding system]
 736set default_config(gui.matchtrackingbranch) false
 737set default_config(gui.pruneduringfetch) false
 738set default_config(gui.trustmtime) false
 739set default_config(gui.fastcopyblame) false
 740set default_config(gui.copyblamethreshold) 40
 741set default_config(gui.blamehistoryctx) 7
 742set default_config(gui.diffcontext) 5
 743set default_config(gui.commitmsgwidth) 75
 744set default_config(gui.newbranchtemplate) {}
 745set default_config(gui.spellingdictionary) {}
 746set default_config(gui.fontui) [font configure font_ui]
 747set default_config(gui.fontdiff) [font configure font_diff]
 748set font_descs {
 749        {fontui   font_ui   {mc "Main Font"}}
 750        {fontdiff font_diff {mc "Diff/Console Font"}}
 751}
 752######################################################################
 754##
 755## find git
 756set _git  [_which git]
 758if {$_git eq {}} {
 759        catch {wm withdraw .}
 760        tk_messageBox \
 761                -icon error \
 762                -type ok \
 763                -title [mc "git-gui: fatal error"] \
 764                -message [mc "Cannot find git in PATH."]
 765        exit 1
 766}
 767######################################################################
 769##
 770## version check
 771if {[catch {set _git_version [git --version]} err]} {
 773        catch {wm withdraw .}
 774        tk_messageBox \
 775                -icon error \
 776                -type ok \
 777                -title [mc "git-gui: fatal error"] \
 778                -message "Cannot determine Git version:
 779$err
 781[appname] requires Git 1.5.0 or later."
 783        exit 1
 784}
 785if {![regsub {^git version } $_git_version {} _git_version]} {
 786        catch {wm withdraw .}
 787        tk_messageBox \
 788                -icon error \
 789                -type ok \
 790                -title [mc "git-gui: fatal error"] \
 791                -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 792        exit 1
 793}
 794set _real_git_version $_git_version
 796regsub -- {[\-\.]dirty$} $_git_version {} _git_version
 797regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 798regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
 799regsub {\.GIT$} $_git_version {} _git_version
 800regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
 801if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 803        catch {wm withdraw .}
 804        if {[tk_messageBox \
 805                -icon warning \
 806                -type yesno \
 807                -default no \
 808                -title "[appname]: warning" \
 809                 -message [mc "Git version cannot be determined.
 810%s claims it is version '%s'.
 812%s requires at least Git 1.5.0 or later.
 814Assume '%s' is version 1.5.0?
 816" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 817                set _git_version 1.5.0
 818        } else {
 819                exit 1
 820        }
 821}
 822unset _real_git_version
 823proc git-version {args} {
 825        global _git_version
 826        switch [llength $args] {
 828        0 {
 829                return $_git_version
 830        }
 831        2 {
 833                set op [lindex $args 0]
 834                set vr [lindex $args 1]
 835                set cm [package vcompare $_git_version $vr]
 836                return [expr $cm $op 0]
 837        }
 838        4 {
 840                set type [lindex $args 0]
 841                set name [lindex $args 1]
 842                set parm [lindex $args 2]
 843                set body [lindex $args 3]
 844                if {($type ne {proc} && $type ne {method})} {
 846                        error "Invalid arguments to git-version"
 847                }
 848                if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 849                        error "Last arm of $type $name must be default"
 850                }
 851                foreach {op vr cb} [lrange $body 0 end-2] {
 853                        if {[git-version $op $vr]} {
 854                                return [uplevel [list $type $name $parm $cb]]
 855                        }
 856                }
 857                return [uplevel [list $type $name $parm [lindex $body end]]]
 859        }
 860        default {
 862                error "git-version >= x"
 863        }
 864        }
 866}
 867if {[git-version < 1.5]} {
 869        catch {wm withdraw .}
 870        tk_messageBox \
 871                -icon error \
 872                -type ok \
 873                -title [mc "git-gui: fatal error"] \
 874                -message "[appname] requires Git 1.5.0 or later.
 875You are using [git-version]:
 877[git --version]"
 879        exit 1
 880}
 881######################################################################
 883##
 884## configure our library
 885set idx [file join $oguilib tclIndex]
 887if {[catch {set fd [open $idx r]} err]} {
 888        catch {wm withdraw .}
 889        tk_messageBox \
 890                -icon error \
 891                -type ok \
 892                -title [mc "git-gui: fatal error"] \
 893                -message $err
 894        exit 1
 895}
 896if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 897        set idx [list]
 898        while {[gets $fd n] >= 0} {
 899                if {$n ne {} && ![string match #* $n]} {
 900                        lappend idx $n
 901                }
 902        }
 903} else {
 904        set idx {}
 905}
 906close $fd
 907if {$idx ne {}} {
 909        set loaded [list]
 910        foreach p $idx {
 911                if {[lsearch -exact $loaded $p] >= 0} continue
 912                source [file join $oguilib $p]
 913                lappend loaded $p
 914        }
 915        unset loaded p
 916} else {
 917        set auto_path [concat [list $oguilib] $auto_path]
 918}
 919unset -nocomplain idx fd
 920######################################################################
 922##
 923## config file parsing
 924git-version proc _parse_config {arr_name args} {
 926        >= 1.5.3 {
 927                upvar $arr_name arr
 928                array unset arr
 929                set buf {}
 930                catch {
 931                        set fd_rc [eval \
 932                                [list git_read config] \
 933                                $args \
 934                                [list --null --list]]
 935                        fconfigure $fd_rc -translation binary
 936                        set buf [read $fd_rc]
 937                        close $fd_rc
 938                }
 939                foreach line [split $buf "\0"] {
 940                        if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
 941                                if {[is_many_config $name]} {
 942                                        lappend arr($name) $value
 943                                } else {
 944                                        set arr($name) $value
 945                                }
 946                        }
 947                }
 948        }
 949        default {
 950                upvar $arr_name arr
 951                array unset arr
 952                catch {
 953                        set fd_rc [eval [list git_read config --list] $args]
 954                        while {[gets $fd_rc line] >= 0} {
 955                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 956                                        if {[is_many_config $name]} {
 957                                                lappend arr($name) $value
 958                                        } else {
 959                                                set arr($name) $value
 960                                        }
 961                                }
 962                        }
 963                        close $fd_rc
 964                }
 965        }
 966}
 967proc load_config {include_global} {
 969        global repo_config global_config system_config default_config
 970        if {$include_global} {
 972                _parse_config system_config --system
 973                _parse_config global_config --global
 974        }
 975        _parse_config repo_config
 976        foreach name [array names default_config] {
 978                if {[catch {set v $system_config($name)}]} {
 979                        set system_config($name) $default_config($name)
 980                }
 981        }
 982        foreach name [array names system_config] {
 983                if {[catch {set v $global_config($name)}]} {
 984                        set global_config($name) $system_config($name)
 985                }
 986                if {[catch {set v $repo_config($name)}]} {
 987                        set repo_config($name) $system_config($name)
 988                }
 989        }
 990}
 991######################################################################
 993##
 994## feature option selection
 995if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
 997        unset _junk
 998} else {
 999        set subcommand gui
1000}
1001if {$subcommand eq {gui.sh}} {
1002        set subcommand gui
1003}
1004if {$subcommand eq {gui} && [llength $argv] > 0} {
1005        set subcommand [lindex $argv 0]
1006        set argv [lrange $argv 1 end]
1007}
1008enable_option multicommit
1010enable_option branch
1011enable_option transport
1012disable_option bare
1013switch -- $subcommand {
1015browser -
1016blame {
1017        enable_option bare
1018        disable_option multicommit
1020        disable_option branch
1021        disable_option transport
1022}
1023citool {
1024        enable_option singlecommit
1025        enable_option retcode
1026        disable_option multicommit
1028        disable_option branch
1029        disable_option transport
1030        while {[llength $argv] > 0} {
1032                set a [lindex $argv 0]
1033                switch -- $a {
1034                --amend {
1035                        enable_option initialamend
1036                }
1037                --nocommit {
1038                        enable_option nocommit
1039                        enable_option nocommitmsg
1040                }
1041                --commitmsg {
1042                        disable_option nocommitmsg
1043                }
1044                default {
1045                        break
1046                }
1047                }
1048                set argv [lrange $argv 1 end]
1050        }
1051}
1052}
1053######################################################################
1055##
1056## execution environment
1057set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1059# Suggest our implementation of askpass, if none is set
1061if {![info exists env(SSH_ASKPASS)]} {
1062        set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1063}
1064######################################################################
1066##
1067## repository setup
1068set picked 0
1070if {[catch {
1071                set _gitdir $env(GIT_DIR)
1072                set _prefix {}
1073                }]
1074        && [catch {
1075                set _gitdir [git rev-parse --git-dir]
1076                set _prefix [git rev-parse --show-prefix]
1077        } err]} {
1078        load_config 1
1079        apply_config
1080        choose_repository::pick
1081        set picked 1
1082}
1083if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1084        catch {set _gitdir [exec cygpath --windows $_gitdir]}
1085}
1086if {![file isdirectory $_gitdir]} {
1087        catch {wm withdraw .}
1088        error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1089        exit 1
1090}
1091if {$_prefix ne {}} {
1092        regsub -all {[^/]+/} $_prefix ../ cdup
1093        if {[catch {cd $cdup} err]} {
1094                catch {wm withdraw .}
1095                error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1096                exit 1
1097        }
1098        unset cdup
1099} elseif {![is_enabled bare]} {
1100        if {[lindex [file split $_gitdir] end] ne {.git}} {
1101                catch {wm withdraw .}
1102                error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
1103                exit 1
1104        }
1105        if {[catch {cd [file dirname $_gitdir]} err]} {
1106                catch {wm withdraw .}
1107                error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
1108                exit 1
1109        }
1110}
1111set _reponame [file split [file normalize $_gitdir]]
1112if {[lindex $_reponame end] eq {.git}} {
1113        set _reponame [lindex $_reponame end-1]
1114} else {
1115        set _reponame [lindex $_reponame end]
1116}
1117######################################################################
1119##
1120## global init
1121set current_diff_path {}
1123set current_diff_side {}
1124set diff_actions [list]
1125set HEAD {}
1127set PARENT {}
1128set MERGE_HEAD [list]
1129set commit_type {}
1130set empty_tree {}
1131set current_branch {}
1132set is_detached 0
1133set current_diff_path {}
1134set is_3way_diff 0
1135set is_conflict_diff 0
1136set selected_commit_type new
1137set diff_empty_count 0
1138set nullid "0000000000000000000000000000000000000000"
1140set nullid2 "0000000000000000000000000000000000000001"
1141######################################################################
1143##
1144## task management
1145set rescan_active 0
1147set diff_active 0
1148set last_clicked {}
1149set disable_on_lock [list]
1151set index_lock_type none
1152proc lock_index {type} {
1154        global index_lock_type disable_on_lock
1155        if {$index_lock_type eq {none}} {
1157                set index_lock_type $type
1158                foreach w $disable_on_lock {
1159                        uplevel #0 $w disabled
1160                }
1161                return 1
1162        } elseif {$index_lock_type eq "begin-$type"} {
1163                set index_lock_type $type
1164                return 1
1165        }
1166        return 0
1167}
1168proc unlock_index {} {
1170        global index_lock_type disable_on_lock
1171        set index_lock_type none
1173        foreach w $disable_on_lock {
1174                uplevel #0 $w normal
1175        }
1176}
1177######################################################################
1179##
1180## status
1181proc repository_state {ctvar hdvar mhvar} {
1183        global current_branch
1184        upvar $ctvar ct $hdvar hd $mhvar mh
1185        set mh [list]
1187        load_current_branch
1189        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1190                set hd {}
1191                set ct initial
1192                return
1193        }
1194        set merge_head [gitdir MERGE_HEAD]
1196        if {[file exists $merge_head]} {
1197                set ct merge
1198                set fd_mh [open $merge_head r]
1199                while {[gets $fd_mh line] >= 0} {
1200                        lappend mh $line
1201                }
1202                close $fd_mh
1203                return
1204        }
1205        set ct normal
1207}
1208proc PARENT {} {
1210        global PARENT empty_tree
1211        set p [lindex $PARENT 0]
1213        if {$p ne {}} {
1214                return $p
1215        }
1216        if {$empty_tree eq {}} {
1217                set empty_tree [git mktree << {}]
1218        }
1219        return $empty_tree
1220}
1221proc force_amend {} {
1223        global selected_commit_type
1224        global HEAD PARENT MERGE_HEAD commit_type
1225        repository_state newType newHEAD newMERGE_HEAD
1227        set HEAD $newHEAD
1228        set PARENT $newHEAD
1229        set MERGE_HEAD $newMERGE_HEAD
1230        set commit_type $newType
1231        set selected_commit_type amend
1233        do_select_commit_type
1234}
1235proc rescan {after {honor_trustmtime 1}} {
1237        global HEAD PARENT MERGE_HEAD commit_type
1238        global ui_index ui_workdir ui_comm
1239        global rescan_active file_states
1240        global repo_config
1241        if {$rescan_active > 0 || ![lock_index read]} return
1243        repository_state newType newHEAD newMERGE_HEAD
1245        if {[string match amend* $commit_type]
1246                && $newType eq {normal}
1247                && $newHEAD eq $HEAD} {
1248        } else {
1249                set HEAD $newHEAD
1250                set PARENT $newHEAD
1251                set MERGE_HEAD $newMERGE_HEAD
1252                set commit_type $newType
1253        }
1254        array unset file_states
1256        if {!$::GITGUI_BCK_exists &&
1258                (![$ui_comm edit modified]
1259                || [string trim [$ui_comm get 0.0 end]] eq {})} {
1260                if {[string match amend* $commit_type]} {
1261                } elseif {[load_message GITGUI_MSG]} {
1262                } elseif {[run_prepare_commit_msg_hook]} {
1263                } elseif {[load_message MERGE_MSG]} {
1264                } elseif {[load_message SQUASH_MSG]} {
1265                }
1266                $ui_comm edit reset
1267                $ui_comm edit modified false
1268        }
1269        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1271                rescan_stage2 {} $after
1272        } else {
1273                set rescan_active 1
1274                ui_status [mc "Refreshing file status..."]
1275                set fd_rf [git_read update-index \
1276                        -q \
1277                        --unmerged \
1278                        --ignore-missing \
1279                        --refresh \
1280                        ]
1281                fconfigure $fd_rf -blocking 0 -translation binary
1282                fileevent $fd_rf readable \
1283                        [list rescan_stage2 $fd_rf $after]
1284        }
1285}
1286if {[is_Cygwin]} {
1288        set is_git_info_exclude {}
1289        proc have_info_exclude {} {
1290                global is_git_info_exclude
1291                if {$is_git_info_exclude eq {}} {
1293                        if {[catch {exec test -f [gitdir info exclude]}]} {
1294                                set is_git_info_exclude 0
1295                        } else {
1296                                set is_git_info_exclude 1
1297                        }
1298                }
1299                return $is_git_info_exclude
1300        }
1301} else {
1302        proc have_info_exclude {} {
1303                return [file readable [gitdir info exclude]]
1304        }
1305}
1306proc rescan_stage2 {fd after} {
1308        global rescan_active buf_rdi buf_rdf buf_rlo
1309        if {$fd ne {}} {
1311                read $fd
1312                if {![eof $fd]} return
1313                close $fd
1314        }
1315        set ls_others [list --exclude-per-directory=.gitignore]
1317        if {[have_info_exclude]} {
1318                lappend ls_others "--exclude-from=[gitdir info exclude]"
1319        }
1320        set user_exclude [get_config core.excludesfile]
1321        if {$user_exclude ne {} && [file readable $user_exclude]} {
1322                lappend ls_others "--exclude-from=$user_exclude"
1323        }
1324        set buf_rdi {}
1326        set buf_rdf {}
1327        set buf_rlo {}
1328        set rescan_active 3
1330        ui_status [mc "Scanning for modified files ..."]
1331        set fd_di [git_read diff-index --cached -z [PARENT]]
1332        set fd_df [git_read diff-files -z]
1333        set fd_lo [eval git_read ls-files --others -z $ls_others]
1334        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1336        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1337        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1338        fileevent $fd_di readable [list read_diff_index $fd_di $after]
1339        fileevent $fd_df readable [list read_diff_files $fd_df $after]
1340        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1341}
1342proc load_message {file} {
1344        global ui_comm
1345        set f [gitdir $file]
1347        if {[file isfile $f]} {
1348                if {[catch {set fd [open $f r]}]} {
1349                        return 0
1350                }
1351                fconfigure $fd -eofchar {}
1352                set content [string trim [read $fd]]
1353                close $fd
1354                regsub -all -line {[ \r\t]+$} $content {} content
1355                $ui_comm delete 0.0 end
1356                $ui_comm insert end $content
1357                return 1
1358        }
1359        return 0
1360}
1361proc run_prepare_commit_msg_hook {} {
1363        global pch_error
1364        # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1366        # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1367        # empty file but existant file.
1368        set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1370        if {[file isfile [gitdir MERGE_MSG]]} {
1372                set pcm_source "merge"
1373                set fd_mm [open [gitdir MERGE_MSG] r]
1374                puts -nonewline $fd_pcm [read $fd_mm]
1375                close $fd_mm
1376        } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1377                set pcm_source "squash"
1378                set fd_sm [open [gitdir SQUASH_MSG] r]
1379                puts -nonewline $fd_pcm [read $fd_sm]
1380                close $fd_sm
1381        } else {
1382                set pcm_source ""
1383        }
1384        close $fd_pcm
1386        set fd_ph [githook_read prepare-commit-msg \
1388                        [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1389        if {$fd_ph eq {}} {
1390                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1391                return 0;
1392        }
1393        ui_status [mc "Calling prepare-commit-msg hook..."]
1395        set pch_error {}
1396        fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1398        fileevent $fd_ph readable \
1399                [list prepare_commit_msg_hook_wait $fd_ph]
1400        return 1;
1402}
1403proc prepare_commit_msg_hook_wait {fd_ph} {
1405        global pch_error
1406        append pch_error [read $fd_ph]
1408        fconfigure $fd_ph -blocking 1
1409        if {[eof $fd_ph]} {
1410                if {[catch {close $fd_ph}]} {
1411                        ui_status [mc "Commit declined by prepare-commit-msg hook."]
1412                        hook_failed_popup prepare-commit-msg $pch_error
1413                        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1414                        exit 1
1415                } else {
1416                        load_message PREPARE_COMMIT_MSG
1417                }
1418                set pch_error {}
1419                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1420                return
1421        }
1422        fconfigure $fd_ph -blocking 0
1423        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1424}
1425proc read_diff_index {fd after} {
1427        global buf_rdi
1428        append buf_rdi [read $fd]
1430        set c 0
1431        set n [string length $buf_rdi]
1432        while {$c < $n} {
1433                set z1 [string first "\0" $buf_rdi $c]
1434                if {$z1 == -1} break
1435                incr z1
1436                set z2 [string first "\0" $buf_rdi $z1]
1437                if {$z2 == -1} break
1438                incr c
1440                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1441                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1442                merge_state \
1443                        [encoding convertfrom $p] \
1444                        [lindex $i 4]? \
1445                        [list [lindex $i 0] [lindex $i 2]] \
1446                        [list]
1447                set c $z2
1448                incr c
1449        }
1450        if {$c < $n} {
1451                set buf_rdi [string range $buf_rdi $c end]
1452        } else {
1453                set buf_rdi {}
1454        }
1455        rescan_done $fd buf_rdi $after
1457}
1458proc read_diff_files {fd after} {
1460        global buf_rdf
1461        append buf_rdf [read $fd]
1463        set c 0
1464        set n [string length $buf_rdf]
1465        while {$c < $n} {
1466                set z1 [string first "\0" $buf_rdf $c]
1467                if {$z1 == -1} break
1468                incr z1
1469                set z2 [string first "\0" $buf_rdf $z1]
1470                if {$z2 == -1} break
1471                incr c
1473                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1474                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1475                merge_state \
1476                        [encoding convertfrom $p] \
1477                        ?[lindex $i 4] \
1478                        [list] \
1479                        [list [lindex $i 0] [lindex $i 2]]
1480                set c $z2
1481                incr c
1482        }
1483        if {$c < $n} {
1484                set buf_rdf [string range $buf_rdf $c end]
1485        } else {
1486                set buf_rdf {}
1487        }
1488        rescan_done $fd buf_rdf $after
1490}
1491proc read_ls_others {fd after} {
1493        global buf_rlo
1494        append buf_rlo [read $fd]
1496        set pck [split $buf_rlo "\0"]
1497        set buf_rlo [lindex $pck end]
1498        foreach p [lrange $pck 0 end-1] {
1499                set p [encoding convertfrom $p]
1500                if {[string index $p end] eq {/}} {
1501                        set p [string range $p 0 end-1]
1502                }
1503                merge_state $p ?O
1504        }
1505        rescan_done $fd buf_rlo $after
1506}
1507proc rescan_done {fd buf after} {
1509        global rescan_active current_diff_path
1510        global file_states repo_config
1511        upvar $buf to_clear
1512        if {![eof $fd]} return
1514        set to_clear {}
1515        close $fd
1516        if {[incr rescan_active -1] > 0} return
1517        prune_selection
1519        unlock_index
1520        display_all_files
1521        if {$current_diff_path ne {}} { reshow_diff $after }
1522        if {$current_diff_path eq {}} { select_first_diff $after }
1523}
1524proc prune_selection {} {
1526        global file_states selected_paths
1527        foreach path [array names selected_paths] {
1529                if {[catch {set still_here $file_states($path)}]} {
1530                        unset selected_paths($path)
1531                }
1532        }
1533}
1534######################################################################
1536##
1537## ui helpers
1538proc mapicon {w state path} {
1540        global all_icons
1541        if {[catch {set r $all_icons($state$w)}]} {
1543                puts "error: no icon for $w state={$state} $path"
1544                return file_plain
1545        }
1546        return $r
1547}
1548proc mapdesc {state path} {
1550        global all_descs
1551        if {[catch {set r $all_descs($state)}]} {
1553                puts "error: no desc for state={$state} $path"
1554                return $state
1555        }
1556        return $r
1557}
1558proc ui_status {msg} {
1560        global main_status
1561        if {[info exists main_status]} {
1562                $main_status show $msg
1563        }
1564}
1565proc ui_ready {{test {}}} {
1567        global main_status
1568        if {[info exists main_status]} {
1569                $main_status show [mc "Ready."] $test
1570        }
1571}
1572proc escape_path {path} {
1574        regsub -all {\\} $path "\\\\" path
1575        regsub -all "\n" $path "\\n" path
1576        return $path
1577}
1578proc short_path {path} {
1580        return [escape_path [lindex [file split $path] end]]
1581}
1582set next_icon_id 0
1584set null_sha1 [string repeat 0 40]
1585proc merge_state {path new_state {head_info {}} {index_info {}}} {
1587        global file_states next_icon_id null_sha1
1588        set s0 [string index $new_state 0]
1590        set s1 [string index $new_state 1]
1591        if {[catch {set info $file_states($path)}]} {
1593                set state __
1594                set icon n[incr next_icon_id]
1595        } else {
1596                set state [lindex $info 0]
1597                set icon [lindex $info 1]
1598                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1599                if {$index_info eq {}} {set index_info [lindex $info 3]}
1600        }
1601        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1603        elseif {$s0 eq {_}} {set s0 _}
1604        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1606        elseif {$s1 eq {_}} {set s1 _}
1607        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1609                set head_info [list 0 $null_sha1]
1610        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1611                && $head_info eq {}} {
1612                set head_info $index_info
1613        }
1614        set file_states($path) [list $s0$s1 $icon \
1616                $head_info $index_info \
1617                ]
1618        return $state
1619}
1620proc display_file_helper {w path icon_name old_m new_m} {
1622        global file_lists
1623        if {$new_m eq {_}} {
1625                set lno [lsearch -sorted -exact $file_lists($w) $path]
1626                if {$lno >= 0} {
1627                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1628                        incr lno
1629                        $w conf -state normal
1630                        $w delete $lno.0 [expr {$lno + 1}].0
1631                        $w conf -state disabled
1632                }
1633        } elseif {$old_m eq {_} && $new_m ne {_}} {
1634                lappend file_lists($w) $path
1635                set file_lists($w) [lsort -unique $file_lists($w)]
1636                set lno [lsearch -sorted -exact $file_lists($w) $path]
1637                incr lno
1638                $w conf -state normal
1639                $w image create $lno.0 \
1640                        -align center -padx 5 -pady 1 \
1641                        -name $icon_name \
1642                        -image [mapicon $w $new_m $path]
1643                $w insert $lno.1 "[escape_path $path]\n"
1644                $w conf -state disabled
1645        } elseif {$old_m ne $new_m} {
1646                $w conf -state normal
1647                $w image conf $icon_name -image [mapicon $w $new_m $path]
1648                $w conf -state disabled
1649        }
1650}
1651proc display_file {path state} {
1653        global file_states selected_paths
1654        global ui_index ui_workdir
1655        set old_m [merge_state $path $state]
1657        set s $file_states($path)
1658        set new_m [lindex $s 0]
1659        set icon_name [lindex $s 1]
1660        set o [string index $old_m 0]
1662        set n [string index $new_m 0]
1663        if {$o eq {U}} {
1664                set o _
1665        }
1666        if {$n eq {U}} {
1667                set n _
1668        }
1669        display_file_helper     $ui_index $path $icon_name $o $n
1670        if {[string index $old_m 0] eq {U}} {
1672                set o U
1673        } else {
1674                set o [string index $old_m 1]
1675        }
1676        if {[string index $new_m 0] eq {U}} {
1677                set n U
1678        } else {
1679                set n [string index $new_m 1]
1680        }
1681        display_file_helper     $ui_workdir $path $icon_name $o $n
1682        if {$new_m eq {__}} {
1684                unset file_states($path)
1685                catch {unset selected_paths($path)}
1686        }
1687}
1688proc display_all_files_helper {w path icon_name m} {
1690        global file_lists
1691        lappend file_lists($w) $path
1693        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1694        $w image create end \
1695                -align center -padx 5 -pady 1 \
1696                -name $icon_name \
1697                -image [mapicon $w $m $path]
1698        $w insert end "[escape_path $path]\n"
1699}
1700proc display_all_files {} {
1702        global ui_index ui_workdir
1703        global file_states file_lists
1704        global last_clicked
1705        $ui_index conf -state normal
1707        $ui_workdir conf -state normal
1708        $ui_index delete 0.0 end
1710        $ui_workdir delete 0.0 end
1711        set last_clicked {}
1712        set file_lists($ui_index) [list]
1714        set file_lists($ui_workdir) [list]
1715        foreach path [lsort [array names file_states]] {
1717                set s $file_states($path)
1718                set m [lindex $s 0]
1719                set icon_name [lindex $s 1]
1720                set s [string index $m 0]
1722                if {$s ne {U} && $s ne {_}} {
1723                        display_all_files_helper $ui_index $path \
1724                                $icon_name $s
1725                }
1726                if {[string index $m 0] eq {U}} {
1728                        set s U
1729                } else {
1730                        set s [string index $m 1]
1731                }
1732                if {$s ne {_}} {
1733                        display_all_files_helper $ui_workdir $path \
1734                                $icon_name $s
1735                }
1736        }
1737        $ui_index conf -state disabled
1739        $ui_workdir conf -state disabled
1740}
1741######################################################################
1743##
1744## icons
1745set filemask {
1747#define mask_width 14
1748#define mask_height 15
1749static unsigned char mask_bits[] = {
1750   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1751   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1752   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1753}
1754image create bitmap file_plain -background white -foreground black -data {
1756#define plain_width 14
1757#define plain_height 15
1758static unsigned char plain_bits[] = {
1759   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1760   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1761   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1762} -maskdata $filemask
1763image create bitmap file_mod -background white -foreground blue -data {
1765#define mod_width 14
1766#define mod_height 15
1767static unsigned char mod_bits[] = {
1768   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1769   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1770   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1771} -maskdata $filemask
1772image create bitmap file_fulltick -background white -foreground "#007000" -data {
1774#define file_fulltick_width 14
1775#define file_fulltick_height 15
1776static unsigned char file_fulltick_bits[] = {
1777   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1778   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1779   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1780} -maskdata $filemask
1781image create bitmap file_parttick -background white -foreground "#005050" -data {
1783#define parttick_width 14
1784#define parttick_height 15
1785static unsigned char parttick_bits[] = {
1786   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1787   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1788   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1789} -maskdata $filemask
1790image create bitmap file_question -background white -foreground black -data {
1792#define file_question_width 14
1793#define file_question_height 15
1794static unsigned char file_question_bits[] = {
1795   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1796   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1797   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1798} -maskdata $filemask
1799image create bitmap file_removed -background white -foreground red -data {
1801#define file_removed_width 14
1802#define file_removed_height 15
1803static unsigned char file_removed_bits[] = {
1804   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1805   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1806   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1807} -maskdata $filemask
1808image create bitmap file_merge -background white -foreground blue -data {
1810#define file_merge_width 14
1811#define file_merge_height 15
1812static unsigned char file_merge_bits[] = {
1813   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1814   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1815   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1816} -maskdata $filemask
1817image create bitmap file_statechange -background white -foreground green -data {
1819#define file_merge_width 14
1820#define file_merge_height 15
1821static unsigned char file_statechange_bits[] = {
1822   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1823   0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1824   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1825} -maskdata $filemask
1826set ui_index .vpane.files.index.list
1828set ui_workdir .vpane.files.workdir.list
1829set all_icons(_$ui_index)   file_plain
1831set all_icons(A$ui_index)   file_fulltick
1832set all_icons(M$ui_index)   file_fulltick
1833set all_icons(D$ui_index)   file_removed
1834set all_icons(U$ui_index)   file_merge
1835set all_icons(T$ui_index)   file_statechange
1836set all_icons(_$ui_workdir) file_plain
1838set all_icons(M$ui_workdir) file_mod
1839set all_icons(D$ui_workdir) file_question
1840set all_icons(U$ui_workdir) file_merge
1841set all_icons(O$ui_workdir) file_plain
1842set all_icons(T$ui_workdir) file_statechange
1843set max_status_desc 0
1845foreach i {
1846                {__ {mc "Unmodified"}}
1847                {_M {mc "Modified, not staged"}}
1849                {M_ {mc "Staged for commit"}}
1850                {MM {mc "Portions staged for commit"}}
1851                {MD {mc "Staged for commit, missing"}}
1852                {_T {mc "File type changed, not staged"}}
1854                {T_ {mc "File type changed, staged"}}
1855                {_O {mc "Untracked, not staged"}}
1857                {A_ {mc "Staged for commit"}}
1858                {AM {mc "Portions staged for commit"}}
1859                {AD {mc "Staged for commit, missing"}}
1860                {_D {mc "Missing"}}
1862                {D_ {mc "Staged for removal"}}
1863                {DO {mc "Staged for removal, still present"}}
1864                {_U {mc "Requires merge resolution"}}
1866                {U_ {mc "Requires merge resolution"}}
1867                {UU {mc "Requires merge resolution"}}
1868                {UM {mc "Requires merge resolution"}}
1869                {UD {mc "Requires merge resolution"}}
1870                {UT {mc "Requires merge resolution"}}
1871        } {
1872        set text [eval [lindex $i 1]]
1873        if {$max_status_desc < [string length $text]} {
1874                set max_status_desc [string length $text]
1875        }
1876        set all_descs([lindex $i 0]) $text
1877}
1878unset i
1879######################################################################
1881##
1882## util
1883proc scrollbar2many {list mode args} {
1885        foreach w $list {eval $w $mode $args}
1886}
1887proc many2scrollbar {list mode sb top bottom} {
1889        $sb set $top $bottom
1890        foreach w $list {$w $mode moveto $top}
1891}
1892proc incr_font_size {font {amt 1}} {
1894        set sz [font configure $font -size]
1895        incr sz $amt
1896        font configure $font -size $sz
1897        font configure ${font}bold -size $sz
1898        font configure ${font}italic -size $sz
1899}
1900######################################################################
1902##
1903## ui commands
1904set starting_gitk_msg [mc "Starting gitk... please wait..."]
1906proc do_gitk {revs} {
1908        # -- Always start gitk through whatever we were loaded with.  This
1909        #    lets us bypass using shell process on Windows systems.
1910        #
1911        set exe [_which gitk -script]
1912        set cmd [list [info nameofexecutable] $exe]
1913        if {$exe eq {}} {
1914                error_popup [mc "Couldn't find gitk in PATH"]
1915        } else {
1916                global env
1917                if {[info exists env(GIT_DIR)]} {
1919                        set old_GIT_DIR $env(GIT_DIR)
1920                } else {
1921                        set old_GIT_DIR {}
1922                }
1923                set pwd [pwd]
1925                cd [file dirname [gitdir]]
1926                set env(GIT_DIR) [file tail [gitdir]]
1927                eval exec $cmd $revs &
1929                if {$old_GIT_DIR eq {}} {
1931                        unset env(GIT_DIR)
1932                } else {
1933                        set env(GIT_DIR) $old_GIT_DIR
1934                }
1935                cd $pwd
1936                ui_status $::starting_gitk_msg
1938                after 10000 {
1939                        ui_ready $starting_gitk_msg
1940                }
1941        }
1942}
1943proc do_explore {} {
1945        set explorer {}
1946        if {[is_Cygwin] || [is_Windows]} {
1947                set explorer "explorer.exe"
1948        } elseif {[is_MacOSX]} {
1949                set explorer "open"
1950        } else {
1951                # freedesktop.org-conforming system is our best shot
1952                set explorer "xdg-open"
1953        }
1954        eval exec $explorer [list [file nativename [file dirname [gitdir]]]] &
1955}
1956set is_quitting 0
1958set ret_code    1
1959proc terminate_me {win} {
1961        global ret_code
1962        if {$win ne {.}} return
1963        exit $ret_code
1964}
1965proc do_quit {{rc {1}}} {
1967        global ui_comm is_quitting repo_config commit_type
1968        global GITGUI_BCK_exists GITGUI_BCK_i
1969        global ui_comm_spell
1970        global ret_code
1971        if {$is_quitting} return
1973        set is_quitting 1
1974        if {[winfo exists $ui_comm]} {
1976                # -- Stash our current commit buffer.
1977                #
1978                set save [gitdir GITGUI_MSG]
1979                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1980                        file rename -force [gitdir GITGUI_BCK] $save
1981                        set GITGUI_BCK_exists 0
1982                } else {
1983                        set msg [string trim [$ui_comm get 0.0 end]]
1984                        regsub -all -line {[ \r\t]+$} $msg {} msg
1985                        if {(![string match amend* $commit_type]
1986                                || [$ui_comm edit modified])
1987                                && $msg ne {}} {
1988                                catch {
1989                                        set fd [open $save w]
1990                                        puts -nonewline $fd $msg
1991                                        close $fd
1992                                }
1993                        } else {
1994                                catch {file delete $save}
1995                        }
1996                }
1997                # -- Cancel our spellchecker if its running.
1999                #
2000                if {[info exists ui_comm_spell]} {
2001                        $ui_comm_spell stop
2002                }
2003                # -- Remove our editor backup, its not needed.
2005                #
2006                after cancel $GITGUI_BCK_i
2007                if {$GITGUI_BCK_exists} {
2008                        catch {file delete [gitdir GITGUI_BCK]}
2009                }
2010                # -- Stash our current window geometry into this repository.
2012                #
2013                set cfg_geometry [list]
2014                lappend cfg_geometry [wm geometry .]
2015                lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2016                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2017                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2018                        set rc_geometry {}
2019                }
2020                if {$cfg_geometry ne $rc_geometry} {
2021                        catch {git config gui.geometry $cfg_geometry}
2022                }
2023        }
2024        set ret_code $rc
2026        destroy .
2027}
2028proc do_rescan {} {
2030        rescan ui_ready
2031}
2032proc ui_do_rescan {} {
2034        rescan {force_first_diff ui_ready}
2035}
2036proc do_commit {} {
2038        commit_tree
2039}
2040proc next_diff {{after {}}} {
2042        global next_diff_p next_diff_w next_diff_i
2043        show_diff $next_diff_p $next_diff_w {} {} $after
2044}
2045proc find_anchor_pos {lst name} {
2047        set lid [lsearch -sorted -exact $lst $name]
2048        if {$lid == -1} {
2050                set lid 0
2051                foreach lname $lst {
2052                        if {$lname >= $name} break
2053                        incr lid
2054                }
2055        }
2056        return $lid
2058}
2059proc find_file_from {flist idx delta path mmask} {
2061        global file_states
2062        set len [llength $flist]
2064        while {$idx >= 0 && $idx < $len} {
2065                set name [lindex $flist $idx]
2066                if {$name ne $path && [info exists file_states($name)]} {
2068                        set state [lindex $file_states($name) 0]
2069                        if {$mmask eq {} || [regexp $mmask $state]} {
2071                                return $idx
2072                        }
2073                }
2074                incr idx $delta
2076        }
2077        return {}
2079}
2080proc find_next_diff {w path {lno {}} {mmask {}}} {
2082        global next_diff_p next_diff_w next_diff_i
2083        global file_lists ui_index ui_workdir
2084        set flist $file_lists($w)
2086        if {$lno eq {}} {
2087                set lno [find_anchor_pos $flist $path]
2088        } else {
2089                incr lno -1
2090        }
2091        if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2093                if {$w eq $ui_index} {
2094                        set mmask "^$mmask"
2095                } else {
2096                        set mmask "$mmask\$"
2097                }
2098        }
2099        set idx [find_file_from $flist $lno 1 $path $mmask]
2101        if {$idx eq {}} {
2102                incr lno -1
2103                set idx [find_file_from $flist $lno -1 $path $mmask]
2104        }
2105        if {$idx ne {}} {
2107                set next_diff_w $w
2108                set next_diff_p [lindex $flist $idx]
2109                set next_diff_i [expr {$idx+1}]
2110                return 1
2111        } else {
2112                return 0
2113        }
2114}
2115proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2117        global current_diff_path
2118        if {$path ne $current_diff_path} {
2120                return {}
2121        } elseif {[find_next_diff $w $path $lno $mmask]} {
2122                return {next_diff;}
2123        } else {
2124                return {reshow_diff;}
2125        }
2126}
2127proc select_first_diff {after} {
2129        global ui_workdir
2130        if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2132            [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2133                next_diff $after
2134        } else {
2135                uplevel #0 $after
2136        }
2137}
2138proc force_first_diff {after} {
2140        global ui_workdir current_diff_path file_states
2141        if {[info exists file_states($current_diff_path)]} {
2143                set state [lindex $file_states($current_diff_path) 0]
2144        } else {
2145                set state {OO}
2146        }
2147        set reselect 0
2149        if {[string first {U} $state] >= 0} {
2150                # Already a conflict, do nothing
2151        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2152                set reselect 1
2153        } elseif {[string index $state 1] ne {O}} {
2154                # Already a diff & no conflicts, do nothing
2155        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2156                set reselect 1
2157        }
2158        if {$reselect} {
2160                next_diff $after
2161        } else {
2162                uplevel #0 $after
2163        }
2164}
2165proc toggle_or_diff {w x y} {
2167        global file_states file_lists current_diff_path ui_index ui_workdir
2168        global last_clicked selected_paths
2169        set pos [split [$w index @$x,$y] .]
2171        set lno [lindex $pos 0]
2172        set col [lindex $pos 1]
2173        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2174        if {$path eq {}} {
2175                set last_clicked {}
2176                return
2177        }
2178        set last_clicked [list $w $lno]
2180        array unset selected_paths
2181        $ui_index tag remove in_sel 0.0 end
2182        $ui_workdir tag remove in_sel 0.0 end
2183        # Determine the state of the file
2185        if {[info exists file_states($path)]} {
2186                set state [lindex $file_states($path) 0]
2187        } else {
2188                set state {__}
2189        }
2190        # Restage the file, or simply show the diff
2192        if {$col == 0 && $y > 1} {
2193                # Conflicts need special handling
2194                if {[string first {U} $state] >= 0} {
2195                        # $w must always be $ui_workdir, but...
2196                        if {$w ne $ui_workdir} { set lno {} }
2197                        merge_stage_workdir $path $lno
2198                        return
2199                }
2200                if {[string index $state 1] eq {O}} {
2202                        set mmask {}
2203                } else {
2204                        set mmask {[^O]}
2205                }
2206                set after [next_diff_after_action $w $path $lno $mmask]
2208                if {$w eq $ui_index} {
2210                        update_indexinfo \
2211                                "Unstaging [short_path $path] from commit" \
2212                                [list $path] \
2213                                [concat $after [list ui_ready]]
2214                } elseif {$w eq $ui_workdir} {
2215                        update_index \
2216                                "Adding [short_path $path]" \
2217                                [list $path] \
2218                                [concat $after [list ui_ready]]
2219                }
2220        } else {
2221                show_diff $path $w $lno
2222        }
2223}
2224proc add_one_to_selection {w x y} {
2226        global file_lists last_clicked selected_paths
2227        set lno [lindex [split [$w index @$x,$y] .] 0]
2229        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2230        if {$path eq {}} {
2231                set last_clicked {}
2232                return
2233        }
2234        if {$last_clicked ne {}
2236                && [lindex $last_clicked 0] ne $w} {
2237                array unset selected_paths
2238                [lindex $last_clicked 0] tag remove in_sel 0.0 end
2239        }
2240        set last_clicked [list $w $lno]
2242        if {[catch {set in_sel $selected_paths($path)}]} {
2243                set in_sel 0
2244        }
2245        if {$in_sel} {
2246                unset selected_paths($path)
2247                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2248        } else {
2249                set selected_paths($path) 1
2250                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2251        }
2252}
2253proc add_range_to_selection {w x y} {
2255        global file_lists last_clicked selected_paths
2256        if {[lindex $last_clicked 0] ne $w} {
2258                toggle_or_diff $w $x $y
2259                return
2260        }
2261        set lno [lindex [split [$w index @$x,$y] .] 0]
2263        set lc [lindex $last_clicked 1]
2264        if {$lc < $lno} {
2265                set begin $lc
2266                set end $lno
2267        } else {
2268                set begin $lno
2269                set end $lc
2270        }
2271        foreach path [lrange $file_lists($w) \
2273                [expr {$begin - 1}] \
2274                [expr {$end - 1}]] {
2275                set selected_paths($path) 1
2276        }
2277        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2278}
2279proc show_more_context {} {
2281        global repo_config
2282        if {$repo_config(gui.diffcontext) < 99} {
2283                incr repo_config(gui.diffcontext)
2284                reshow_diff
2285        }
2286}
2287proc show_less_context {} {
2289        global repo_config
2290        if {$repo_config(gui.diffcontext) > 1} {
2291                incr repo_config(gui.diffcontext) -1
2292                reshow_diff
2293        }
2294}
2295######################################################################
2297##
2298## ui construction
2299load_config 0
2301apply_config
2302set ui_comm {}
2303# -- Menu Bar
2305#
2306menu .mbar -tearoff 0
2307if {[is_MacOSX]} {
2308        # -- Apple Menu (Mac OS X only)
2309        #
2310        .mbar add cascade -label Apple -menu .mbar.apple
2311        menu .mbar.apple
2312}
2313.mbar add cascade -label [mc Repository] -menu .mbar.repository
2314.mbar add cascade -label [mc Edit] -menu .mbar.edit
2315if {[is_enabled branch]} {
2316        .mbar add cascade -label [mc Branch] -menu .mbar.branch
2317}
2318if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2319        .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2320}
2321if {[is_enabled transport]} {
2322        .mbar add cascade -label [mc Merge] -menu .mbar.merge
2323        .mbar add cascade -label [mc Remote] -menu .mbar.remote
2324}
2325if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2326        .mbar add cascade -label [mc Tools] -menu .mbar.tools
2327}
2328# -- Repository Menu
2330#
2331menu .mbar.repository
2332.mbar.repository add command \
2334        -label [mc "Explore Working Copy"] \
2335        -command {do_explore}
2336.mbar.repository add separator
2337.mbar.repository add command \
2339        -label [mc "Browse Current Branch's Files"] \
2340        -command {browser::new $current_branch}
2341set ui_browse_current [.mbar.repository index last]
2342.mbar.repository add command \
2343        -label [mc "Browse Branch Files..."] \
2344        -command browser_open::dialog
2345.mbar.repository add separator
2346.mbar.repository add command \
2348        -label [mc "Visualize Current Branch's History"] \
2349        -command {do_gitk $current_branch}
2350set ui_visualize_current [.mbar.repository index last]
2351.mbar.repository add command \
2352        -label [mc "Visualize All Branch History"] \
2353        -command {do_gitk --all}
2354.mbar.repository add separator
2355proc current_branch_write {args} {
2357        global current_branch
2358        .mbar.repository entryconf $::ui_browse_current \
2359                -label [mc "Browse %s's Files" $current_branch]
2360        .mbar.repository entryconf $::ui_visualize_current \
2361                -label [mc "Visualize %s's History" $current_branch]
2362}
2363trace add variable current_branch write current_branch_write
2364if {[is_enabled multicommit]} {
2366        .mbar.repository add command -label [mc "Database Statistics"] \
2367                -command do_stats
2368        .mbar.repository add command -label [mc "Compress Database"] \
2370                -command do_gc
2371        .mbar.repository add command -label [mc "Verify Database"] \
2373                -command do_fsck_objects
2374        .mbar.repository add separator
2376        if {[is_Cygwin]} {
2378                .mbar.repository add command \
2379                        -label [mc "Create Desktop Icon"] \
2380                        -command do_cygwin_shortcut
2381        } elseif {[is_Windows]} {
2382                .mbar.repository add command \
2383                        -label [mc "Create Desktop Icon"] \
2384                        -command do_windows_shortcut
2385        } elseif {[is_MacOSX]} {
2386                .mbar.repository add command \
2387                        -label [mc "Create Desktop Icon"] \
2388                        -command do_macosx_app
2389        }
2390}
2391if {[is_MacOSX]} {
2393        proc ::tk::mac::Quit {args} { do_quit }
2394} else {
2395        .mbar.repository add command -label [mc Quit] \
2396                -command do_quit \
2397                -accelerator $M1T-Q
2398}
2399# -- Edit Menu
2401#
2402menu .mbar.edit
2403.mbar.edit add command -label [mc Undo] \
2404        -command {catch {[focus] edit undo}} \
2405        -accelerator $M1T-Z
2406.mbar.edit add command -label [mc Redo] \
2407        -command {catch {[focus] edit redo}} \
2408        -accelerator $M1T-Y
2409.mbar.edit add separator
2410.mbar.edit add command -label [mc Cut] \
2411        -command {catch {tk_textCut [focus]}} \
2412        -accelerator $M1T-X
2413.mbar.edit add command -label [mc Copy] \
2414        -command {catch {tk_textCopy [focus]}} \
2415        -accelerator $M1T-C
2416.mbar.edit add command -label [mc Paste] \
2417        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2418        -accelerator $M1T-V
2419.mbar.edit add command -label [mc Delete] \
2420        -command {catch {[focus] delete sel.first sel.last}} \
2421        -accelerator Del
2422.mbar.edit add separator
2423.mbar.edit add command -label [mc "Select All"] \
2424        -command {catch {[focus] tag add sel 0.0 end}} \
2425        -accelerator $M1T-A
2426# -- Branch Menu
2428#
2429if {[is_enabled branch]} {
2430        menu .mbar.branch
2431        .mbar.branch add command -label [mc "Create..."] \
2433                -command branch_create::dialog \
2434                -accelerator $M1T-N
2435        lappend disable_on_lock [list .mbar.branch entryconf \
2436                [.mbar.branch index last] -state]
2437        .mbar.branch add command -label [mc "Checkout..."] \
2439                -command branch_checkout::dialog \
2440                -accelerator $M1T-O
2441        lappend disable_on_lock [list .mbar.branch entryconf \
2442                [.mbar.branch index last] -state]
2443        .mbar.branch add command -label [mc "Rename..."] \
2445                -command branch_rename::dialog
2446        lappend disable_on_lock [list .mbar.branch entryconf \
2447                [.mbar.branch index last] -state]
2448        .mbar.branch add command -label [mc "Delete..."] \
2450                -command branch_delete::dialog
2451        lappend disable_on_lock [list .mbar.branch entryconf \
2452                [.mbar.branch index last] -state]
2453        .mbar.branch add command -label [mc "Reset..."] \
2455                -command merge::reset_hard
2456        lappend disable_on_lock [list .mbar.branch entryconf \
2457                [.mbar.branch index last] -state]
2458}
2459# -- Commit Menu
2461#
2462proc commit_btn_caption {} {
2463        if {[is_enabled nocommit]} {
2464                return [mc "Done"]
2465        } else {
2466                return [mc Commit@@verb]
2467        }
2468}
2469if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2471        menu .mbar.commit
2472        if {![is_enabled nocommit]} {
2474                .mbar.commit add radiobutton \
2475                        -label [mc "New Commit"] \
2476                        -command do_select_commit_type \
2477                        -variable selected_commit_type \
2478                        -value new
2479                lappend disable_on_lock \
2480                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2481                .mbar.commit add radiobutton \
2483                        -label [mc "Amend Last Commit"] \
2484                        -command do_select_commit_type \
2485                        -variable selected_commit_type \
2486                        -value amend
2487                lappend disable_on_lock \
2488                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2489                .mbar.commit add separator
2491        }
2492        .mbar.commit add command -label [mc Rescan] \
2494                -command ui_do_rescan \
2495                -accelerator F5
2496        lappend disable_on_lock \
2497                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2498        .mbar.commit add command -label [mc "Stage To Commit"] \
2500                -command do_add_selection \
2501                -accelerator $M1T-T
2502        lappend disable_on_lock \
2503                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2504        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2506                -command do_add_all \
2507                -accelerator $M1T-I
2508        lappend disable_on_lock \
2509                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2510        .mbar.commit add command -label [mc "Unstage From Commit"] \
2512                -command do_unstage_selection
2513        lappend disable_on_lock \
2514                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2515        .mbar.commit add command -label [mc "Revert Changes"] \
2517                -command do_revert_selection
2518        lappend disable_on_lock \
2519                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2520        .mbar.commit add separator
2522        .mbar.commit add command -label [mc "Show Less Context"] \
2524                -command show_less_context \
2525                -accelerator $M1T-\-
2526        .mbar.commit add command -label [mc "Show More Context"] \
2528                -command show_more_context \
2529                -accelerator $M1T-=
2530        .mbar.commit add separator
2532        if {![is_enabled nocommitmsg]} {
2534                .mbar.commit add command -label [mc "Sign Off"] \
2535                        -command do_signoff \
2536                        -accelerator $M1T-S
2537        }
2538        .mbar.commit add command -label [commit_btn_caption] \
2540                -command do_commit \
2541                -accelerator $M1T-Return
2542        lappend disable_on_lock \
2543                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2544}
2545# -- Merge Menu
2547#
2548if {[is_enabled branch]} {
2549        menu .mbar.merge
2550        .mbar.merge add command -label [mc "Local Merge..."] \
2551                -command merge::dialog \
2552                -accelerator $M1T-M
2553        lappend disable_on_lock \
2554                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2555        .mbar.merge add command -label [mc "Abort Merge..."] \
2556                -command merge::reset_hard
2557        lappend disable_on_lock \
2558                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2559}
2560# -- Transport Menu
2562#
2563if {[is_enabled transport]} {
2564        menu .mbar.remote
2565        .mbar.remote add command \
2567                -label [mc "Add..."] \
2568                -command remote_add::dialog \
2569                -accelerator $M1T-A
2570        .mbar.remote add command \
2571                -label [mc "Push..."] \
2572                -command do_push_anywhere \
2573                -accelerator $M1T-P
2574        .mbar.remote add command \
2575                -label [mc "Delete Branch..."] \
2576                -command remote_branch_delete::dialog
2577}
2578if {[is_MacOSX]} {
2580        proc ::tk::mac::ShowPreferences {} {do_options}
2581} else {
2582        # -- Edit Menu
2583        #
2584        .mbar.edit add separator
2585        .mbar.edit add command -label [mc "Options..."] \
2586                -command do_options
2587}
2588# -- Tools Menu
2590#
2591if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2592        set tools_menubar .mbar.tools
2593        menu $tools_menubar
2594        $tools_menubar add separator
2595        $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2596        $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2597        set tools_tailcnt 3
2598        if {[array names repo_config guitool.*.cmd] ne {}} {
2599                tools_populate_all
2600        }
2601}
2602# -- Help Menu
2604#
2605.mbar add cascade -label [mc Help] -menu .mbar.help
2606menu .mbar.help
2607if {[is_MacOSX]} {
2609        .mbar.apple add command -label [mc "About %s" [appname]] \
2610                -command do_about
2611        .mbar.apple add separator
2612} else {
2613        .mbar.help add command -label [mc "About %s" [appname]] \
2614                -command do_about
2615}
2616. configure -menu .mbar
2617set doc_path [githtmldir]
2619if {$doc_path ne {}} {
2620        set doc_path [file join $doc_path index.html]
2621        if {[is_Cygwin]} {
2623                set doc_path [exec cygpath --mixed $doc_path]
2624        }
2625}
2626if {[file isfile $doc_path]} {
2628        set doc_url "file:$doc_path"
2629} else {
2630        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2631}
2632proc start_browser {url} {
2634        git "web--browse" $url
2635}
2636.mbar.help add command -label [mc "Online Documentation"] \
2638        -command [list start_browser $doc_url]
2639.mbar.help add command -label [mc "Show SSH Key"] \
2641        -command do_ssh_key
2642unset doc_path doc_url
2644# -- Standard bindings
2646#
2647wm protocol . WM_DELETE_WINDOW do_quit
2648bind all <$M1B-Key-q> do_quit
2649bind all <$M1B-Key-Q> do_quit
2650bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2651bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2652set subcommand_args {}
2654proc usage {} {
2655        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2656        exit 1
2657}
2658proc normalize_relpath {path} {
2660        set elements {}
2661        foreach item [file split $path] {
2662                if {$item eq {.}} continue
2663                if {$item eq {..} && [llength $elements] > 0
2664                    && [lindex $elements end] ne {..}} {
2665                        set elements [lrange $elements 0 end-1]
2666                        continue
2667                }
2668                lappend elements $item
2669        }
2670        return [eval file join $elements]
2671}
2672# -- Not a normal commit type invocation?  Do that instead!
2674#
2675switch -- $subcommand {
2676browser -
2677blame {
2678        if {$subcommand eq "blame"} {
2679                set subcommand_args {[--line=<num>] rev? path}
2680        } else {
2681                set subcommand_args {rev? path}
2682        }
2683        if {$argv eq {}} usage
2684        set head {}
2685        set path {}
2686        set jump_spec {}
2687        set is_path 0
2688        foreach a $argv {
2689                if {$is_path || [file exists $_prefix$a]} {
2690                        if {$path ne {}} usage
2691                        set path [normalize_relpath $_prefix$a]
2692                        break
2693                } elseif {$a eq {--}} {
2694                        if {$path ne {}} {
2695                                if {$head ne {}} usage
2696                                set head $path
2697                                set path {}
2698                        }
2699                        set is_path 1
2700                } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2701                        if {$jump_spec ne {} || $head ne {}} usage
2702                        set jump_spec [list $lnum]
2703                } elseif {$head eq {}} {
2704                        if {$head ne {}} usage
2705                        set head $a
2706                        set is_path 1
2707                } else {
2708                        usage
2709                }
2710        }
2711        unset is_path
2712        if {$head ne {} && $path eq {}} {
2714                set path [normalize_relpath $_prefix$head]
2715                set head {}
2716        }
2717        if {$head eq {}} {
2719                load_current_branch
2720        } else {
2721                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2722                        if {[catch {
2723                                        set head [git rev-parse --verify $head]
2724                                } err]} {
2725                                puts stderr $err
2726                                exit 1
2727                        }
2728                }
2729                set current_branch $head
2730        }
2731        switch -- $subcommand {
2733        browser {
2734                if {$jump_spec ne {}} usage
2735                if {$head eq {}} {
2736                        if {$path ne {} && [file isdirectory $path]} {
2737                                set head $current_branch
2738                        } else {
2739                                set head $path
2740                                set path {}
2741                        }
2742                }
2743                browser::new $head $path
2744        }
2745        blame   {
2746                if {$head eq {} && ![file exists $path]} {
2747                        puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2748                        exit 1
2749                }
2750                blame::new $head $path $jump_spec
2751        }
2752        }
2753        return
2754}
2755citool -
2756gui {
2757        if {[llength $argv] != 0} {
2758                puts -nonewline stderr "usage: $argv0"
2759                if {$subcommand ne {gui}
2760                        && [file tail $argv0] ne "git-$subcommand"} {
2761                        puts -nonewline stderr " $subcommand"
2762                }
2763                puts stderr {}
2764                exit 1
2765        }
2766        # fall through to setup UI for commits
2767}
2768default {
2769        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2770        exit 1
2771}
2772}
2773# -- Branch Control
2775#
2776frame .branch \
2777        -borderwidth 1 \
2778        -relief sunken
2779label .branch.l1 \
2780        -text [mc "Current Branch:"] \
2781        -anchor w \
2782        -justify left
2783label .branch.cb \
2784        -textvariable current_branch \
2785        -anchor w \
2786        -justify left
2787pack .branch.l1 -side left
2788pack .branch.cb -side left -fill x
2789pack .branch -side top -fill x
2790# -- Main Window Layout
2792#
2793panedwindow .vpane -orient horizontal
2794panedwindow .vpane.files -orient vertical
2795.vpane add .vpane.files -sticky nsew -height 100 -width 200
2796pack .vpane -anchor n -side top -fill both -expand 1
2797# -- Index File List
2799#
2800frame .vpane.files.index -height 100 -width 200
2801label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2802        -background lightgreen -foreground black
2803text $ui_index -background white -foreground black \
2804        -borderwidth 0 \
2805        -width 20 -height 10 \
2806        -wrap none \
2807        -cursor $cursor_ptr \
2808        -xscrollcommand {.vpane.files.index.sx set} \
2809        -yscrollcommand {.vpane.files.index.sy set} \
2810        -state disabled
2811scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2812scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2813pack .vpane.files.index.title -side top -fill x
2814pack .vpane.files.index.sx -side bottom -fill x
2815pack .vpane.files.index.sy -side right -fill y
2816pack $ui_index -side left -fill both -expand 1
2817# -- Working Directory File List
2819#
2820frame .vpane.files.workdir -height 100 -width 200
2821label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2822        -background lightsalmon -foreground black
2823text $ui_workdir -background white -foreground black \
2824        -borderwidth 0 \
2825        -width 20 -height 10 \
2826        -wrap none \
2827        -cursor $cursor_ptr \
2828        -xscrollcommand {.vpane.files.workdir.sx set} \
2829        -yscrollcommand {.vpane.files.workdir.sy set} \
2830        -state disabled
2831scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2832scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2833pack .vpane.files.workdir.title -side top -fill x
2834pack .vpane.files.workdir.sx -side bottom -fill x
2835pack .vpane.files.workdir.sy -side right -fill y
2836pack $ui_workdir -side left -fill both -expand 1
2837.vpane.files add .vpane.files.workdir -sticky nsew
2839.vpane.files add .vpane.files.index -sticky nsew
2840foreach i [list $ui_index $ui_workdir] {
2842        rmsel_tag $i
2843        $i tag conf in_diff -background [$i tag cget in_sel -background]
2844}
2845unset i
2846# -- Diff and Commit Area
2848#
2849frame .vpane.lower -height 300 -width 400
2850frame .vpane.lower.commarea
2851frame .vpane.lower.diff -relief sunken -borderwidth 1
2852pack .vpane.lower.diff -fill both -expand 1
2853pack .vpane.lower.commarea -side bottom -fill x
2854.vpane add .vpane.lower -sticky nsew
2855# -- Commit Area Buttons
2857#
2858frame .vpane.lower.commarea.buttons
2859label .vpane.lower.commarea.buttons.l -text {} \
2860        -anchor w \
2861        -justify left
2862pack .vpane.lower.commarea.buttons.l -side top -fill x
2863pack .vpane.lower.commarea.buttons -side left -fill y
2864button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2866        -command ui_do_rescan
2867pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2868lappend disable_on_lock \
2869        {.vpane.lower.commarea.buttons.rescan conf -state}
2870button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2872        -command do_add_all
2873pack .vpane.lower.commarea.buttons.incall -side top -fill x
2874lappend disable_on_lock \
2875        {.vpane.lower.commarea.buttons.incall conf -state}
2876if {![is_enabled nocommitmsg]} {
2878        button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2879                -command do_signoff
2880        pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2881}
2882button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
2884        -command do_commit
2885pack .vpane.lower.commarea.buttons.commit -side top -fill x
2886lappend disable_on_lock \
2887        {.vpane.lower.commarea.buttons.commit conf -state}
2888if {![is_enabled nocommit]} {
2890        button .vpane.lower.commarea.buttons.push -text [mc Push] \
2891                -command do_push_anywhere
2892        pack .vpane.lower.commarea.buttons.push -side top -fill x
2893}
2894# -- Commit Message Buffer
2896#
2897frame .vpane.lower.commarea.buffer
2898frame .vpane.lower.commarea.buffer.header
2899set ui_comm .vpane.lower.commarea.buffer.t
2900set ui_coml .vpane.lower.commarea.buffer.header.l
2901if {![is_enabled nocommit]} {
2903        radiobutton .vpane.lower.commarea.buffer.header.new \
2904                -text [mc "New Commit"] \
2905                -command do_select_commit_type \
2906                -variable selected_commit_type \
2907                -value new
2908        lappend disable_on_lock \
2909                [list .vpane.lower.commarea.buffer.header.new conf -state]
2910        radiobutton .vpane.lower.commarea.buffer.header.amend \
2911                -text [mc "Amend Last Commit"] \
2912                -command do_select_commit_type \
2913                -variable selected_commit_type \
2914                -value amend
2915        lappend disable_on_lock \
2916                [list .vpane.lower.commarea.buffer.header.amend conf -state]
2917}
2918label $ui_coml \
2920        -anchor w \
2921        -justify left
2922proc trace_commit_type {varname args} {
2923        global ui_coml commit_type
2924        switch -glob -- $commit_type {
2925        initial       {set txt [mc "Initial Commit Message:"]}
2926        amend         {set txt [mc "Amended Commit Message:"]}
2927        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2928        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2929        merge         {set txt [mc "Merge Commit Message:"]}
2930        *             {set txt [mc "Commit Message:"]}
2931        }
2932        $ui_coml conf -text $txt
2933}
2934trace add variable commit_type write trace_commit_type
2935pack $ui_coml -side left -fill x
2936if {![is_enabled nocommit]} {
2938        pack .vpane.lower.commarea.buffer.header.amend -side right
2939        pack .vpane.lower.commarea.buffer.header.new -side right
2940}
2941text $ui_comm -background white -foreground black \
2943        -borderwidth 1 \
2944        -undo true \
2945        -maxundo 20 \
2946        -autoseparators true \
2947        -relief sunken \
2948        -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2949        -font font_diff \
2950        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2951scrollbar .vpane.lower.commarea.buffer.sby \
2952        -command [list $ui_comm yview]
2953pack .vpane.lower.commarea.buffer.header -side top -fill x
2954pack .vpane.lower.commarea.buffer.sby -side right -fill y
2955pack $ui_comm -side left -fill y
2956pack .vpane.lower.commarea.buffer -side left -fill y
2957# -- Commit Message Buffer Context Menu
2959#
2960set ctxm .vpane.lower.commarea.buffer.ctxm
2961menu $ctxm -tearoff 0
2962$ctxm add command \
2963        -label [mc Cut] \
2964        -command {tk_textCut $ui_comm}
2965$ctxm add command \
2966        -label [mc Copy] \
2967        -command {tk_textCopy $ui_comm}
2968$ctxm add command \
2969        -label [mc Paste] \
2970        -command {tk_textPaste $ui_comm}
2971$ctxm add command \
2972        -label [mc Delete] \
2973        -command {catch {$ui_comm delete sel.first sel.last}}
2974$ctxm add separator
2975$ctxm add command \
2976        -label [mc "Select All"] \
2977        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2978$ctxm add command \
2979        -label [mc "Copy All"] \
2980        -command {
2981                $ui_comm tag add sel 0.0 end
2982                tk_textCopy $ui_comm
2983                $ui_comm tag remove sel 0.0 end
2984        }
2985$ctxm add separator
2986$ctxm add command \
2987        -label [mc "Sign Off"] \
2988        -command do_signoff
2989set ui_comm_ctxm $ctxm
2990# -- Diff Header
2992#
2993proc trace_current_diff_path {varname args} {
2994        global current_diff_path diff_actions file_states
2995        if {$current_diff_path eq {}} {
2996                set s {}
2997                set f {}
2998                set p {}
2999                set o disabled
3000        } else {
3001                set p $current_diff_path
3002                set s [mapdesc [lindex $file_states($p) 0] $p]
3003                set f [mc "File:"]
3004                set p [escape_path $p]
3005                set o normal
3006        }
3007        .vpane.lower.diff.header.status configure -text $s
3009        .vpane.lower.diff.header.file configure -text $f
3010        .vpane.lower.diff.header.path configure -text $p
3011        foreach w $diff_actions {
3012                uplevel #0 $w $o
3013        }
3014}
3015trace add variable current_diff_path write trace_current_diff_path
3016frame .vpane.lower.diff.header -background gold
3018label .vpane.lower.diff.header.status \
3019        -background gold \
3020        -foreground black \
3021        -width $max_status_desc \
3022        -anchor w \
3023        -justify left
3024label .vpane.lower.diff.header.file \
3025        -background gold \
3026        -foreground black \
3027        -anchor w \
3028        -justify left
3029label .vpane.lower.diff.header.path \
3030        -background gold \
3031        -foreground black \
3032        -anchor w \
3033        -justify left
3034pack .vpane.lower.diff.header.status -side left
3035pack .vpane.lower.diff.header.file -side left
3036pack .vpane.lower.diff.header.path -fill x
3037set ctxm .vpane.lower.diff.header.ctxm
3038menu $ctxm -tearoff 0
3039$ctxm add command \
3040        -label [mc Copy] \
3041        -command {
3042                clipboard clear
3043                clipboard append \
3044                        -format STRING \
3045                        -type STRING \
3046                        -- $current_diff_path
3047        }
3048lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3049bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3050# -- Diff Body
3052#
3053frame .vpane.lower.diff.body
3054set ui_diff .vpane.lower.diff.body.t
3055text $ui_diff -background white -foreground black \
3056        -borderwidth 0 \
3057        -width 80 -height 15 -wrap none \
3058        -font font_diff \
3059        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3060        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3061        -state disabled
3062scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3063        -command [list $ui_diff xview]
3064scrollbar .vpane.lower.diff.body.sby -orient vertical \
3065        -command [list $ui_diff yview]
3066pack .vpane.lower.diff.body.sbx -side bottom -fill x
3067pack .vpane.lower.diff.body.sby -side right -fill y
3068pack $ui_diff -side left -fill both -expand 1
3069pack .vpane.lower.diff.header -side top -fill x
3070pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3071$ui_diff tag conf d_cr -elide true
3073$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3074$ui_diff tag conf d_+ -foreground {#00a000}
3075$ui_diff tag conf d_- -foreground red
3076$ui_diff tag conf d_++ -foreground {#00a000}
3078$ui_diff tag conf d_-- -foreground red
3079$ui_diff tag conf d_+s \
3080        -foreground {#00a000} \
3081        -background {#e2effa}
3082$ui_diff tag conf d_-s \
3083        -foreground red \
3084        -background {#e2effa}
3085$ui_diff tag conf d_s+ \
3086        -foreground {#00a000} \
3087        -background ivory1
3088$ui_diff tag conf d_s- \
3089        -foreground red \
3090        -background ivory1
3091$ui_diff tag conf d<<<<<<< \
3093        -foreground orange \
3094        -font font_diffbold
3095$ui_diff tag conf d======= \
3096        -foreground orange \
3097        -font font_diffbold
3098$ui_diff tag conf d>>>>>>> \
3099        -foreground orange \
3100        -font font_diffbold
3101$ui_diff tag raise sel
3103# -- Diff Body Context Menu
3105#
3106proc create_common_diff_popup {ctxm} {
3108        $ctxm add command \
3109                -label [mc "Show Less Context"] \
3110                -command show_less_context
3111        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3112        $ctxm add command \
3113                -label [mc "Show More Context"] \
3114                -command show_more_context
3115        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3116        $ctxm add separator
3117        $ctxm add command \
3118                -label [mc Refresh] \
3119                -command reshow_diff
3120        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3121        $ctxm add command \
3122                -label [mc Copy] \
3123                -command {tk_textCopy $ui_diff}
3124        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3125        $ctxm add command \
3126                -label [mc "Select All"] \
3127                -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3128        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3129        $ctxm add command \
3130                -label [mc "Copy All"] \
3131                -command {
3132                        $ui_diff tag add sel 0.0 end
3133                        tk_textCopy $ui_diff
3134                        $ui_diff tag remove sel 0.0 end
3135                }
3136        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3137        $ctxm add separator
3138        $ctxm add command \
3139                -label [mc "Decrease Font Size"] \
3140                -command {incr_font_size font_diff -1}
3141        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3142        $ctxm add command \
3143                -label [mc "Increase Font Size"] \
3144                -command {incr_font_size font_diff 1}
3145        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3146        $ctxm add separator
3147        set emenu $ctxm.enc
3148        menu $emenu
3149        build_encoding_menu $emenu [list force_diff_encoding]
3150        $ctxm add cascade \
3151                -label [mc "Encoding"] \
3152                -menu $emenu
3153        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3154        $ctxm add separator
3155        $ctxm add command -label [mc "Options..."] \
3156                -command do_options
3157}
3158set ctxm .vpane.lower.diff.body.ctxm
3160menu $ctxm -tearoff 0
3161$ctxm add command \
3162        -label [mc "Apply/Reverse Hunk"] \
3163        -command {apply_hunk $cursorX $cursorY}
3164set ui_diff_applyhunk [$ctxm index last]
3165lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3166$ctxm add command \
3167        -label [mc "Apply/Reverse Line"] \
3168        -command {apply_line $cursorX $cursorY; do_rescan}
3169set ui_diff_applyline [$ctxm index last]
3170lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3171$ctxm add separator
3172create_common_diff_popup $ctxm
3173set ctxmmg .vpane.lower.diff.body.ctxmmg
3175menu $ctxmmg -tearoff 0
3176$ctxmmg add command \
3177        -label [mc "Run Merge Tool"] \
3178        -command {merge_resolve_tool}
3179lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3180$ctxmmg add separator
3181$ctxmmg add command \
3182        -label [mc "Use Remote Version"] \
3183        -command {merge_resolve_one 3}
3184lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3185$ctxmmg add command \
3186        -label [mc "Use Local Version"] \
3187        -command {merge_resolve_one 2}
3188lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3189$ctxmmg add command \
3190        -label [mc "Revert To Base"] \
3191        -command {merge_resolve_one 1}
3192lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3193$ctxmmg add separator
3194create_common_diff_popup $ctxmmg
3195proc popup_diff_menu {ctxm ctxmmg x y X Y} {
3197        global current_diff_path file_states
3198        set ::cursorX $x
3199        set ::cursorY $y
3200        if {[info exists file_states($current_diff_path)]} {
3201                set state [lindex $file_states($current_diff_path) 0]
3202        } else {
3203                set state {__}
3204        }
3205        if {[string first {U} $state] >= 0} {
3206                tk_popup $ctxmmg $X $Y
3207        } else {
3208                if {$::ui_index eq $::current_diff_side} {
3209                        set l [mc "Unstage Hunk From Commit"]
3210                        set t [mc "Unstage Line From Commit"]
3211                } else {
3212                        set l [mc "Stage Hunk For Commit"]
3213                        set t [mc "Stage Line For Commit"]
3214                }
3215                if {$::is_3way_diff
3216                        || $current_diff_path eq {}
3217                        || {__} eq $state
3218                        || {_O} eq $state
3219                        || {_T} eq $state
3220                        || {T_} eq $state} {
3221                        set s disabled
3222                } else {
3223                        set s normal
3224                }
3225                $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3226                $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3227                tk_popup $ctxm $X $Y
3228        }
3229}
3230bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg %x %y %X %Y]
3231# -- Status Bar
3233#
3234set main_status [::status_bar::new .status]
3235pack .status -anchor w -side bottom -fill x
3236$main_status show [mc "Initializing..."]
3237# -- Load geometry
3239#
3240catch {
3241set gm $repo_config(gui.geometry)
3242wm geometry . [lindex $gm 0]
3243.vpane sash place 0 \
3244        [lindex $gm 1] \
3245        [lindex [.vpane sash coord 0] 1]
3246.vpane.files sash place 0 \
3247        [lindex [.vpane.files sash coord 0] 0] \
3248        [lindex $gm 2]
3249unset gm
3250}
3251# -- Key Bindings
3253#
3254bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3255bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3256bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3257bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3258bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3259bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3260bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3261bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3262bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3263bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3264bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3265bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3266bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3267bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3268bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3269bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3270bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3271bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3272bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3274bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3275bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3276bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3277bind $ui_diff <$M1B-Key-v> {break}
3278bind $ui_diff <$M1B-Key-V> {break}
3279bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3280bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3281bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3282bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3283bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3284bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3285bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3286bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3287bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3288bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3289bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3290bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3291bind $ui_diff <Button-1>   {focus %W}
3292if {[is_enabled branch]} {
3294        bind . <$M1B-Key-n> branch_create::dialog
3295        bind . <$M1B-Key-N> branch_create::dialog
3296        bind . <$M1B-Key-o> branch_checkout::dialog
3297        bind . <$M1B-Key-O> branch_checkout::dialog
3298        bind . <$M1B-Key-m> merge::dialog
3299        bind . <$M1B-Key-M> merge::dialog
3300}
3301if {[is_enabled transport]} {
3302        bind . <$M1B-Key-p> do_push_anywhere
3303        bind . <$M1B-Key-P> do_push_anywhere
3304}
3305bind .   <Key-F5>     ui_do_rescan
3307bind .   <$M1B-Key-r> ui_do_rescan
3308bind .   <$M1B-Key-R> ui_do_rescan
3309bind .   <$M1B-Key-s> do_signoff
3310bind .   <$M1B-Key-S> do_signoff
3311bind .   <$M1B-Key-t> do_add_selection
3312bind .   <$M1B-Key-T> do_add_selection
3313bind .   <$M1B-Key-i> do_add_all
3314bind .   <$M1B-Key-I> do_add_all
3315bind .   <$M1B-Key-minus> {show_less_context;break}
3316bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3317bind .   <$M1B-Key-equal> {show_more_context;break}
3318bind .   <$M1B-Key-plus> {show_more_context;break}
3319bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3320bind .   <$M1B-Key-Return> do_commit
3321foreach i [list $ui_index $ui_workdir] {
3322        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3323        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3324        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3325}
3326unset i
3327set file_lists($ui_index) [list]
3329set file_lists($ui_workdir) [list]
3330wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3332focus -force $ui_comm
3333# -- Warn the user about environmental problems.  Cygwin's Tcl
3335#    does *not* pass its env array onto any processes it spawns.
3336#    This means that git processes get none of our environment.
3337#
3338if {[is_Cygwin]} {
3339        set ignored_env 0
3340        set suggest_user {}
3341        set msg [mc "Possible environment issues exist.
3342The following environment variables are probably
3344going to be ignored by any Git subprocess run
3345by %s:
3346" [appname]]
3348        foreach name [array names env] {
3349                switch -regexp -- $name {
3350                {^GIT_INDEX_FILE$} -
3351                {^GIT_OBJECT_DIRECTORY$} -
3352                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3353                {^GIT_DIFF_OPTS$} -
3354                {^GIT_EXTERNAL_DIFF$} -
3355                {^GIT_PAGER$} -
3356                {^GIT_TRACE$} -
3357                {^GIT_CONFIG$} -
3358                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3359                        append msg " - $name\n"
3360                        incr ignored_env
3361                }
3362                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3363                        append msg " - $name\n"
3364                        incr ignored_env
3365                        set suggest_user $name
3366                }
3367                }
3368        }
3369        if {$ignored_env > 0} {
3370                append msg [mc "
3371This is due to a known issue with the
3372Tcl binary distributed by Cygwin."]
3373                if {$suggest_user ne {}} {
3375                        append msg [mc "
3376A good replacement for %s
3378is placing values for the user.name and
3379user.email settings into your personal
3380~/.gitconfig file.
3381" $suggest_user]
3382                }
3383                warn_popup $msg
3384        }
3385        unset ignored_env msg suggest_user name
3386}
3387# -- Only initialize complex UI if we are going to stay running.
3389#
3390if {[is_enabled transport]} {
3391        load_all_remotes
3392        set n [.mbar.remote index end]
3394        populate_remotes_menu
3395        set n [expr {[.mbar.remote index end] - $n}]
3396        if {$n > 0} {
3397                if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3398                .mbar.remote insert $n separator
3399        }
3400        unset n
3401}
3402if {[winfo exists $ui_comm]} {
3404        set GITGUI_BCK_exists [load_message GITGUI_BCK]
3405        # -- If both our backup and message files exist use the
3407        #    newer of the two files to initialize the buffer.
3408        #
3409        if {$GITGUI_BCK_exists} {
3410                set m [gitdir GITGUI_MSG]
3411                if {[file isfile $m]} {
3412                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3413                                catch {file delete [gitdir GITGUI_MSG]}
3414                        } else {
3415                                $ui_comm delete 0.0 end
3416                                $ui_comm edit reset
3417                                $ui_comm edit modified false
3418                                catch {file delete [gitdir GITGUI_BCK]}
3419                                set GITGUI_BCK_exists 0
3420                        }
3421                }
3422                unset m
3423        }
3424        proc backup_commit_buffer {} {
3426                global ui_comm GITGUI_BCK_exists
3427                set m [$ui_comm edit modified]
3429                if {$m || $GITGUI_BCK_exists} {
3430                        set msg [string trim [$ui_comm get 0.0 end]]
3431                        regsub -all -line {[ \r\t]+$} $msg {} msg
3432                        if {$msg eq {}} {
3434                                if {$GITGUI_BCK_exists} {
3435                                        catch {file delete [gitdir GITGUI_BCK]}
3436                                        set GITGUI_BCK_exists 0
3437                                }
3438                        } elseif {$m} {
3439                                catch {
3440                                        set fd [open [gitdir GITGUI_BCK] w]
3441                                        puts -nonewline $fd $msg
3442                                        close $fd
3443                                        set GITGUI_BCK_exists 1
3444                                }
3445                        }
3446                        $ui_comm edit modified false
3448                }
3449                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3451        }
3452        backup_commit_buffer
3454        # -- If the user has aspell available we can drive it
3456        #    in pipe mode to spellcheck the commit message.
3457        #
3458        set spell_cmd [list |]
3459        set spell_dict [get_config gui.spellingdictionary]
3460        lappend spell_cmd aspell
3461        if {$spell_dict ne {}} {
3462                lappend spell_cmd --master=$spell_dict
3463        }
3464        lappend spell_cmd --mode=none
3465        lappend spell_cmd --encoding=utf-8
3466        lappend spell_cmd pipe
3467        if {$spell_dict eq {none}
3468         || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3469                bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3470        } else {
3471                set ui_comm_spell [spellcheck::init \
3472                        $spell_fd \
3473                        $ui_comm \
3474                        $ui_comm_ctxm \
3475                ]
3476        }
3477        unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3478}
3479lock_index begin-read
3481if {![winfo ismapped .]} {
3482        wm deiconify .
3483}
3484after 1 {
3485        if {[is_enabled initialamend]} {
3486                force_amend
3487        } else {
3488                do_rescan
3489        }
3490        if {[is_enabled nocommitmsg]} {
3492                $ui_comm configure -state disabled -background gray
3493        }
3494}
3495if {[is_enabled multicommit]} {
3496        after 1000 hint_gc
3497}
3498if {[is_enabled retcode]} {
3499        bind . <Destroy> {+terminate_me %W}
3500}
3501if {$picked && [is_config_true gui.autoexplore]} {
3502        do_explore
3503}