git-gui/git-gui.sh

   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" -- "$@"
  11
  12 set appvers {@@GITGUI_VERSION@@}
  13 set copyright [string map [list (c) \u00a9] {
  14 Copyright (c) 2006-2010 Shawn Pearce, et. al.
  15
  16 This program is free software; you can redistribute it and/or modify
  17 it under the terms of the GNU General Public License as published by
  18 the Free Software Foundation; either version 2 of the License, or
  19 (at your option) any later version.
  20
  21 This program is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public License
  27 along with this program; if not, write to the Free Software
  28 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}]
  29
  30 ######################################################################
  31 ##
  32 ## Tcl/Tk sanity check
  33
  34 if {[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 "git-gui: fatal error" \
  42                 -message $err
  43         exit 1
  44 }
  45
  46 catch {rename send {}} ; # What an evil concept...
  47
  48 ######################################################################
  49 ##
  50 ## locate our library
  51
  52 set oguilib {@@GITGUI_LIBDIR@@}
  53 set oguirel {@@GITGUI_RELATIVE@@}
  54 if {$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 }
  68 unset oguirel
  69
  70 ######################################################################
  71 ##
  72 ## enable verbose loading?
  73
  74 if {![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         if {[tk windowingsystem] eq "win32"} { console show }
  87 }
  88
  89 ######################################################################
  90 ##
  91 ## Internationalization (i18n) through msgcat and gettext. See
  92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  93
  94 package require msgcat
  95
  96 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
  97 if {[tk windowingsystem] eq "win32"
  98         && [package vcompare [package provide msgcat] 1.4.4] < 0
  99 } then {
 100         proc _mc_update_locale {} {
 101                 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
 102                 if {![catch {
 103                         package require registry
 104                         set uilocale [registry get $key "PreferredUILanguages"]
 105                         msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
 106                 } uilocale]} {
 107                         if {[string length $uilocale] > 0} {
 108                                 msgcat::mclocale $uilocale
 109                         }
 110                 }
 111         }
 112         _mc_update_locale
 113 }
 114
 115 proc _mc_trim {fmt} {
 116         set cmk [string first @@ $fmt]
 117         if {$cmk > 0} {
 118                 return [string range $fmt 0 [expr {$cmk - 1}]]
 119         }
 120         return $fmt
 121 }
 122
 123 proc mc {en_fmt args} {
 124         set fmt [_mc_trim [::msgcat::mc $en_fmt]]
 125         if {[catch {set msg [eval [list format $fmt] $args]} err]} {
 126                 set msg [eval [list format [_mc_trim $en_fmt]] $args]
 127         }
 128         return $msg
 129 }
 130
 131 proc strcat {args} {
 132         return [join $args {}]
 133 }
 134
 135 ::msgcat::mcload $oguimsg
 136 unset oguimsg
 137
 138 ######################################################################
 139 ##
 140 ## read only globals
 141
 142 set _appname {Git Gui}
 143 set _gitdir {}
 144 set _gitworktree {}
 145 set _isbare {}
 146 set _gitexec {}
 147 set _githtmldir {}
 148 set _reponame {}
 149 set _iscygwin {}
 150 set _search_path {}
 151 set _shellpath {@@SHELL_PATH@@}
 152
 153 set _trace [lsearch -exact $argv --trace]
 154 if {$_trace >= 0} {
 155         set argv [lreplace $argv $_trace $_trace]
 156         set _trace 1
 157 } else {
 158         set _trace 0
 159 }
 160
 161 # variable for the last merged branch (useful for a default when deleting
 162 # branches).
 163 set _last_merged_branch {}
 164
 165 proc shellpath {} {
 166         global _shellpath env
 167         if {[string match @@* $_shellpath]} {
 168                 if {[info exists env(SHELL)]} {
 169                         return $env(SHELL)
 170                 } else {
 171                         return /bin/sh
 172                 }
 173         }
 174         return $_shellpath
 175 }
 176
 177 proc appname {} {
 178         global _appname
 179         return $_appname
 180 }
 181
 182 proc gitdir {args} {
 183         global _gitdir
 184         if {$args eq {}} {
 185                 return $_gitdir
 186         }
 187         return [eval [list file join $_gitdir] $args]
 188 }
 189
 190 proc gitexec {args} {
 191         global _gitexec
 192         if {$_gitexec eq {}} {
 193                 if {[catch {set _gitexec [git --exec-path]} err]} {
 194                         error "Git not installed?\n\n$err"
 195                 }
 196                 if {[is_Cygwin]} {
 197                         set _gitexec [exec cygpath \
 198                                 --windows \
 199                                 --absolute \
 200                                 $_gitexec]
 201                 } else {
 202                         set _gitexec [file normalize $_gitexec]
 203                 }
 204         }
 205         if {$args eq {}} {
 206                 return $_gitexec
 207         }
 208         return [eval [list file join $_gitexec] $args]
 209 }
 210
 211 proc githtmldir {args} {
 212         global _githtmldir
 213         if {$_githtmldir eq {}} {
 214                 if {[catch {set _githtmldir [git --html-path]}]} {
 215                         # Git not installed or option not yet supported
 216                         return {}
 217                 }
 218                 if {[is_Cygwin]} {
 219                         set _githtmldir [exec cygpath \
 220                                 --windows \
 221                                 --absolute \
 222                                 $_githtmldir]
 223                 } else {
 224                         set _githtmldir [file normalize $_githtmldir]
 225                 }
 226         }
 227         if {$args eq {}} {
 228                 return $_githtmldir
 229         }
 230         return [eval [list file join $_githtmldir] $args]
 231 }
 232
 233 proc reponame {} {
 234         return $::_reponame
 235 }
 236
 237 proc is_MacOSX {} {
 238         if {[tk windowingsystem] eq {aqua}} {
 239                 return 1
 240         }
 241         return 0
 242 }
 243
 244 proc is_Windows {} {
 245         if {$::tcl_platform(platform) eq {windows}} {
 246                 return 1
 247         }
 248         return 0
 249 }
 250
 251 proc is_Cygwin {} {
 252         global _iscygwin
 253         if {$_iscygwin eq {}} {
 254                 if {$::tcl_platform(platform) eq {windows}} {
 255                         if {[catch {set p [exec cygpath --windir]} err]} {
 256                                 set _iscygwin 0
 257                         } else {
 258                                 set _iscygwin 1
 259                         }
 260                 } else {
 261                         set _iscygwin 0
 262                 }
 263         }
 264         return $_iscygwin
 265 }
 266
 267 proc is_enabled {option} {
 268         global enabled_options
 269         if {[catch {set on $enabled_options($option)}]} {return 0}
 270         return $on
 271 }
 272
 273 proc enable_option {option} {
 274         global enabled_options
 275         set enabled_options($option) 1
 276 }
 277
 278 proc disable_option {option} {
 279         global enabled_options
 280         set enabled_options($option) 0
 281 }
 282
 283 ######################################################################
 284 ##
 285 ## config
 286
 287 proc is_many_config {name} {
 288         switch -glob -- $name {
 289         gui.recentrepo -
 290         remote.*.fetch -
 291         remote.*.push
 292                 {return 1}
 293         *
 294                 {return 0}
 295         }
 296 }
 297
 298 proc is_config_true {name} {
 299         global repo_config
 300         if {[catch {set v $repo_config($name)}]} {
 301                 return 0
 302         }
 303         set v [string tolower $v]
 304         if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
 305                 return 1
 306         } else {
 307                 return 0
 308         }
 309 }
 310
 311 proc is_config_false {name} {
 312         global repo_config
 313         if {[catch {set v $repo_config($name)}]} {
 314                 return 0
 315         }
 316         set v [string tolower $v]
 317         if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
 318                 return 1
 319         } else {
 320                 return 0
 321         }
 322 }
 323
 324 proc get_config {name} {
 325         global repo_config
 326         if {[catch {set v $repo_config($name)}]} {
 327                 return {}
 328         } else {
 329                 return $v
 330         }
 331 }
 332
 333 proc is_bare {} {
 334         global _isbare
 335         global _gitdir
 336         global _gitworktree
 337
 338         if {$_isbare eq {}} {
 339                 if {[catch {
 340                         set _bare [git rev-parse --is-bare-repository]
 341                         switch  -- $_bare {
 342                         true { set _isbare 1 }
 343                         false { set _isbare 0}
 344                         default { throw }
 345                         }
 346                 }]} {
 347                         if {[is_config_true core.bare]
 348                                 || ($_gitworktree eq {}
 349                                         && [lindex [file split $_gitdir] end] ne {.git})} {
 350                                 set _isbare 1
 351                         } else {
 352                                 set _isbare 0
 353                         }
 354                 }
 355         }
 356         return $_isbare
 357 }
 358
 359 ######################################################################
 360 ##
 361 ## handy utils
 362
 363 proc _trace_exec {cmd} {
 364         if {!$::_trace} return
 365         set d {}
 366         foreach v $cmd {
 367                 if {$d ne {}} {
 368                         append d { }
 369                 }
 370                 if {[regexp {[ \t\r\n'"$?*]} $v]} {
 371                         set v [sq $v]
 372                 }
 373                 append d $v
 374         }
 375         puts stderr $d
 376 }
 377
 378 #'"  fix poor old emacs font-lock mode
 379
 380 proc _git_cmd {name} {
 381         global _git_cmd_path
 382
 383         if {[catch {set v $_git_cmd_path($name)}]} {
 384                 switch -- $name {
 385                   version   -
 386                 --version   -
 387                 --exec-path { return [list $::_git $name] }
 388                 }
 389
 390                 set p [gitexec git-$name$::_search_exe]
 391                 if {[file exists $p]} {
 392                         set v [list $p]
 393                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 394                         # Try to determine what sort of magic will make
 395                         # git-$name go and do its thing, because native
 396                         # Tcl on Windows doesn't know it.
 397                         #
 398                         set p [gitexec git-$name]
 399                         set f [open $p r]
 400                         set s [gets $f]
 401                         close $f
 402
 403                         switch -glob -- [lindex $s 0] {
 404                         #!*sh     { set i sh     }
 405                         #!*perl   { set i perl   }
 406                         #!*python { set i python }
 407                         default   { error "git-$name is not supported: $s" }
 408                         }
 409
 410                         upvar #0 _$i interp
 411                         if {![info exists interp]} {
 412                                 set interp [_which $i]
 413                         }
 414                         if {$interp eq {}} {
 415                                 error "git-$name requires $i (not in PATH)"
 416                         }
 417                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 418                 } else {
 419                         # Assume it is builtin to git somehow and we
 420                         # aren't actually able to see a file for it.
 421                         #
 422                         set v [list $::_git $name]
 423                 }
 424                 set _git_cmd_path($name) $v
 425         }
 426         return $v
 427 }
 428
 429 proc _which {what args} {
 430         global env _search_exe _search_path
 431
 432         if {$_search_path eq {}} {
 433                 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 434                         set _search_path [split [exec cygpath \
 435                                 --windows \
 436                                 --path \
 437                                 --absolute \
 438                                 $env(PATH)] {;}]
 439                         set _search_exe .exe
 440                 } elseif {[is_Windows]} {
 441                         set gitguidir [file dirname [info script]]
 442                         regsub -all ";" $gitguidir "\\;" gitguidir
 443                         set env(PATH) "$gitguidir;$env(PATH)"
 444                         set _search_path [split $env(PATH) {;}]
 445                         set _search_exe .exe
 446                 } else {
 447                         set _search_path [split $env(PATH) :]
 448                         set _search_exe {}
 449                 }
 450         }
 451
 452         if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 453                 set suffix {}
 454         } else {
 455                 set suffix $_search_exe
 456         }
 457
 458         foreach p $_search_path {
 459                 set p [file join $p $what$suffix]
 460                 if {[file exists $p]} {
 461                         return [file normalize $p]
 462                 }
 463         }
 464         return {}
 465 }
 466
 467 # Test a file for a hashbang to identify executable scripts on Windows.
 468 proc is_shellscript {filename} {
 469         if {![file exists $filename]} {return 0}
 470         set f [open $filename r]
 471         fconfigure $f -encoding binary
 472         set magic [read $f 2]
 473         close $f
 474         return [expr {$magic eq "#!"}]
 475 }
 476
 477 # Run a command connected via pipes on stdout.
 478 # This is for use with textconv filters and uses sh -c "..." to allow it to
 479 # contain a command with arguments. On windows we must check for shell
 480 # scripts specifically otherwise just call the filter command.
 481 proc open_cmd_pipe {cmd path} {
 482         global env
 483         if {![file executable [shellpath]]} {
 484                 set exe [auto_execok [lindex $cmd 0]]
 485                 if {[is_shellscript [lindex $exe 0]]} {
 486                         set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
 487                 } else {
 488                         set run [concat $exe [lrange $cmd 1 end] $path]
 489                 }
 490         } else {
 491                 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
 492         }
 493         return [open |$run r]
 494 }
 495
 496 proc _lappend_nice {cmd_var} {
 497         global _nice
 498         upvar $cmd_var cmd
 499
 500         if {![info exists _nice]} {
 501                 set _nice [_which nice]
 502                 if {[catch {exec $_nice git version}]} {
 503                         set _nice {}
 504                 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
 505                         set _nice {}
 506                 }
 507         }
 508         if {$_nice ne {}} {
 509                 lappend cmd $_nice
 510         }
 511 }
 512
 513 proc git {args} {
 514         set opt [list]
 515
 516         while {1} {
 517                 switch -- [lindex $args 0] {
 518                 --nice {
 519                         _lappend_nice opt
 520                 }
 521
 522                 default {
 523                         break
 524                 }
 525
 526                 }
 527
 528                 set args [lrange $args 1 end]
 529         }
 530
 531         set cmdp [_git_cmd [lindex $args 0]]
 532         set args [lrange $args 1 end]
 533
 534         _trace_exec [concat $opt $cmdp $args]
 535         set result [eval exec $opt $cmdp $args]
 536         if {[encoding system] != "utf-8"} {
 537                 set result [encoding convertfrom utf-8 [encoding convertto $result]]
 538         }
 539         if {$::_trace} {
 540                 puts stderr "< $result"
 541         }
 542         return $result
 543 }
 544
 545 proc _open_stdout_stderr {cmd} {
 546         _trace_exec $cmd
 547         if {[catch {
 548                         set fd [open [concat [list | ] $cmd] r]
 549                 } err]} {
 550                 if {   [lindex $cmd end] eq {2>@1}
 551                     && $err eq {can not find channel named "1"}
 552                         } {
 553                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
 554                         # redirect operator.  Fallback to |& cat for those.
 555                         # The command was not actually started, so its safe
 556                         # to try to start it a second time.
 557                         #
 558                         set fd [open [concat \
 559                                 [list | ] \
 560                                 [lrange $cmd 0 end-1] \
 561                                 [list |& cat] \
 562                                 ] r]
 563                 } else {
 564                         error $err
 565                 }
 566         }
 567         fconfigure $fd -eofchar {}
 568         return $fd
 569 }
 570
 571 proc git_read {args} {
 572         set opt [list]
 573
 574         while {1} {
 575                 switch -- [lindex $args 0] {
 576                 --nice {
 577                         _lappend_nice opt
 578                 }
 579
 580                 --stderr {
 581                         lappend args 2>@1
 582                 }
 583
 584                 default {
 585                         break
 586                 }
 587
 588                 }
 589
 590                 set args [lrange $args 1 end]
 591         }
 592
 593         set cmdp [_git_cmd [lindex $args 0]]
 594         set args [lrange $args 1 end]
 595
 596         return [_open_stdout_stderr [concat $opt $cmdp $args]]
 597 }
 598
 599 proc git_write {args} {
 600         set opt [list]
 601
 602         while {1} {
 603                 switch -- [lindex $args 0] {
 604                 --nice {
 605                         _lappend_nice opt
 606                 }
 607
 608                 default {
 609                         break
 610                 }
 611
 612                 }
 613
 614                 set args [lrange $args 1 end]
 615         }
 616
 617         set cmdp [_git_cmd [lindex $args 0]]
 618         set args [lrange $args 1 end]
 619
 620         _trace_exec [concat $opt $cmdp $args]
 621         return [open [concat [list | ] $opt $cmdp $args] w]
 622 }
 623
 624 proc githook_read {hook_name args} {
 625         set pchook [gitdir hooks $hook_name]
 626         lappend args 2>@1
 627
 628         # On Windows [file executable] might lie so we need to ask
 629         # the shell if the hook is executable.  Yes that's annoying.
 630         #
 631         if {[is_Windows]} {
 632                 upvar #0 _sh interp
 633                 if {![info exists interp]} {
 634                         set interp [_which sh]
 635                 }
 636                 if {$interp eq {}} {
 637                         error "hook execution requires sh (not in PATH)"
 638                 }
 639
 640                 set scr {if test -x "$1";then exec "$@";fi}
 641                 set sh_c [list $interp -c $scr $interp $pchook]
 642                 return [_open_stdout_stderr [concat $sh_c $args]]
 643         }
 644
 645         if {[file executable $pchook]} {
 646                 return [_open_stdout_stderr [concat [list $pchook] $args]]
 647         }
 648
 649         return {}
 650 }
 651
 652 proc kill_file_process {fd} {
 653         set process [pid $fd]
 654
 655         catch {
 656                 if {[is_Windows]} {
 657                         # Use a Cygwin-specific flag to allow killing
 658                         # native Windows processes
 659                         exec kill -f $process
 660                 } else {
 661                         exec kill $process
 662                 }
 663         }
 664 }
 665
 666 proc gitattr {path attr default} {
 667         if {[catch {set r [git check-attr $attr -- $path]}]} {
 668                 set r unspecified
 669         } else {
 670                 set r [join [lrange [split $r :] 2 end] :]
 671                 regsub {^ } $r {} r
 672         }
 673         if {$r eq {unspecified}} {
 674                 return $default
 675         }
 676         return $r
 677 }
 678
 679 proc sq {value} {
 680         regsub -all ' $value "'\\''" value
 681         return "'$value'"
 682 }
 683
 684 proc load_current_branch {} {
 685         global current_branch is_detached
 686
 687         set fd [open [gitdir HEAD] r]
 688         if {[gets $fd ref] < 1} {
 689                 set ref {}
 690         }
 691         close $fd
 692
 693         set pfx {ref: refs/heads/}
 694         set len [string length $pfx]
 695         if {[string equal -length $len $pfx $ref]} {
 696                 # We're on a branch.  It might not exist.  But
 697                 # HEAD looks good enough to be a branch.
 698                 #
 699                 set current_branch [string range $ref $len end]
 700                 set is_detached 0
 701         } else {
 702                 # Assume this is a detached head.
 703                 #
 704                 set current_branch HEAD
 705                 set is_detached 1
 706         }
 707 }
 708
 709 auto_load tk_optionMenu
 710 rename tk_optionMenu real__tkOptionMenu
 711 proc tk_optionMenu {w varName args} {
 712         set m [eval real__tkOptionMenu $w $varName $args]
 713         $m configure -font font_ui
 714         $w configure -font font_ui
 715         return $m
 716 }
 717
 718 proc rmsel_tag {text} {
 719         $text tag conf sel \
 720                 -background [$text cget -background] \
 721                 -foreground [$text cget -foreground] \
 722                 -borderwidth 0
 723         $text tag conf in_sel -background lightgray
 724         bind $text <Motion> break
 725         return $text
 726 }
 727
 728 wm withdraw .
 729 set root_exists 0
 730 bind . <Visibility> {
 731         bind . <Visibility> {}
 732         set root_exists 1
 733 }
 734
 735 if {[is_Windows]} {
 736         wm iconbitmap . -default $oguilib/git-gui.ico
 737         set ::tk::AlwaysShowSelection 1
 738         bind . <Control-F2> {console show}
 739
 740         # Spoof an X11 display for SSH
 741         if {![info exists env(DISPLAY)]} {
 742                 set env(DISPLAY) :9999
 743         }
 744 } else {
 745         catch {
 746                 image create photo gitlogo -width 16 -height 16
 747
 748                 gitlogo put #33CC33 -to  7  0  9  2
 749                 gitlogo put #33CC33 -to  4  2 12  4
 750                 gitlogo put #33CC33 -to  7  4  9  6
 751                 gitlogo put #CC3333 -to  4  6 12  8
 752                 gitlogo put gray26  -to  4  9  6 10
 753                 gitlogo put gray26  -to  3 10  6 12
 754                 gitlogo put gray26  -to  8  9 13 11
 755                 gitlogo put gray26  -to  8 11 10 12
 756                 gitlogo put gray26  -to 11 11 13 14
 757                 gitlogo put gray26  -to  3 12  5 14
 758                 gitlogo put gray26  -to  5 13
 759                 gitlogo put gray26  -to 10 13
 760                 gitlogo put gray26  -to  4 14 12 15
 761                 gitlogo put gray26  -to  5 15 11 16
 762                 gitlogo redither
 763
 764                 image create photo gitlogo32 -width 32 -height 32
 765                 gitlogo32 copy gitlogo -zoom 2 2
 766
 767                 wm iconphoto . -default gitlogo gitlogo32
 768         }
 769 }
 770
 771 ######################################################################
 772 ##
 773 ## config defaults
 774
 775 set cursor_ptr arrow
 776 font create font_ui
 777 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
 778         eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
 779         eval [linsert [font actual TkFixedFont] 0 font create font_diff]
 780 } else {
 781         font create font_diff -family Courier -size 10
 782         catch {
 783                 label .dummy
 784                 eval font configure font_ui [font actual [.dummy cget -font]]
 785                 destroy .dummy
 786         }
 787 }
 788
 789 font create font_uiitalic
 790 font create font_uibold
 791 font create font_diffbold
 792 font create font_diffitalic
 793
 794 foreach class {Button Checkbutton Entry Label
 795                 Labelframe Listbox Message
 796                 Radiobutton Spinbox Text} {
 797         option add *$class.font font_ui
 798 }
 799 if {![is_MacOSX]} {
 800         option add *Menu.font font_ui
 801         option add *Entry.borderWidth 1 startupFile
 802         option add *Entry.relief sunken startupFile
 803         option add *RadioButton.anchor w startupFile
 804 }
 805 unset class
 806
 807 if {[is_Windows] || [is_MacOSX]} {
 808         option add *Menu.tearOff 0
 809 }
 810
 811 if {[is_MacOSX]} {
 812         set M1B M1
 813         set M1T Cmd
 814 } else {
 815         set M1B Control
 816         set M1T Ctrl
 817 }
 818
 819 proc bind_button3 {w cmd} {
 820         bind $w <Any-Button-3> $cmd
 821         if {[is_MacOSX]} {
 822                 # Mac OS X sends Button-2 on right click through three-button mouse,
 823                 # or through trackpad right-clicking (two-finger touch + click).
 824                 bind $w <Any-Button-2> $cmd
 825                 bind $w <Control-Button-1> $cmd
 826         }
 827 }
 828
 829 proc apply_config {} {
 830         global repo_config font_descs
 831
 832         foreach option $font_descs {
 833                 set name [lindex $option 0]
 834                 set font [lindex $option 1]
 835                 if {[catch {
 836                         set need_weight 1
 837                         foreach {cn cv} $repo_config(gui.$name) {
 838                                 if {$cn eq {-weight}} {
 839                                         set need_weight 0
 840                                 }
 841                                 font configure $font $cn $cv
 842                         }
 843                         if {$need_weight} {
 844                                 font configure $font -weight normal
 845                         }
 846                         } err]} {
 847                         error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 848                 }
 849                 foreach {cn cv} [font configure $font] {
 850                         font configure ${font}bold $cn $cv
 851                         font configure ${font}italic $cn $cv
 852                 }
 853                 font configure ${font}bold -weight bold
 854                 font configure ${font}italic -slant italic
 855         }
 856
 857         global use_ttk NS
 858         set use_ttk 0
 859         set NS {}
 860         if {$repo_config(gui.usettk)} {
 861                 set use_ttk [package vsatisfies [package provide Tk] 8.5]
 862                 if {$use_ttk} {
 863                         set NS ttk
 864                         bind [winfo class .] <<ThemeChanged>> [list InitTheme]
 865                         pave_toplevel .
 866                 }
 867         }
 868 }
 869
 870 set default_config(branch.autosetupmerge) true
 871 set default_config(merge.tool) {}
 872 set default_config(mergetool.keepbackup) true
 873 set default_config(merge.diffstat) true
 874 set default_config(merge.summary) false
 875 set default_config(merge.verbosity) 2
 876 set default_config(user.name) {}
 877 set default_config(user.email) {}
 878
 879 set default_config(gui.encoding) [encoding system]
 880 set default_config(gui.matchtrackingbranch) false
 881 set default_config(gui.textconv) true
 882 set default_config(gui.pruneduringfetch) false
 883 set default_config(gui.trustmtime) false
 884 set default_config(gui.fastcopyblame) false
 885 set default_config(gui.copyblamethreshold) 40
 886 set default_config(gui.blamehistoryctx) 7
 887 set default_config(gui.diffcontext) 5
 888 set default_config(gui.diffopts) {}
 889 set default_config(gui.commitmsgwidth) 75
 890 set default_config(gui.newbranchtemplate) {}
 891 set default_config(gui.spellingdictionary) {}
 892 set default_config(gui.fontui) [font configure font_ui]
 893 set default_config(gui.fontdiff) [font configure font_diff]
 894 # TODO: this option should be added to the git-config documentation
 895 set default_config(gui.maxfilesdisplayed) 5000
 896 set default_config(gui.usettk) 1
 897 set default_config(gui.warndetachedcommit) 1
 898 set font_descs {
 899         {fontui   font_ui   {mc "Main Font"}}
 900         {fontdiff font_diff {mc "Diff/Console Font"}}
 901 }
 902 set default_config(gui.stageuntracked) ask
 903
 904 ######################################################################
 905 ##
 906 ## find git
 907
 908 set _git  [_which git]
 909 if {$_git eq {}} {
 910         catch {wm withdraw .}
 911         tk_messageBox \
 912                 -icon error \
 913                 -type ok \
 914                 -title [mc "git-gui: fatal error"] \
 915                 -message [mc "Cannot find git in PATH."]
 916         exit 1
 917 }
 918
 919 ######################################################################
 920 ##
 921 ## version check
 922
 923 if {[catch {set _git_version [git --version]} err]} {
 924         catch {wm withdraw .}
 925         tk_messageBox \
 926                 -icon error \
 927                 -type ok \
 928                 -title [mc "git-gui: fatal error"] \
 929                 -message "Cannot determine Git version:
 930
 931 $err
 932
 933 [appname] requires Git 1.5.0 or later."
 934         exit 1
 935 }
 936 if {![regsub {^git version } $_git_version {} _git_version]} {
 937         catch {wm withdraw .}
 938         tk_messageBox \
 939                 -icon error \
 940                 -type ok \
 941                 -title [mc "git-gui: fatal error"] \
 942                 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 943         exit 1
 944 }
 945
 946 proc get_trimmed_version {s} {
 947     set r {}
 948     foreach x [split $s -._] {
 949         if {[string is integer -strict $x]} {
 950             lappend r $x
 951         } else {
 952             break
 953         }
 954     }
 955     return [join $r .]
 956 }
 957 set _real_git_version $_git_version
 958 set _git_version [get_trimmed_version $_git_version]
 959
 960 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 961         catch {wm withdraw .}
 962         if {[tk_messageBox \
 963                 -icon warning \
 964                 -type yesno \
 965                 -default no \
 966                 -title "[appname]: warning" \
 967                  -message [mc "Git version cannot be determined.
 968
 969 %s claims it is version '%s'.
 970
 971 %s requires at least Git 1.5.0 or later.
 972
 973 Assume '%s' is version 1.5.0?
 974 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 975                 set _git_version 1.5.0
 976         } else {
 977                 exit 1
 978         }
 979 }
 980 unset _real_git_version
 981
 982 proc git-version {args} {
 983         global _git_version
 984
 985         switch [llength $args] {
 986         0 {
 987                 return $_git_version
 988         }
 989
 990         2 {
 991                 set op [lindex $args 0]
 992                 set vr [lindex $args 1]
 993                 set cm [package vcompare $_git_version $vr]
 994                 return [expr $cm $op 0]
 995         }
 996
 997         4 {
 998                 set type [lindex $args 0]
 999                 set name [lindex $args 1]
1000                 set parm [lindex $args 2]
1001                 set body [lindex $args 3]
1002
1003                 if {($type ne {proc} && $type ne {method})} {
1004                         error "Invalid arguments to git-version"
1005                 }
1006                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1007                         error "Last arm of $type $name must be default"
1008                 }
1009
1010                 foreach {op vr cb} [lrange $body 0 end-2] {
1011                         if {[git-version $op $vr]} {
1012                                 return [uplevel [list $type $name $parm $cb]]
1013                         }
1014                 }
1015
1016                 return [uplevel [list $type $name $parm [lindex $body end]]]
1017         }
1018
1019         default {
1020                 error "git-version >= x"
1021         }
1022
1023         }
1024 }
1025
1026 if {[git-version < 1.5]} {
1027         catch {wm withdraw .}
1028         tk_messageBox \
1029                 -icon error \
1030                 -type ok \
1031                 -title [mc "git-gui: fatal error"] \
1032                 -message "[appname] requires Git 1.5.0 or later.
1033
1034 You are using [git-version]:
1035
1036 [git --version]"
1037         exit 1
1038 }
1039
1040 ######################################################################
1041 ##
1042 ## configure our library
1043
1044 set idx [file join $oguilib tclIndex]
1045 if {[catch {set fd [open $idx r]} err]} {
1046         catch {wm withdraw .}
1047         tk_messageBox \
1048                 -icon error \
1049                 -type ok \
1050                 -title [mc "git-gui: fatal error"] \
1051                 -message $err
1052         exit 1
1053 }
1054 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1055         set idx [list]
1056         while {[gets $fd n] >= 0} {
1057                 if {$n ne {} && ![string match #* $n]} {
1058                         lappend idx $n
1059                 }
1060         }
1061 } else {
1062         set idx {}
1063 }
1064 close $fd
1065
1066 if {$idx ne {}} {
1067         set loaded [list]
1068         foreach p $idx {
1069                 if {[lsearch -exact $loaded $p] >= 0} continue
1070                 source [file join $oguilib $p]
1071                 lappend loaded $p
1072         }
1073         unset loaded p
1074 } else {
1075         set auto_path [concat [list $oguilib] $auto_path]
1076 }
1077 unset -nocomplain idx fd
1078
1079 ######################################################################
1080 ##
1081 ## config file parsing
1082
1083 git-version proc _parse_config {arr_name args} {
1084         >= 1.5.3 {
1085                 upvar $arr_name arr
1086                 array unset arr
1087                 set buf {}
1088                 catch {
1089                         set fd_rc [eval \
1090                                 [list git_read config] \
1091                                 $args \
1092                                 [list --null --list]]
1093                         fconfigure $fd_rc -translation binary -encoding utf-8
1094                         set buf [read $fd_rc]
1095                         close $fd_rc
1096                 }
1097                 foreach line [split $buf "\0"] {
1098                         if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1099                                 if {[is_many_config $name]} {
1100                                         lappend arr($name) $value
1101                                 } else {
1102                                         set arr($name) $value
1103                                 }
1104                         } elseif {[regexp {^([^\n]+)$} $line line name]} {
1105                                 # no value given, but interpreting them as
1106                                 # boolean will be handled as true
1107                                 set arr($name) {}
1108                         }
1109                 }
1110         }
1111         default {
1112                 upvar $arr_name arr
1113                 array unset arr
1114                 catch {
1115                         set fd_rc [eval [list git_read config --list] $args]
1116                         while {[gets $fd_rc line] >= 0} {
1117                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1118                                         if {[is_many_config $name]} {
1119                                                 lappend arr($name) $value
1120                                         } else {
1121                                                 set arr($name) $value
1122                                         }
1123                                 } elseif {[regexp {^([^=]+)$} $line line name]} {
1124                                         # no value given, but interpreting them as
1125                                         # boolean will be handled as true
1126                                         set arr($name) {}
1127                                 }
1128                         }
1129                         close $fd_rc
1130                 }
1131         }
1132 }
1133
1134 proc load_config {include_global} {
1135         global repo_config global_config system_config default_config
1136
1137         if {$include_global} {
1138                 _parse_config system_config --system
1139                 _parse_config global_config --global
1140         }
1141         _parse_config repo_config
1142
1143         foreach name [array names default_config] {
1144                 if {[catch {set v $system_config($name)}]} {
1145                         set system_config($name) $default_config($name)
1146                 }
1147         }
1148         foreach name [array names system_config] {
1149                 if {[catch {set v $global_config($name)}]} {
1150                         set global_config($name) $system_config($name)
1151                 }
1152                 if {[catch {set v $repo_config($name)}]} {
1153                         set repo_config($name) $system_config($name)
1154                 }
1155         }
1156 }
1157
1158 ######################################################################
1159 ##
1160 ## feature option selection
1161
1162 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1163         unset _junk
1164 } else {
1165         set subcommand gui
1166 }
1167 if {$subcommand eq {gui.sh}} {
1168         set subcommand gui
1169 }
1170 if {$subcommand eq {gui} && [llength $argv] > 0} {
1171         set subcommand [lindex $argv 0]
1172         set argv [lrange $argv 1 end]
1173 }
1174
1175 enable_option multicommit
1176 enable_option branch
1177 enable_option transport
1178 disable_option bare
1179
1180 switch -- $subcommand {
1181 browser -
1182 blame {
1183         enable_option bare
1184
1185         disable_option multicommit
1186         disable_option branch
1187         disable_option transport
1188 }
1189 citool {
1190         enable_option singlecommit
1191         enable_option retcode
1192
1193         disable_option multicommit
1194         disable_option branch
1195         disable_option transport
1196
1197         while {[llength $argv] > 0} {
1198                 set a [lindex $argv 0]
1199                 switch -- $a {
1200                 --amend {
1201                         enable_option initialamend
1202                 }
1203                 --nocommit {
1204                         enable_option nocommit
1205                         enable_option nocommitmsg
1206                 }
1207                 --commitmsg {
1208                         disable_option nocommitmsg
1209                 }
1210                 default {
1211                         break
1212                 }
1213                 }
1214
1215                 set argv [lrange $argv 1 end]
1216         }
1217 }
1218 }
1219
1220 ######################################################################
1221 ##
1222 ## execution environment
1223
1224 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1225
1226 # Suggest our implementation of askpass, if none is set
1227 if {![info exists env(SSH_ASKPASS)]} {
1228         set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1229 }
1230 if {![info exists env(GIT_ASKPASS)]} {
1231         set env(GIT_ASKPASS) [gitexec git-gui--askpass]
1232 }
1233 if {![info exists env(GIT_ASK_YESNO)]} {
1234         set env(GIT_ASK_YESNO) [gitexec git-gui--askyesno]
1235 }
1236
1237 ######################################################################
1238 ##
1239 ## repository setup
1240
1241 set picked 0
1242 if {[catch {
1243                 set _gitdir $env(GIT_DIR)
1244                 set _prefix {}
1245                 }]
1246         && [catch {
1247                 # beware that from the .git dir this sets _gitdir to .
1248                 # and _prefix to the empty string
1249                 set _gitdir [git rev-parse --git-dir]
1250                 set _prefix [git rev-parse --show-prefix]
1251         } err]} {
1252         load_config 1
1253         apply_config
1254         choose_repository::pick
1255         set picked 1
1256 }
1257
1258 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1259 # run from the .git dir itself) lest the routines to find the worktree
1260 # get confused
1261 if {$_gitdir eq "."} {
1262         set _gitdir [pwd]
1263 }
1264
1265 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1266         catch {set _gitdir [exec cygpath --windows $_gitdir]}
1267 }
1268 if {![file isdirectory $_gitdir]} {
1269         catch {wm withdraw .}
1270         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1271         exit 1
1272 }
1273 # _gitdir exists, so try loading the config
1274 load_config 0
1275 apply_config
1276
1277 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1278 if {[package vsatisfies $_git_version 1.7.0]} {
1279         set _gitworktree [git rev-parse --show-toplevel]
1280 } else {
1281         # try to set work tree from environment, core.worktree or use
1282         # cdup to obtain a relative path to the top of the worktree. If
1283         # run from the top, the ./ prefix ensures normalize expands pwd.
1284         if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1285                 set _gitworktree [get_config core.worktree]
1286                 if {$_gitworktree eq ""} {
1287                         set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1288                 }
1289         }
1290 }
1291
1292 if {$_prefix ne {}} {
1293         if {$_gitworktree eq {}} {
1294                 regsub -all {[^/]+/} $_prefix ../ cdup
1295         } else {
1296                 set cdup $_gitworktree
1297         }
1298         if {[catch {cd $cdup} err]} {
1299                 catch {wm withdraw .}
1300                 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1301                 exit 1
1302         }
1303         set _gitworktree [pwd]
1304         unset cdup
1305 } elseif {![is_enabled bare]} {
1306         if {[is_bare]} {
1307                 catch {wm withdraw .}
1308                 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1309                 exit 1
1310         }
1311         if {$_gitworktree eq {}} {
1312                 set _gitworktree [file dirname $_gitdir]
1313         }
1314         if {[catch {cd $_gitworktree} err]} {
1315                 catch {wm withdraw .}
1316                 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1317                 exit 1
1318         }
1319         set _gitworktree [pwd]
1320 }
1321 set _reponame [file split [file normalize $_gitdir]]
1322 if {[lindex $_reponame end] eq {.git}} {
1323         set _reponame [lindex $_reponame end-1]
1324 } else {
1325         set _reponame [lindex $_reponame end]
1326 }
1327
1328 ######################################################################
1329 ##
1330 ## global init
1331
1332 set current_diff_path {}
1333 set current_diff_side {}
1334 set diff_actions [list]
1335
1336 set HEAD {}
1337 set PARENT {}
1338 set MERGE_HEAD [list]
1339 set commit_type {}
1340 set empty_tree {}
1341 set current_branch {}
1342 set is_detached 0
1343 set current_diff_path {}
1344 set is_3way_diff 0
1345 set is_submodule_diff 0
1346 set is_conflict_diff 0
1347 set selected_commit_type new
1348 set diff_empty_count 0
1349
1350 set nullid "0000000000000000000000000000000000000000"
1351 set nullid2 "0000000000000000000000000000000000000001"
1352
1353 ######################################################################
1354 ##
1355 ## task management
1356
1357 set rescan_active 0
1358 set diff_active 0
1359 set last_clicked {}
1360
1361 set disable_on_lock [list]
1362 set index_lock_type none
1363
1364 proc lock_index {type} {
1365         global index_lock_type disable_on_lock
1366
1367         if {$index_lock_type eq {none}} {
1368                 set index_lock_type $type
1369                 foreach w $disable_on_lock {
1370                         uplevel #0 $w disabled
1371                 }
1372                 return 1
1373         } elseif {$index_lock_type eq "begin-$type"} {
1374                 set index_lock_type $type
1375                 return 1
1376         }
1377         return 0
1378 }
1379
1380 proc unlock_index {} {
1381         global index_lock_type disable_on_lock
1382
1383         set index_lock_type none
1384         foreach w $disable_on_lock {
1385                 uplevel #0 $w normal
1386         }
1387 }
1388
1389 ######################################################################
1390 ##
1391 ## status
1392
1393 proc repository_state {ctvar hdvar mhvar} {
1394         global current_branch
1395         upvar $ctvar ct $hdvar hd $mhvar mh
1396
1397         set mh [list]
1398
1399         load_current_branch
1400         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1401                 set hd {}
1402                 set ct initial
1403                 return
1404         }
1405
1406         set merge_head [gitdir MERGE_HEAD]
1407         if {[file exists $merge_head]} {
1408                 set ct merge
1409                 set fd_mh [open $merge_head r]
1410                 while {[gets $fd_mh line] >= 0} {
1411                         lappend mh $line
1412                 }
1413                 close $fd_mh
1414                 return
1415         }
1416
1417         set ct normal
1418 }
1419
1420 proc PARENT {} {
1421         global PARENT empty_tree
1422
1423         set p [lindex $PARENT 0]
1424         if {$p ne {}} {
1425                 return $p
1426         }
1427         if {$empty_tree eq {}} {
1428                 set empty_tree [git mktree << {}]
1429         }
1430         return $empty_tree
1431 }
1432
1433 proc force_amend {} {
1434         global selected_commit_type
1435         global HEAD PARENT MERGE_HEAD commit_type
1436
1437         repository_state newType newHEAD newMERGE_HEAD
1438         set HEAD $newHEAD
1439         set PARENT $newHEAD
1440         set MERGE_HEAD $newMERGE_HEAD
1441         set commit_type $newType
1442
1443         set selected_commit_type amend
1444         do_select_commit_type
1445 }
1446
1447 proc rescan {after {honor_trustmtime 1}} {
1448         global HEAD PARENT MERGE_HEAD commit_type
1449         global ui_index ui_workdir ui_comm
1450         global rescan_active file_states
1451         global repo_config
1452
1453         if {$rescan_active > 0 || ![lock_index read]} return
1454
1455         repository_state newType newHEAD newMERGE_HEAD
1456         if {[string match amend* $commit_type]
1457                 && $newType eq {normal}
1458                 && $newHEAD eq $HEAD} {
1459         } else {
1460                 set HEAD $newHEAD
1461                 set PARENT $newHEAD
1462                 set MERGE_HEAD $newMERGE_HEAD
1463                 set commit_type $newType
1464         }
1465
1466         array unset file_states
1467
1468         if {!$::GITGUI_BCK_exists &&
1469                 (![$ui_comm edit modified]
1470                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1471                 if {[string match amend* $commit_type]} {
1472                 } elseif {[load_message GITGUI_MSG]} {
1473                 } elseif {[run_prepare_commit_msg_hook]} {
1474                 } elseif {[load_message MERGE_MSG]} {
1475                 } elseif {[load_message SQUASH_MSG]} {
1476                 }
1477                 $ui_comm edit reset
1478                 $ui_comm edit modified false
1479         }
1480
1481         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1482                 rescan_stage2 {} $after
1483         } else {
1484                 set rescan_active 1
1485                 ui_status [mc "Refreshing file status..."]
1486                 set fd_rf [git_read update-index \
1487                         -q \
1488                         --unmerged \
1489                         --ignore-missing \
1490                         --refresh \
1491                         ]
1492                 fconfigure $fd_rf -blocking 0 -translation binary
1493                 fileevent $fd_rf readable \
1494                         [list rescan_stage2 $fd_rf $after]
1495         }
1496 }
1497
1498 if {[is_Cygwin]} {
1499         set is_git_info_exclude {}
1500         proc have_info_exclude {} {
1501                 global is_git_info_exclude
1502
1503                 if {$is_git_info_exclude eq {}} {
1504                         if {[catch {exec test -f [gitdir info exclude]}]} {
1505                                 set is_git_info_exclude 0
1506                         } else {
1507                                 set is_git_info_exclude 1
1508                         }
1509                 }
1510                 return $is_git_info_exclude
1511         }
1512 } else {
1513         proc have_info_exclude {} {
1514                 return [file readable [gitdir info exclude]]
1515         }
1516 }
1517
1518 proc rescan_stage2 {fd after} {
1519         global rescan_active buf_rdi buf_rdf buf_rlo
1520
1521         if {$fd ne {}} {
1522                 read $fd
1523                 if {![eof $fd]} return
1524                 close $fd
1525         }
1526
1527         if {[package vsatisfies $::_git_version 1.6.3]} {
1528                 set ls_others [list --exclude-standard]
1529         } else {
1530                 set ls_others [list --exclude-per-directory=.gitignore]
1531                 if {[have_info_exclude]} {
1532                         lappend ls_others "--exclude-from=[gitdir info exclude]"
1533                 }
1534                 set user_exclude [get_config core.excludesfile]
1535                 if {$user_exclude ne {} && [file readable $user_exclude]} {
1536                         lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1537                 }
1538         }
1539
1540         set buf_rdi {}
1541         set buf_rdf {}
1542         set buf_rlo {}
1543
1544         set rescan_active 3
1545         ui_status [mc "Scanning for modified files ..."]
1546         set fd_di [git_read diff-index --cached -z [PARENT]]
1547         set fd_df [git_read diff-files -z]
1548         set fd_lo [eval git_read ls-files --others -z $ls_others]
1549
1550         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1551         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1552         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1553         fileevent $fd_di readable [list read_diff_index $fd_di $after]
1554         fileevent $fd_df readable [list read_diff_files $fd_df $after]
1555         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1556 }
1557
1558 proc load_message {file} {
1559         global ui_comm
1560
1561         set f [gitdir $file]
1562         if {[file isfile $f]} {
1563                 if {[catch {set fd [open $f r]}]} {
1564                         return 0
1565                 }
1566                 fconfigure $fd -eofchar {}
1567                 set content [string trim [read $fd]]
1568                 close $fd
1569                 regsub -all -line {[ \r\t]+$} $content {} content
1570                 $ui_comm delete 0.0 end
1571                 $ui_comm insert end $content
1572                 return 1
1573         }
1574         return 0
1575 }
1576
1577 proc run_prepare_commit_msg_hook {} {
1578         global pch_error
1579
1580         # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1581         # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1582         # empty file but existent file.
1583
1584         set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1585
1586         if {[file isfile [gitdir MERGE_MSG]]} {
1587                 set pcm_source "merge"
1588                 set fd_mm [open [gitdir MERGE_MSG] r]
1589                 puts -nonewline $fd_pcm [read $fd_mm]
1590                 close $fd_mm
1591         } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1592                 set pcm_source "squash"
1593                 set fd_sm [open [gitdir SQUASH_MSG] r]
1594                 puts -nonewline $fd_pcm [read $fd_sm]
1595                 close $fd_sm
1596         } else {
1597                 set pcm_source ""
1598         }
1599
1600         close $fd_pcm
1601
1602         set fd_ph [githook_read prepare-commit-msg \
1603                         [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1604         if {$fd_ph eq {}} {
1605                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1606                 return 0;
1607         }
1608
1609         ui_status [mc "Calling prepare-commit-msg hook..."]
1610         set pch_error {}
1611
1612         fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1613         fileevent $fd_ph readable \
1614                 [list prepare_commit_msg_hook_wait $fd_ph]
1615
1616         return 1;
1617 }
1618
1619 proc prepare_commit_msg_hook_wait {fd_ph} {
1620         global pch_error
1621
1622         append pch_error [read $fd_ph]
1623         fconfigure $fd_ph -blocking 1
1624         if {[eof $fd_ph]} {
1625                 if {[catch {close $fd_ph}]} {
1626                         ui_status [mc "Commit declined by prepare-commit-msg hook."]
1627                         hook_failed_popup prepare-commit-msg $pch_error
1628                         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1629                         exit 1
1630                 } else {
1631                         load_message PREPARE_COMMIT_MSG
1632                 }
1633                 set pch_error {}
1634                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1635                 return
1636         }
1637         fconfigure $fd_ph -blocking 0
1638         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1639 }
1640
1641 proc read_diff_index {fd after} {
1642         global buf_rdi
1643
1644         append buf_rdi [read $fd]
1645         set c 0
1646         set n [string length $buf_rdi]
1647         while {$c < $n} {
1648                 set z1 [string first "\0" $buf_rdi $c]
1649                 if {$z1 == -1} break
1650                 incr z1
1651                 set z2 [string first "\0" $buf_rdi $z1]
1652                 if {$z2 == -1} break
1653
1654                 incr c
1655                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1656                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1657                 merge_state \
1658                         [encoding convertfrom utf-8 $p] \
1659                         [lindex $i 4]? \
1660                         [list [lindex $i 0] [lindex $i 2]] \
1661                         [list]
1662                 set c $z2
1663                 incr c
1664         }
1665         if {$c < $n} {
1666                 set buf_rdi [string range $buf_rdi $c end]
1667         } else {
1668                 set buf_rdi {}
1669         }
1670
1671         rescan_done $fd buf_rdi $after
1672 }
1673
1674 proc read_diff_files {fd after} {
1675         global buf_rdf
1676
1677         append buf_rdf [read $fd]
1678         set c 0
1679         set n [string length $buf_rdf]
1680         while {$c < $n} {
1681                 set z1 [string first "\0" $buf_rdf $c]
1682                 if {$z1 == -1} break
1683                 incr z1
1684                 set z2 [string first "\0" $buf_rdf $z1]
1685                 if {$z2 == -1} break
1686
1687                 incr c
1688                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1689                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1690                 merge_state \
1691                         [encoding convertfrom utf-8 $p] \
1692                         ?[lindex $i 4] \
1693                         [list] \
1694                         [list [lindex $i 0] [lindex $i 2]]
1695                 set c $z2
1696                 incr c
1697         }
1698         if {$c < $n} {
1699                 set buf_rdf [string range $buf_rdf $c end]
1700         } else {
1701                 set buf_rdf {}
1702         }
1703
1704         rescan_done $fd buf_rdf $after
1705 }
1706
1707 proc read_ls_others {fd after} {
1708         global buf_rlo
1709
1710         append buf_rlo [read $fd]
1711         set pck [split $buf_rlo "\0"]
1712         set buf_rlo [lindex $pck end]
1713         foreach p [lrange $pck 0 end-1] {
1714                 set p [encoding convertfrom utf-8 $p]
1715                 if {[string index $p end] eq {/}} {
1716                         set p [string range $p 0 end-1]
1717                 }
1718                 merge_state $p ?O
1719         }
1720         rescan_done $fd buf_rlo $after
1721 }
1722
1723 proc rescan_done {fd buf after} {
1724         global rescan_active current_diff_path
1725         global file_states repo_config
1726         upvar $buf to_clear
1727
1728         if {![eof $fd]} return
1729         set to_clear {}
1730         close $fd
1731         if {[incr rescan_active -1] > 0} return
1732
1733         prune_selection
1734         unlock_index
1735         display_all_files
1736         if {$current_diff_path ne {}} { reshow_diff $after }
1737         if {$current_diff_path eq {}} { select_first_diff $after }
1738 }
1739
1740 proc prune_selection {} {
1741         global file_states selected_paths
1742
1743         foreach path [array names selected_paths] {
1744                 if {[catch {set still_here $file_states($path)}]} {
1745                         unset selected_paths($path)
1746                 }
1747         }
1748 }
1749
1750 ######################################################################
1751 ##
1752 ## ui helpers
1753
1754 proc mapicon {w state path} {
1755         global all_icons
1756
1757         if {[catch {set r $all_icons($state$w)}]} {
1758                 puts "error: no icon for $w state={$state} $path"
1759                 return file_plain
1760         }
1761         return $r
1762 }
1763
1764 proc mapdesc {state path} {
1765         global all_descs
1766
1767         if {[catch {set r $all_descs($state)}]} {
1768                 puts "error: no desc for state={$state} $path"
1769                 return $state
1770         }
1771         return $r
1772 }
1773
1774 proc ui_status {msg} {
1775         global main_status
1776         if {[info exists main_status]} {
1777                 $main_status show $msg
1778         }
1779 }
1780
1781 proc ui_ready {{test {}}} {
1782         global main_status
1783         if {[info exists main_status]} {
1784                 $main_status show [mc "Ready."] $test
1785         }
1786 }
1787
1788 proc escape_path {path} {
1789         regsub -all {\\} $path "\\\\" path
1790         regsub -all "\n" $path "\\n" path
1791         return $path
1792 }
1793
1794 proc short_path {path} {
1795         return [escape_path [lindex [file split $path] end]]
1796 }
1797
1798 set next_icon_id 0
1799 set null_sha1 [string repeat 0 40]
1800
1801 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1802         global file_states next_icon_id null_sha1
1803
1804         set s0 [string index $new_state 0]
1805         set s1 [string index $new_state 1]
1806
1807         if {[catch {set info $file_states($path)}]} {
1808                 set state __
1809                 set icon n[incr next_icon_id]
1810         } else {
1811                 set state [lindex $info 0]
1812                 set icon [lindex $info 1]
1813                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1814                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1815         }
1816
1817         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1818         elseif {$s0 eq {_}} {set s0 _}
1819
1820         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1821         elseif {$s1 eq {_}} {set s1 _}
1822
1823         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1824                 set head_info [list 0 $null_sha1]
1825         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1826                 && $head_info eq {}} {
1827                 set head_info $index_info
1828         } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1829                 set index_info $head_info
1830                 set head_info {}
1831         }
1832
1833         set file_states($path) [list $s0$s1 $icon \
1834                 $head_info $index_info \
1835                 ]
1836         return $state
1837 }
1838
1839 proc display_file_helper {w path icon_name old_m new_m} {
1840         global file_lists
1841
1842         if {$new_m eq {_}} {
1843                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1844                 if {$lno >= 0} {
1845                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1846                         incr lno
1847                         $w conf -state normal
1848                         $w delete $lno.0 [expr {$lno + 1}].0
1849                         $w conf -state disabled
1850                 }
1851         } elseif {$old_m eq {_} && $new_m ne {_}} {
1852                 lappend file_lists($w) $path
1853                 set file_lists($w) [lsort -unique $file_lists($w)]
1854                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1855                 incr lno
1856                 $w conf -state normal
1857                 $w image create $lno.0 \
1858                         -align center -padx 5 -pady 1 \
1859                         -name $icon_name \
1860                         -image [mapicon $w $new_m $path]
1861                 $w insert $lno.1 "[escape_path $path]\n"
1862                 $w conf -state disabled
1863         } elseif {$old_m ne $new_m} {
1864                 $w conf -state normal
1865                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1866                 $w conf -state disabled
1867         }
1868 }
1869
1870 proc display_file {path state} {
1871         global file_states selected_paths
1872         global ui_index ui_workdir
1873
1874         set old_m [merge_state $path $state]
1875         set s $file_states($path)
1876         set new_m [lindex $s 0]
1877         set icon_name [lindex $s 1]
1878
1879         set o [string index $old_m 0]
1880         set n [string index $new_m 0]
1881         if {$o eq {U}} {
1882                 set o _
1883         }
1884         if {$n eq {U}} {
1885                 set n _
1886         }
1887         display_file_helper     $ui_index $path $icon_name $o $n
1888
1889         if {[string index $old_m 0] eq {U}} {
1890                 set o U
1891         } else {
1892                 set o [string index $old_m 1]
1893         }
1894         if {[string index $new_m 0] eq {U}} {
1895                 set n U
1896         } else {
1897                 set n [string index $new_m 1]
1898         }
1899         display_file_helper     $ui_workdir $path $icon_name $o $n
1900
1901         if {$new_m eq {__}} {
1902                 unset file_states($path)
1903                 catch {unset selected_paths($path)}
1904         }
1905 }
1906
1907 proc display_all_files_helper {w path icon_name m} {
1908         global file_lists
1909
1910         lappend file_lists($w) $path
1911         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1912         $w image create end \
1913                 -align center -padx 5 -pady 1 \
1914                 -name $icon_name \
1915                 -image [mapicon $w $m $path]
1916         $w insert end "[escape_path $path]\n"
1917 }
1918
1919 set files_warning 0
1920 proc display_all_files {} {
1921         global ui_index ui_workdir
1922         global file_states file_lists
1923         global last_clicked
1924         global files_warning
1925
1926         $ui_index conf -state normal
1927         $ui_workdir conf -state normal
1928
1929         $ui_index delete 0.0 end
1930         $ui_workdir delete 0.0 end
1931         set last_clicked {}
1932
1933         set file_lists($ui_index) [list]
1934         set file_lists($ui_workdir) [list]
1935
1936         set to_display [lsort [array names file_states]]
1937         set display_limit [get_config gui.maxfilesdisplayed]
1938         if {[llength $to_display] > $display_limit} {
1939                 if {!$files_warning} {
1940                         # do not repeatedly warn:
1941                         set files_warning 1
1942                         info_popup [mc "Displaying only %s of %s files." \
1943                                 $display_limit [llength $to_display]]
1944                 }
1945                 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1946         }
1947         foreach path $to_display {
1948                 set s $file_states($path)
1949                 set m [lindex $s 0]
1950                 set icon_name [lindex $s 1]
1951
1952                 set s [string index $m 0]
1953                 if {$s ne {U} && $s ne {_}} {
1954                         display_all_files_helper $ui_index $path \
1955                                 $icon_name $s
1956                 }
1957
1958                 if {[string index $m 0] eq {U}} {
1959                         set s U
1960                 } else {
1961                         set s [string index $m 1]
1962                 }
1963                 if {$s ne {_}} {
1964                         display_all_files_helper $ui_workdir $path \
1965                                 $icon_name $s
1966                 }
1967         }
1968
1969         $ui_index conf -state disabled
1970         $ui_workdir conf -state disabled
1971 }
1972
1973 ######################################################################
1974 ##
1975 ## icons
1976
1977 set filemask {
1978 #define mask_width 14
1979 #define mask_height 15
1980 static unsigned char mask_bits[] = {
1981    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1982    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1983    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1984 }
1985
1986 image create bitmap file_plain -background white -foreground black -data {
1987 #define plain_width 14
1988 #define plain_height 15
1989 static unsigned char plain_bits[] = {
1990    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1991    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1992    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1993 } -maskdata $filemask
1994
1995 image create bitmap file_mod -background white -foreground blue -data {
1996 #define mod_width 14
1997 #define mod_height 15
1998 static unsigned char mod_bits[] = {
1999    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2000    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2001    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2002 } -maskdata $filemask
2003
2004 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2005 #define file_fulltick_width 14
2006 #define file_fulltick_height 15
2007 static unsigned char file_fulltick_bits[] = {
2008    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2009    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2010    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2011 } -maskdata $filemask
2012
2013 image create bitmap file_question -background white -foreground black -data {
2014 #define file_question_width 14
2015 #define file_question_height 15
2016 static unsigned char file_question_bits[] = {
2017    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2018    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2019    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2020 } -maskdata $filemask
2021
2022 image create bitmap file_removed -background white -foreground red -data {
2023 #define file_removed_width 14
2024 #define file_removed_height 15
2025 static unsigned char file_removed_bits[] = {
2026    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2027    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2028    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2029 } -maskdata $filemask
2030
2031 image create bitmap file_merge -background white -foreground blue -data {
2032 #define file_merge_width 14
2033 #define file_merge_height 15
2034 static unsigned char file_merge_bits[] = {
2035    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2036    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2037    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2038 } -maskdata $filemask
2039
2040 image create bitmap file_statechange -background white -foreground green -data {
2041 #define file_statechange_width 14
2042 #define file_statechange_height 15
2043 static unsigned char file_statechange_bits[] = {
2044    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2045    0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2046    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2047 } -maskdata $filemask
2048
2049 set ui_index .vpane.files.index.list
2050 set ui_workdir .vpane.files.workdir.list
2051
2052 set all_icons(_$ui_index)   file_plain
2053 set all_icons(A$ui_index)   file_plain
2054 set all_icons(M$ui_index)   file_fulltick
2055 set all_icons(D$ui_index)   file_removed
2056 set all_icons(U$ui_index)   file_merge
2057 set all_icons(T$ui_index)   file_statechange
2058
2059 set all_icons(_$ui_workdir) file_plain
2060 set all_icons(M$ui_workdir) file_mod
2061 set all_icons(D$ui_workdir) file_question
2062 set all_icons(U$ui_workdir) file_merge
2063 set all_icons(O$ui_workdir) file_plain
2064 set all_icons(T$ui_workdir) file_statechange
2065
2066 set max_status_desc 0
2067 foreach i {
2068                 {__ {mc "Unmodified"}}
2069
2070                 {_M {mc "Modified, not staged"}}
2071                 {M_ {mc "Staged for commit"}}
2072                 {MM {mc "Portions staged for commit"}}
2073                 {MD {mc "Staged for commit, missing"}}
2074
2075                 {_T {mc "File type changed, not staged"}}
2076                 {MT {mc "File type changed, old type staged for commit"}}
2077                 {AT {mc "File type changed, old type staged for commit"}}
2078                 {T_ {mc "File type changed, staged"}}
2079                 {TM {mc "File type change staged, modification not staged"}}
2080                 {TD {mc "File type change staged, file missing"}}
2081
2082                 {_O {mc "Untracked, not staged"}}
2083                 {A_ {mc "Staged for commit"}}
2084                 {AM {mc "Portions staged for commit"}}
2085                 {AD {mc "Staged for commit, missing"}}
2086
2087                 {_D {mc "Missing"}}
2088                 {D_ {mc "Staged for removal"}}
2089                 {DO {mc "Staged for removal, still present"}}
2090
2091                 {_U {mc "Requires merge resolution"}}
2092                 {U_ {mc "Requires merge resolution"}}
2093                 {UU {mc "Requires merge resolution"}}
2094                 {UM {mc "Requires merge resolution"}}
2095                 {UD {mc "Requires merge resolution"}}
2096                 {UT {mc "Requires merge resolution"}}
2097         } {
2098         set text [eval [lindex $i 1]]
2099         if {$max_status_desc < [string length $text]} {
2100                 set max_status_desc [string length $text]
2101         }
2102         set all_descs([lindex $i 0]) $text
2103 }
2104 unset i
2105
2106 ######################################################################
2107 ##
2108 ## util
2109
2110 proc scrollbar2many {list mode args} {
2111         foreach w $list {eval $w $mode $args}
2112 }
2113
2114 proc many2scrollbar {list mode sb top bottom} {
2115         $sb set $top $bottom
2116         foreach w $list {$w $mode moveto $top}
2117 }
2118
2119 proc incr_font_size {font {amt 1}} {
2120         set sz [font configure $font -size]
2121         incr sz $amt
2122         font configure $font -size $sz
2123         font configure ${font}bold -size $sz
2124         font configure ${font}italic -size $sz
2125 }
2126
2127 ######################################################################
2128 ##
2129 ## ui commands
2130
2131 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2132
2133 proc do_gitk {revs {is_submodule false}} {
2134         global current_diff_path file_states current_diff_side ui_index
2135         global _gitworktree
2136
2137         # -- Always start gitk through whatever we were loaded with.  This
2138         #    lets us bypass using shell process on Windows systems.
2139         #
2140         set exe [_which gitk -script]
2141         set cmd [list [info nameofexecutable] $exe]
2142         if {$exe eq {}} {
2143                 error_popup [mc "Couldn't find gitk in PATH"]
2144         } else {
2145                 global env
2146
2147                 if {[info exists env(GIT_DIR)]} {
2148                         set old_GIT_DIR $env(GIT_DIR)
2149                 } else {
2150                         set old_GIT_DIR {}
2151                 }
2152
2153                 set pwd [pwd]
2154
2155                 if {!$is_submodule} {
2156                         if {![is_bare]} {
2157                                 cd $_gitworktree
2158                         }
2159                         set env(GIT_DIR) [file normalize [gitdir]]
2160                 } else {
2161                         cd $current_diff_path
2162                         if {$revs eq {--}} {
2163                                 set s $file_states($current_diff_path)
2164                                 set old_sha1 {}
2165                                 set new_sha1 {}
2166                                 switch -glob -- [lindex $s 0] {
2167                                 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2168                                 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2169                                 MM {
2170                                         if {$current_diff_side eq $ui_index} {
2171                                                 set old_sha1 [lindex [lindex $s 2] 1]
2172                                                 set new_sha1 [lindex [lindex $s 3] 1]
2173                                         } else {
2174                                                 set old_sha1 [lindex [lindex $s 3] 1]
2175                                         }
2176                                 }
2177                                 }
2178                                 set revs $old_sha1...$new_sha1
2179                         }
2180                         if {[info exists env(GIT_DIR)]} {
2181                                 unset env(GIT_DIR)
2182                         }
2183                 }
2184                 eval exec $cmd $revs "--" "--" &
2185
2186                 if {$old_GIT_DIR ne {}} {
2187                         set env(GIT_DIR) $old_GIT_DIR
2188                 }
2189                 cd $pwd
2190
2191                 ui_status $::starting_gitk_msg
2192                 after 10000 {
2193                         ui_ready $starting_gitk_msg
2194                 }
2195         }
2196 }
2197
2198 proc do_git_gui {} {
2199         global current_diff_path
2200
2201         # -- Always start git gui through whatever we were loaded with.  This
2202         #    lets us bypass using shell process on Windows systems.
2203         #
2204         set exe [list [_which git]]
2205         if {$exe eq {}} {
2206                 error_popup [mc "Couldn't find git gui in PATH"]
2207         } else {
2208                 global env
2209
2210                 if {[info exists env(GIT_DIR)]} {
2211                         set old_GIT_DIR $env(GIT_DIR)
2212                         unset env(GIT_DIR)
2213                 } else {
2214                         set old_GIT_DIR {}
2215                 }
2216
2217                 set pwd [pwd]
2218                 cd $current_diff_path
2219
2220                 eval exec $exe gui &
2221
2222                 if {$old_GIT_DIR ne {}} {
2223                         set env(GIT_DIR) $old_GIT_DIR
2224                 }
2225                 cd $pwd
2226
2227                 ui_status $::starting_gitk_msg
2228                 after 10000 {
2229                         ui_ready $starting_gitk_msg
2230                 }
2231         }
2232 }
2233
2234 proc do_explore {} {
2235         global _gitworktree
2236         set explorer {}
2237         if {[is_Cygwin] || [is_Windows]} {
2238                 set explorer "explorer.exe"
2239         } elseif {[is_MacOSX]} {
2240                 set explorer "open"
2241         } else {
2242                 # freedesktop.org-conforming system is our best shot
2243                 set explorer "xdg-open"
2244         }
2245         eval exec $explorer [list [file nativename $_gitworktree]] &
2246 }
2247
2248 set is_quitting 0
2249 set ret_code    1
2250
2251 proc terminate_me {win} {
2252         global ret_code
2253         if {$win ne {.}} return
2254         exit $ret_code
2255 }
2256
2257 proc do_quit {{rc {1}}} {
2258         global ui_comm is_quitting repo_config commit_type
2259         global GITGUI_BCK_exists GITGUI_BCK_i
2260         global ui_comm_spell
2261         global ret_code use_ttk
2262
2263         if {$is_quitting} return
2264         set is_quitting 1
2265
2266         if {[winfo exists $ui_comm]} {
2267                 # -- Stash our current commit buffer.
2268                 #
2269                 set save [gitdir GITGUI_MSG]
2270                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2271                         file rename -force [gitdir GITGUI_BCK] $save
2272                         set GITGUI_BCK_exists 0
2273                 } else {
2274                         set msg [string trim [$ui_comm get 0.0 end]]
2275                         regsub -all -line {[ \r\t]+$} $msg {} msg
2276                         if {(![string match amend* $commit_type]
2277                                 || [$ui_comm edit modified])
2278                                 && $msg ne {}} {
2279                                 catch {
2280                                         set fd [open $save w]
2281                                         puts -nonewline $fd $msg
2282                                         close $fd
2283                                 }
2284                         } else {
2285                                 catch {file delete $save}
2286                         }
2287                 }
2288
2289                 # -- Cancel our spellchecker if its running.
2290                 #
2291                 if {[info exists ui_comm_spell]} {
2292                         $ui_comm_spell stop
2293                 }
2294
2295                 # -- Remove our editor backup, its not needed.
2296                 #
2297                 after cancel $GITGUI_BCK_i
2298                 if {$GITGUI_BCK_exists} {
2299                         catch {file delete [gitdir GITGUI_BCK]}
2300                 }
2301
2302                 # -- Stash our current window geometry into this repository.
2303                 #
2304                 set cfg_wmstate [wm state .]
2305                 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2306                         set rc_wmstate {}
2307                 }
2308                 if {$cfg_wmstate ne $rc_wmstate} {
2309                         catch {git config gui.wmstate $cfg_wmstate}
2310                 }
2311                 if {$cfg_wmstate eq {zoomed}} {
2312                         # on Windows wm geometry will lie about window
2313                         # position (but not size) when window is zoomed
2314                         # restore the window before querying wm geometry
2315                         wm state . normal
2316                 }
2317                 set cfg_geometry [list]
2318                 lappend cfg_geometry [wm geometry .]
2319                 if {$use_ttk} {
2320                         lappend cfg_geometry [.vpane sashpos 0]
2321                         lappend cfg_geometry [.vpane.files sashpos 0]
2322                 } else {
2323                         lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2324                         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2325                 }
2326                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2327                         set rc_geometry {}
2328                 }
2329                 if {$cfg_geometry ne $rc_geometry} {
2330                         catch {git config gui.geometry $cfg_geometry}
2331                 }
2332         }
2333
2334         set ret_code $rc
2335
2336         # Briefly enable send again, working around Tk bug
2337         # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2338         tk appname [appname]
2339
2340         destroy .
2341 }
2342
2343 proc do_rescan {} {
2344         rescan ui_ready
2345 }
2346
2347 proc ui_do_rescan {} {
2348         rescan {force_first_diff ui_ready}
2349 }
2350
2351 proc do_commit {} {
2352         commit_tree
2353 }
2354
2355 proc next_diff {{after {}}} {
2356         global next_diff_p next_diff_w next_diff_i
2357         show_diff $next_diff_p $next_diff_w {} {} $after
2358 }
2359
2360 proc find_anchor_pos {lst name} {
2361         set lid [lsearch -sorted -exact $lst $name]
2362
2363         if {$lid == -1} {
2364                 set lid 0
2365                 foreach lname $lst {
2366                         if {$lname >= $name} break
2367                         incr lid
2368                 }
2369         }
2370
2371         return $lid
2372 }
2373
2374 proc find_file_from {flist idx delta path mmask} {
2375         global file_states
2376
2377         set len [llength $flist]
2378         while {$idx >= 0 && $idx < $len} {
2379                 set name [lindex $flist $idx]
2380
2381                 if {$name ne $path && [info exists file_states($name)]} {
2382                         set state [lindex $file_states($name) 0]
2383
2384                         if {$mmask eq {} || [regexp $mmask $state]} {
2385                                 return $idx
2386                         }
2387                 }
2388
2389                 incr idx $delta
2390         }
2391
2392         return {}
2393 }
2394
2395 proc find_next_diff {w path {lno {}} {mmask {}}} {
2396         global next_diff_p next_diff_w next_diff_i
2397         global file_lists ui_index ui_workdir
2398
2399         set flist $file_lists($w)
2400         if {$lno eq {}} {
2401                 set lno [find_anchor_pos $flist $path]
2402         } else {
2403                 incr lno -1
2404         }
2405
2406         if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2407                 if {$w eq $ui_index} {
2408                         set mmask "^$mmask"
2409                 } else {
2410                         set mmask "$mmask\$"
2411                 }
2412         }
2413
2414         set idx [find_file_from $flist $lno 1 $path $mmask]
2415         if {$idx eq {}} {
2416                 incr lno -1
2417                 set idx [find_file_from $flist $lno -1 $path $mmask]
2418         }
2419
2420         if {$idx ne {}} {
2421                 set next_diff_w $w
2422                 set next_diff_p [lindex $flist $idx]
2423                 set next_diff_i [expr {$idx+1}]
2424                 return 1
2425         } else {
2426                 return 0
2427         }
2428 }
2429
2430 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2431         global current_diff_path
2432
2433         if {$path ne $current_diff_path} {
2434                 return {}
2435         } elseif {[find_next_diff $w $path $lno $mmask]} {
2436                 return {next_diff;}
2437         } else {
2438                 return {reshow_diff;}
2439         }
2440 }
2441
2442 proc select_first_diff {after} {
2443         global ui_workdir
2444
2445         if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2446             [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2447                 next_diff $after
2448         } else {
2449                 uplevel #0 $after
2450         }
2451 }
2452
2453 proc force_first_diff {after} {
2454         global ui_workdir current_diff_path file_states
2455
2456         if {[info exists file_states($current_diff_path)]} {
2457                 set state [lindex $file_states($current_diff_path) 0]
2458         } else {
2459                 set state {OO}
2460         }
2461
2462         set reselect 0
2463         if {[string first {U} $state] >= 0} {
2464                 # Already a conflict, do nothing
2465         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2466                 set reselect 1
2467         } elseif {[string index $state 1] ne {O}} {
2468                 # Already a diff & no conflicts, do nothing
2469         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2470                 set reselect 1
2471         }
2472
2473         if {$reselect} {
2474                 next_diff $after
2475         } else {
2476                 uplevel #0 $after
2477         }
2478 }
2479
2480 proc toggle_or_diff {w x y} {
2481         global file_states file_lists current_diff_path ui_index ui_workdir
2482         global last_clicked selected_paths
2483
2484         set pos [split [$w index @$x,$y] .]
2485         set lno [lindex $pos 0]
2486         set col [lindex $pos 1]
2487         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2488         if {$path eq {}} {
2489                 set last_clicked {}
2490                 return
2491         }
2492
2493         set last_clicked [list $w $lno]
2494         array unset selected_paths
2495         $ui_index tag remove in_sel 0.0 end
2496         $ui_workdir tag remove in_sel 0.0 end
2497
2498         # Determine the state of the file
2499         if {[info exists file_states($path)]} {
2500                 set state [lindex $file_states($path) 0]
2501         } else {
2502                 set state {__}
2503         }
2504
2505         # Restage the file, or simply show the diff
2506         if {$col == 0 && $y > 1} {
2507                 # Conflicts need special handling
2508                 if {[string first {U} $state] >= 0} {
2509                         # $w must always be $ui_workdir, but...
2510                         if {$w ne $ui_workdir} { set lno {} }
2511                         merge_stage_workdir $path $lno
2512                         return
2513                 }
2514
2515                 if {[string index $state 1] eq {O}} {
2516                         set mmask {}
2517                 } else {
2518                         set mmask {[^O]}
2519                 }
2520
2521                 set after [next_diff_after_action $w $path $lno $mmask]
2522
2523                 if {$w eq $ui_index} {
2524                         update_indexinfo \
2525                                 "Unstaging [short_path $path] from commit" \
2526                                 [list $path] \
2527                                 [concat $after [list ui_ready]]
2528                 } elseif {$w eq $ui_workdir} {
2529                         update_index \
2530                                 "Adding [short_path $path]" \
2531                                 [list $path] \
2532                                 [concat $after [list ui_ready]]
2533                 }
2534         } else {
2535                 set selected_paths($path) 1
2536                 show_diff $path $w $lno
2537         }
2538 }
2539
2540 proc add_one_to_selection {w x y} {
2541         global file_lists last_clicked selected_paths
2542
2543         set lno [lindex [split [$w index @$x,$y] .] 0]
2544         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2545         if {$path eq {}} {
2546                 set last_clicked {}
2547                 return
2548         }
2549
2550         if {$last_clicked ne {}
2551                 && [lindex $last_clicked 0] ne $w} {
2552                 array unset selected_paths
2553                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2554         }
2555
2556         set last_clicked [list $w $lno]
2557         if {[catch {set in_sel $selected_paths($path)}]} {
2558                 set in_sel 0
2559         }
2560         if {$in_sel} {
2561                 unset selected_paths($path)
2562                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2563         } else {
2564                 set selected_paths($path) 1
2565                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2566         }
2567 }
2568
2569 proc add_range_to_selection {w x y} {
2570         global file_lists last_clicked selected_paths
2571
2572         if {[lindex $last_clicked 0] ne $w} {
2573                 toggle_or_diff $w $x $y
2574                 return
2575         }
2576
2577         set lno [lindex [split [$w index @$x,$y] .] 0]
2578         set lc [lindex $last_clicked 1]
2579         if {$lc < $lno} {
2580                 set begin $lc
2581                 set end $lno
2582         } else {
2583                 set begin $lno
2584                 set end $lc
2585         }
2586
2587         foreach path [lrange $file_lists($w) \
2588                 [expr {$begin - 1}] \
2589                 [expr {$end - 1}]] {
2590                 set selected_paths($path) 1
2591         }
2592         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2593 }
2594
2595 proc show_more_context {} {
2596         global repo_config
2597         if {$repo_config(gui.diffcontext) < 99} {
2598                 incr repo_config(gui.diffcontext)
2599                 reshow_diff
2600         }
2601 }
2602
2603 proc show_less_context {} {
2604         global repo_config
2605         if {$repo_config(gui.diffcontext) > 1} {
2606                 incr repo_config(gui.diffcontext) -1
2607                 reshow_diff
2608         }
2609 }
2610
2611 ######################################################################
2612 ##
2613 ## ui construction
2614
2615 set ui_comm {}
2616
2617 # -- Menu Bar
2618 #
2619 menu .mbar -tearoff 0
2620 if {[is_MacOSX]} {
2621         # -- Apple Menu (Mac OS X only)
2622         #
2623         .mbar add cascade -label Apple -menu .mbar.apple
2624         menu .mbar.apple
2625 }
2626 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2627 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2628 if {[is_enabled branch]} {
2629         .mbar add cascade -label [mc Branch] -menu .mbar.branch
2630 }
2631 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2632         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2633 }
2634 if {[is_enabled transport]} {
2635         .mbar add cascade -label [mc Merge] -menu .mbar.merge
2636         .mbar add cascade -label [mc Remote] -menu .mbar.remote
2637 }
2638 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2639         .mbar add cascade -label [mc Tools] -menu .mbar.tools
2640 }
2641
2642 # -- Repository Menu
2643 #
2644 menu .mbar.repository
2645
2646 if {![is_bare]} {
2647         .mbar.repository add command \
2648                 -label [mc "Explore Working Copy"] \
2649                 -command {do_explore}
2650         .mbar.repository add separator
2651 }
2652
2653 .mbar.repository add command \
2654         -label [mc "Browse Current Branch's Files"] \
2655         -command {browser::new $current_branch}
2656 set ui_browse_current [.mbar.repository index last]
2657 .mbar.repository add command \
2658         -label [mc "Browse Branch Files..."] \
2659         -command browser_open::dialog
2660 .mbar.repository add separator
2661
2662 .mbar.repository add command \
2663         -label [mc "Visualize Current Branch's History"] \
2664         -command {do_gitk $current_branch}
2665 set ui_visualize_current [.mbar.repository index last]
2666 .mbar.repository add command \
2667         -label [mc "Visualize All Branch History"] \
2668         -command {do_gitk --all}
2669 .mbar.repository add separator
2670
2671 proc current_branch_write {args} {
2672         global current_branch
2673         .mbar.repository entryconf $::ui_browse_current \
2674                 -label [mc "Browse %s's Files" $current_branch]
2675         .mbar.repository entryconf $::ui_visualize_current \
2676                 -label [mc "Visualize %s's History" $current_branch]
2677 }
2678 trace add variable current_branch write current_branch_write
2679
2680 if {[is_enabled multicommit]} {
2681         .mbar.repository add command -label [mc "Database Statistics"] \
2682                 -command do_stats
2683
2684         .mbar.repository add command -label [mc "Compress Database"] \
2685                 -command do_gc
2686
2687         .mbar.repository add command -label [mc "Verify Database"] \
2688                 -command do_fsck_objects
2689
2690         .mbar.repository add separator
2691
2692         if {[is_Cygwin]} {
2693                 .mbar.repository add command \
2694                         -label [mc "Create Desktop Icon"] \
2695                         -command do_cygwin_shortcut
2696         } elseif {[is_Windows]} {
2697                 .mbar.repository add command \
2698                         -label [mc "Create Desktop Icon"] \
2699                         -command do_windows_shortcut
2700         } elseif {[is_MacOSX]} {
2701                 .mbar.repository add command \
2702                         -label [mc "Create Desktop Icon"] \
2703                         -command do_macosx_app
2704         }
2705 }
2706
2707 if {[is_MacOSX]} {
2708         proc ::tk::mac::Quit {args} { do_quit }
2709 } else {
2710         .mbar.repository add command -label [mc Quit] \
2711                 -command do_quit \
2712                 -accelerator $M1T-Q
2713 }
2714
2715 # -- Edit Menu
2716 #
2717 menu .mbar.edit
2718 .mbar.edit add command -label [mc Undo] \
2719         -command {catch {[focus] edit undo}} \
2720         -accelerator $M1T-Z
2721 .mbar.edit add command -label [mc Redo] \
2722         -command {catch {[focus] edit redo}} \
2723         -accelerator $M1T-Y
2724 .mbar.edit add separator
2725 .mbar.edit add command -label [mc Cut] \
2726         -command {catch {tk_textCut [focus]}} \
2727         -accelerator $M1T-X
2728 .mbar.edit add command -label [mc Copy] \
2729         -command {catch {tk_textCopy [focus]}} \
2730         -accelerator $M1T-C
2731 .mbar.edit add command -label [mc Paste] \
2732         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2733         -accelerator $M1T-V
2734 .mbar.edit add command -label [mc Delete] \
2735         -command {catch {[focus] delete sel.first sel.last}} \
2736         -accelerator Del
2737 .mbar.edit add separator
2738 .mbar.edit add command -label [mc "Select All"] \
2739         -command {catch {[focus] tag add sel 0.0 end}} \
2740         -accelerator $M1T-A
2741
2742 # -- Branch Menu
2743 #
2744 if {[is_enabled branch]} {
2745         menu .mbar.branch
2746
2747         .mbar.branch add command -label [mc "Create..."] \
2748                 -command branch_create::dialog \
2749                 -accelerator $M1T-N
2750         lappend disable_on_lock [list .mbar.branch entryconf \
2751                 [.mbar.branch index last] -state]
2752
2753         .mbar.branch add command -label [mc "Checkout..."] \
2754                 -command branch_checkout::dialog \
2755                 -accelerator $M1T-O
2756         lappend disable_on_lock [list .mbar.branch entryconf \
2757                 [.mbar.branch index last] -state]
2758
2759         .mbar.branch add command -label [mc "Rename..."] \
2760                 -command branch_rename::dialog
2761         lappend disable_on_lock [list .mbar.branch entryconf \
2762                 [.mbar.branch index last] -state]
2763
2764         .mbar.branch add command -label [mc "Delete..."] \
2765                 -command branch_delete::dialog
2766         lappend disable_on_lock [list .mbar.branch entryconf \
2767                 [.mbar.branch index last] -state]
2768
2769         .mbar.branch add command -label [mc "Reset..."] \
2770                 -command merge::reset_hard
2771         lappend disable_on_lock [list .mbar.branch entryconf \
2772                 [.mbar.branch index last] -state]
2773 }
2774
2775 # -- Commit Menu
2776 #
2777 proc commit_btn_caption {} {
2778         if {[is_enabled nocommit]} {
2779                 return [mc "Done"]
2780         } else {
2781                 return [mc Commit@@verb]
2782         }
2783 }
2784
2785 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2786         menu .mbar.commit
2787
2788         if {![is_enabled nocommit]} {
2789                 .mbar.commit add radiobutton \
2790                         -label [mc "New Commit"] \
2791                         -command do_select_commit_type \
2792                         -variable selected_commit_type \
2793                         -value new
2794                 lappend disable_on_lock \
2795                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2796
2797                 .mbar.commit add radiobutton \
2798                         -label [mc "Amend Last Commit"] \
2799                         -command do_select_commit_type \
2800                         -variable selected_commit_type \
2801                         -value amend
2802                 lappend disable_on_lock \
2803                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2804
2805                 .mbar.commit add separator
2806         }
2807
2808         .mbar.commit add command -label [mc Rescan] \
2809                 -command ui_do_rescan \
2810                 -accelerator F5
2811         lappend disable_on_lock \
2812                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2813
2814         .mbar.commit add command -label [mc "Stage To Commit"] \
2815                 -command do_add_selection \
2816                 -accelerator $M1T-T
2817         lappend disable_on_lock \
2818                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2819
2820         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2821                 -command do_add_all \
2822                 -accelerator $M1T-I
2823         lappend disable_on_lock \
2824                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2825
2826         .mbar.commit add command -label [mc "Unstage From Commit"] \
2827                 -command do_unstage_selection \
2828                 -accelerator $M1T-U
2829         lappend disable_on_lock \
2830                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2831
2832         .mbar.commit add command -label [mc "Revert Changes"] \
2833                 -command do_revert_selection \
2834                 -accelerator $M1T-J
2835         lappend disable_on_lock \
2836                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2837
2838         .mbar.commit add separator
2839
2840         .mbar.commit add command -label [mc "Show Less Context"] \
2841                 -command show_less_context \
2842                 -accelerator $M1T-\-
2843
2844         .mbar.commit add command -label [mc "Show More Context"] \
2845                 -command show_more_context \
2846                 -accelerator $M1T-=
2847
2848         .mbar.commit add separator
2849
2850         if {![is_enabled nocommitmsg]} {
2851                 .mbar.commit add command -label [mc "Sign Off"] \
2852                         -command do_signoff \
2853                         -accelerator $M1T-S
2854         }
2855
2856         .mbar.commit add command -label [commit_btn_caption] \
2857                 -command do_commit \
2858                 -accelerator $M1T-Return
2859         lappend disable_on_lock \
2860                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2861 }
2862
2863 # -- Merge Menu
2864 #
2865 if {[is_enabled branch]} {
2866         menu .mbar.merge
2867         .mbar.merge add command -label [mc "Local Merge..."] \
2868                 -command merge::dialog \
2869                 -accelerator $M1T-M
2870         lappend disable_on_lock \
2871                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2872         .mbar.merge add command -label [mc "Abort Merge..."] \
2873                 -command merge::reset_hard
2874         lappend disable_on_lock \
2875                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2876 }
2877
2878 # -- Transport Menu
2879 #
2880 if {[is_enabled transport]} {
2881         menu .mbar.remote
2882
2883         .mbar.remote add command \
2884                 -label [mc "Add..."] \
2885                 -command remote_add::dialog \
2886                 -accelerator $M1T-A
2887         .mbar.remote add command \
2888                 -label [mc "Push..."] \
2889                 -command do_push_anywhere \
2890                 -accelerator $M1T-P
2891         .mbar.remote add command \
2892                 -label [mc "Delete Branch..."] \
2893                 -command remote_branch_delete::dialog
2894 }
2895
2896 if {[is_MacOSX]} {
2897         proc ::tk::mac::ShowPreferences {} {do_options}
2898 } else {
2899         # -- Edit Menu
2900         #
2901         .mbar.edit add separator
2902         .mbar.edit add command -label [mc "Options..."] \
2903                 -command do_options
2904 }
2905
2906 # -- Tools Menu
2907 #
2908 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2909         set tools_menubar .mbar.tools
2910         menu $tools_menubar
2911         $tools_menubar add separator
2912         $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2913         $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2914         set tools_tailcnt 3
2915         if {[array names repo_config guitool.*.cmd] ne {}} {
2916                 tools_populate_all
2917         }
2918 }
2919
2920 # -- Help Menu
2921 #
2922 .mbar add cascade -label [mc Help] -menu .mbar.help
2923 menu .mbar.help
2924
2925 if {[is_MacOSX]} {
2926         .mbar.apple add command -label [mc "About %s" [appname]] \
2927                 -command do_about
2928         .mbar.apple add separator
2929 } else {
2930         .mbar.help add command -label [mc "About %s" [appname]] \
2931                 -command do_about
2932 }
2933 . configure -menu .mbar
2934
2935 set doc_path [githtmldir]
2936 if {$doc_path ne {}} {
2937         set doc_path [file join $doc_path index.html]
2938
2939         if {[is_Cygwin]} {
2940                 set doc_path [exec cygpath --mixed $doc_path]
2941         }
2942 }
2943
2944 if {[file isfile $doc_path]} {
2945         set doc_url "file:$doc_path"
2946 } else {
2947         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2948 }
2949
2950 proc start_browser {url} {
2951         git "web--browse" $url
2952 }
2953
2954 .mbar.help add command -label [mc "Online Documentation"] \
2955         -command [list start_browser $doc_url]
2956
2957 .mbar.help add command -label [mc "Show SSH Key"] \
2958         -command do_ssh_key
2959
2960 unset doc_path doc_url
2961
2962 # -- Standard bindings
2963 #
2964 wm protocol . WM_DELETE_WINDOW do_quit
2965 bind all <$M1B-Key-q> do_quit
2966 bind all <$M1B-Key-Q> do_quit
2967 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2968 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2969
2970 set subcommand_args {}
2971 proc usage {} {
2972         set s "usage: $::argv0 $::subcommand $::subcommand_args"
2973         if {[tk windowingsystem] eq "win32"} {
2974                 wm withdraw .
2975                 tk_messageBox -icon info -message $s \
2976                         -title [mc "Usage"]
2977         } else {
2978                 puts stderr $s
2979         }
2980         exit 1
2981 }
2982
2983 proc normalize_relpath {path} {
2984         set elements {}
2985         foreach item [file split $path] {
2986                 if {$item eq {.}} continue
2987                 if {$item eq {..} && [llength $elements] > 0
2988                     && [lindex $elements end] ne {..}} {
2989                         set elements [lrange $elements 0 end-1]
2990                         continue
2991                 }
2992                 lappend elements $item
2993         }
2994         return [eval file join $elements]
2995 }
2996
2997 # -- Not a normal commit type invocation?  Do that instead!
2998 #
2999 switch -- $subcommand {
3000 browser -
3001 blame {
3002         if {$subcommand eq "blame"} {
3003                 set subcommand_args {[--line=<num>] rev? path}
3004         } else {
3005                 set subcommand_args {rev? path}
3006         }
3007         if {$argv eq {}} usage
3008         set head {}
3009         set path {}
3010         set jump_spec {}
3011         set is_path 0
3012         foreach a $argv {
3013                 if {$is_path || [file exists $_prefix$a]} {
3014                         if {$path ne {}} usage
3015                         set path [normalize_relpath $_prefix$a]
3016                         break
3017                 } elseif {$a eq {--}} {
3018                         if {$path ne {}} {
3019                                 if {$head ne {}} usage
3020                                 set head $path
3021                                 set path {}
3022                         }
3023                         set is_path 1
3024                 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3025                         if {$jump_spec ne {} || $head ne {}} usage
3026                         set jump_spec [list $lnum]
3027                 } elseif {$head eq {}} {
3028                         if {$head ne {}} usage
3029                         set head $a
3030                         set is_path 1
3031                 } else {
3032                         usage
3033                 }
3034         }
3035         unset is_path
3036
3037         if {$head ne {} && $path eq {}} {
3038                 set path [normalize_relpath $_prefix$head]
3039                 set head {}
3040         }
3041
3042         if {$head eq {}} {
3043                 load_current_branch
3044         } else {
3045                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3046                         if {[catch {
3047                                         set head [git rev-parse --verify $head]
3048                                 } err]} {
3049                                 if {[tk windowingsystem] eq "win32"} {
3050                                         tk_messageBox -icon error -title [mc Error] -message $err
3051                                 } else {
3052                                         puts stderr $err
3053                                 }
3054                                 exit 1
3055                         }
3056                 }
3057                 set current_branch $head
3058         }
3059
3060         wm deiconify .
3061         switch -- $subcommand {
3062         browser {
3063                 if {$jump_spec ne {}} usage
3064                 if {$head eq {}} {
3065                         if {$path ne {} && [file isdirectory $path]} {
3066                                 set head $current_branch
3067                         } else {
3068                                 set head $path
3069                                 set path {}
3070                         }
3071                 }
3072                 browser::new $head $path
3073         }
3074         blame   {
3075                 if {$head eq {} && ![file exists $path]} {
3076                         catch {wm withdraw .}
3077                         tk_messageBox \
3078                                 -icon error \
3079                                 -type ok \
3080                                 -title [mc "git-gui: fatal error"] \
3081                                 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3082                         exit 1
3083                 }
3084                 blame::new $head $path $jump_spec
3085         }
3086         }
3087         return
3088 }
3089 citool -
3090 gui {
3091         if {[llength $argv] != 0} {
3092                 usage
3093         }
3094         # fall through to setup UI for commits
3095 }
3096 default {
3097         set err "usage: $argv0 \[{blame|browser|citool}\]"
3098         if {[tk windowingsystem] eq "win32"} {
3099                 wm withdraw .
3100                 tk_messageBox -icon error -message $err \
3101                         -title [mc "Usage"]
3102         } else {
3103                 puts stderr $err
3104         }
3105         exit 1
3106 }
3107 }
3108
3109 # -- Branch Control
3110 #
3111 ${NS}::frame .branch
3112 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3113 ${NS}::label .branch.l1 \
3114         -text [mc "Current Branch:"] \
3115         -anchor w \
3116         -justify left
3117 ${NS}::label .branch.cb \
3118         -textvariable current_branch \
3119         -anchor w \
3120         -justify left
3121 pack .branch.l1 -side left
3122 pack .branch.cb -side left -fill x
3123 pack .branch -side top -fill x
3124
3125 # -- Main Window Layout
3126 #
3127 ${NS}::panedwindow .vpane -orient horizontal
3128 ${NS}::panedwindow .vpane.files -orient vertical
3129 if {$use_ttk} {
3130         .vpane add .vpane.files
3131 } else {
3132         .vpane add .vpane.files -sticky nsew -height 100 -width 200
3133 }
3134 pack .vpane -anchor n -side top -fill both -expand 1
3135
3136 # -- Index File List
3137 #
3138 ${NS}::frame .vpane.files.index -height 100 -width 200
3139 tlabel .vpane.files.index.title \
3140         -text [mc "Staged Changes (Will Commit)"] \
3141         -background lightgreen -foreground black
3142 text $ui_index -background white -foreground black \
3143         -borderwidth 0 \
3144         -width 20 -height 10 \
3145         -wrap none \
3146         -cursor $cursor_ptr \
3147         -xscrollcommand {.vpane.files.index.sx set} \
3148         -yscrollcommand {.vpane.files.index.sy set} \
3149         -state disabled
3150 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3151 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3152 pack .vpane.files.index.title -side top -fill x
3153 pack .vpane.files.index.sx -side bottom -fill x
3154 pack .vpane.files.index.sy -side right -fill y
3155 pack $ui_index -side left -fill both -expand 1
3156
3157 # -- Working Directory File List
3158 #
3159 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3160 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3161         -background lightsalmon -foreground black
3162 text $ui_workdir -background white -foreground black \
3163         -borderwidth 0 \
3164         -width 20 -height 10 \
3165         -wrap none \
3166         -cursor $cursor_ptr \
3167         -xscrollcommand {.vpane.files.workdir.sx set} \
3168         -yscrollcommand {.vpane.files.workdir.sy set} \
3169         -state disabled
3170 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3171 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3172 pack .vpane.files.workdir.title -side top -fill x
3173 pack .vpane.files.workdir.sx -side bottom -fill x
3174 pack .vpane.files.workdir.sy -side right -fill y
3175 pack $ui_workdir -side left -fill both -expand 1
3176
3177 .vpane.files add .vpane.files.workdir
3178 .vpane.files add .vpane.files.index
3179 if {!$use_ttk} {
3180         .vpane.files paneconfigure .vpane.files.workdir -sticky news
3181         .vpane.files paneconfigure .vpane.files.index -sticky news
3182 }
3183
3184 foreach i [list $ui_index $ui_workdir] {
3185         rmsel_tag $i
3186         $i tag conf in_diff -background [$i tag cget in_sel -background]
3187 }
3188 unset i
3189
3190 # -- Diff and Commit Area
3191 #
3192 ${NS}::frame .vpane.lower -height 300 -width 400
3193 ${NS}::frame .vpane.lower.commarea
3194 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3195 pack .vpane.lower.diff -fill both -expand 1
3196 pack .vpane.lower.commarea -side bottom -fill x
3197 .vpane add .vpane.lower
3198 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3199
3200 # -- Commit Area Buttons
3201 #
3202 ${NS}::frame .vpane.lower.commarea.buttons
3203 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3204         -anchor w \
3205         -justify left
3206 pack .vpane.lower.commarea.buttons.l -side top -fill x
3207 pack .vpane.lower.commarea.buttons -side left -fill y
3208
3209 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3210         -command ui_do_rescan
3211 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3212 lappend disable_on_lock \
3213         {.vpane.lower.commarea.buttons.rescan conf -state}
3214
3215 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3216         -command do_add_all
3217 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3218 lappend disable_on_lock \
3219         {.vpane.lower.commarea.buttons.incall conf -state}
3220
3221 if {![is_enabled nocommitmsg]} {
3222         ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3223                 -command do_signoff
3224         pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3225 }
3226
3227 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3228         -command do_commit
3229 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3230 lappend disable_on_lock \
3231         {.vpane.lower.commarea.buttons.commit conf -state}
3232
3233 if {![is_enabled nocommit]} {
3234         ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3235                 -command do_push_anywhere
3236         pack .vpane.lower.commarea.buttons.push -side top -fill x
3237 }
3238
3239 # -- Commit Message Buffer
3240 #
3241 ${NS}::frame .vpane.lower.commarea.buffer
3242 ${NS}::frame .vpane.lower.commarea.buffer.header
3243 set ui_comm .vpane.lower.commarea.buffer.t
3244 set ui_coml .vpane.lower.commarea.buffer.header.l
3245
3246 if {![is_enabled nocommit]} {
3247         ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3248                 -text [mc "New Commit"] \
3249                 -command do_select_commit_type \
3250                 -variable selected_commit_type \
3251                 -value new
3252         lappend disable_on_lock \
3253                 [list .vpane.lower.commarea.buffer.header.new conf -state]
3254         ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3255                 -text [mc "Amend Last Commit"] \
3256                 -command do_select_commit_type \
3257                 -variable selected_commit_type \
3258                 -value amend
3259         lappend disable_on_lock \
3260                 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3261 }
3262
3263 ${NS}::label $ui_coml \
3264         -anchor w \
3265         -justify left
3266 proc trace_commit_type {varname args} {
3267         global ui_coml commit_type
3268         switch -glob -- $commit_type {
3269         initial       {set txt [mc "Initial Commit Message:"]}
3270         amend         {set txt [mc "Amended Commit Message:"]}
3271         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3272         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3273         merge         {set txt [mc "Merge Commit Message:"]}
3274         *             {set txt [mc "Commit Message:"]}
3275         }
3276         $ui_coml conf -text $txt
3277 }
3278 trace add variable commit_type write trace_commit_type
3279 pack $ui_coml -side left -fill x
3280
3281 if {![is_enabled nocommit]} {
3282         pack .vpane.lower.commarea.buffer.header.amend -side right
3283         pack .vpane.lower.commarea.buffer.header.new -side right
3284 }
3285
3286 text $ui_comm -background white -foreground black \
3287         -borderwidth 1 \
3288         -undo true \
3289         -maxundo 20 \
3290         -autoseparators true \
3291         -relief sunken \
3292         -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3293         -font font_diff \
3294         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3295 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3296         -command [list $ui_comm yview]
3297 pack .vpane.lower.commarea.buffer.header -side top -fill x
3298 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3299 pack $ui_comm -side left -fill y
3300 pack .vpane.lower.commarea.buffer -side left -fill y
3301
3302 # -- Commit Message Buffer Context Menu
3303 #
3304 set ctxm .vpane.lower.commarea.buffer.ctxm
3305 menu $ctxm -tearoff 0
3306 $ctxm add command \
3307         -label [mc Cut] \
3308         -command {tk_textCut $ui_comm}
3309 $ctxm add command \
3310         -label [mc Copy] \
3311         -command {tk_textCopy $ui_comm}
3312 $ctxm add command \
3313         -label [mc Paste] \
3314         -command {tk_textPaste $ui_comm}
3315 $ctxm add command \
3316         -label [mc Delete] \
3317         -command {catch {$ui_comm delete sel.first sel.last}}
3318 $ctxm add separator
3319 $ctxm add command \
3320         -label [mc "Select All"] \
3321         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3322 $ctxm add command \
3323         -label [mc "Copy All"] \
3324         -command {
3325                 $ui_comm tag add sel 0.0 end
3326                 tk_textCopy $ui_comm
3327                 $ui_comm tag remove sel 0.0 end
3328         }
3329 $ctxm add separator
3330 $ctxm add command \
3331         -label [mc "Sign Off"] \
3332         -command do_signoff
3333 set ui_comm_ctxm $ctxm
3334
3335 # -- Diff Header
3336 #
3337 proc trace_current_diff_path {varname args} {
3338         global current_diff_path diff_actions file_states
3339         if {$current_diff_path eq {}} {
3340                 set s {}
3341                 set f {}
3342                 set p {}
3343                 set o disabled
3344         } else {
3345                 set p $current_diff_path
3346                 set s [mapdesc [lindex $file_states($p) 0] $p]
3347                 set f [mc "File:"]
3348                 set p [escape_path $p]
3349                 set o normal
3350         }
3351
3352         .vpane.lower.diff.header.status configure -text $s
3353         .vpane.lower.diff.header.file configure -text $f
3354         .vpane.lower.diff.header.path configure -text $p
3355         foreach w $diff_actions {
3356                 uplevel #0 $w $o
3357         }
3358 }
3359 trace add variable current_diff_path write trace_current_diff_path
3360
3361 gold_frame .vpane.lower.diff.header
3362 tlabel .vpane.lower.diff.header.status \
3363         -background gold \
3364         -foreground black \
3365         -width $max_status_desc \
3366         -anchor w \
3367         -justify left
3368 tlabel .vpane.lower.diff.header.file \
3369         -background gold \
3370         -foreground black \
3371         -anchor w \
3372         -justify left
3373 tlabel .vpane.lower.diff.header.path \
3374         -background gold \
3375         -foreground black \
3376         -anchor w \
3377         -justify left
3378 pack .vpane.lower.diff.header.status -side left
3379 pack .vpane.lower.diff.header.file -side left
3380 pack .vpane.lower.diff.header.path -fill x
3381 set ctxm .vpane.lower.diff.header.ctxm
3382 menu $ctxm -tearoff 0
3383 $ctxm add command \
3384         -label [mc Copy] \
3385         -command {
3386                 clipboard clear
3387                 clipboard append \
3388                         -format STRING \
3389                         -type STRING \
3390                         -- $current_diff_path
3391         }
3392 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3393 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3394
3395 # -- Diff Body
3396 #
3397 ${NS}::frame .vpane.lower.diff.body
3398 set ui_diff .vpane.lower.diff.body.t
3399 text $ui_diff -background white -foreground black \
3400         -borderwidth 0 \
3401         -width 80 -height 5 -wrap none \
3402         -font font_diff \
3403         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3404         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3405         -state disabled
3406 catch {$ui_diff configure -tabstyle wordprocessor}
3407 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3408         -command [list $ui_diff xview]
3409 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3410         -command [list $ui_diff yview]
3411 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3412 pack .vpane.lower.diff.body.sby -side right -fill y
3413 pack $ui_diff -side left -fill both -expand 1
3414 pack .vpane.lower.diff.header -side top -fill x
3415 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3416
3417 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3418         $ui_diff tag configure clr4$n -background $c
3419         $ui_diff tag configure clri4$n -foreground $c
3420         $ui_diff tag configure clr3$n -foreground $c
3421         $ui_diff tag configure clri3$n -background $c
3422 }
3423 $ui_diff tag configure clr1 -font font_diffbold
3424 $ui_diff tag configure clr4 -underline 1
3425
3426 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3427
3428 $ui_diff tag conf d_cr -elide true
3429 $ui_diff tag conf d_@ -font font_diffbold
3430 $ui_diff tag conf d_+ -foreground {#00a000}
3431 $ui_diff tag conf d_- -foreground red
3432
3433 $ui_diff tag conf d_++ -foreground {#00a000}
3434 $ui_diff tag conf d_-- -foreground red
3435 $ui_diff tag conf d_+s \
3436         -foreground {#00a000} \
3437         -background {#e2effa}
3438 $ui_diff tag conf d_-s \
3439         -foreground red \
3440         -background {#e2effa}
3441 $ui_diff tag conf d_s+ \
3442         -foreground {#00a000} \
3443         -background ivory1
3444 $ui_diff tag conf d_s- \
3445         -foreground red \
3446         -background ivory1
3447
3448 $ui_diff tag conf d< \
3449         -foreground orange \
3450         -font font_diffbold
3451 $ui_diff tag conf d= \
3452         -foreground orange \
3453         -font font_diffbold
3454 $ui_diff tag conf d> \
3455         -foreground orange \
3456         -font font_diffbold
3457
3458 $ui_diff tag raise sel
3459
3460 # -- Diff Body Context Menu
3461 #
3462
3463 proc create_common_diff_popup {ctxm} {
3464         $ctxm add command \
3465                 -label [mc Refresh] \
3466                 -command reshow_diff
3467         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3468         $ctxm add command \
3469                 -label [mc Copy] \
3470                 -command {tk_textCopy $ui_diff}
3471         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3472         $ctxm add command \
3473                 -label [mc "Select All"] \
3474                 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3475         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3476         $ctxm add command \
3477                 -label [mc "Copy All"] \
3478                 -command {
3479                         $ui_diff tag add sel 0.0 end
3480                         tk_textCopy $ui_diff
3481                         $ui_diff tag remove sel 0.0 end
3482                 }
3483         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3484         $ctxm add separator
3485         $ctxm add command \
3486                 -label [mc "Decrease Font Size"] \
3487                 -command {incr_font_size font_diff -1}
3488         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3489         $ctxm add command \
3490                 -label [mc "Increase Font Size"] \
3491                 -command {incr_font_size font_diff 1}
3492         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3493         $ctxm add separator
3494         set emenu $ctxm.enc
3495         menu $emenu
3496         build_encoding_menu $emenu [list force_diff_encoding]
3497         $ctxm add cascade \
3498                 -label [mc "Encoding"] \
3499                 -menu $emenu
3500         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3501         $ctxm add separator
3502         $ctxm add command -label [mc "Options..."] \
3503                 -command do_options
3504 }
3505
3506 set ctxm .vpane.lower.diff.body.ctxm
3507 menu $ctxm -tearoff 0
3508 $ctxm add command \
3509         -label [mc "Apply/Reverse Hunk"] \
3510         -command {apply_hunk $cursorX $cursorY}
3511 set ui_diff_applyhunk [$ctxm index last]
3512 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3513 $ctxm add command \
3514         -label [mc "Apply/Reverse Line"] \
3515         -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3516 set ui_diff_applyline [$ctxm index last]
3517 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3518 $ctxm add separator
3519 $ctxm add command \
3520         -label [mc "Show Less Context"] \
3521         -command show_less_context
3522 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3523 $ctxm add command \
3524         -label [mc "Show More Context"] \
3525         -command show_more_context
3526 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3527 $ctxm add separator
3528 create_common_diff_popup $ctxm
3529
3530 set ctxmmg .vpane.lower.diff.body.ctxmmg
3531 menu $ctxmmg -tearoff 0
3532 $ctxmmg add command \
3533         -label [mc "Run Merge Tool"] \
3534         -command {merge_resolve_tool}
3535 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3536 $ctxmmg add separator
3537 $ctxmmg add command \
3538         -label [mc "Use Remote Version"] \
3539         -command {merge_resolve_one 3}
3540 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3541 $ctxmmg add command \
3542         -label [mc "Use Local Version"] \
3543         -command {merge_resolve_one 2}
3544 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3545 $ctxmmg add command \
3546         -label [mc "Revert To Base"] \
3547         -command {merge_resolve_one 1}
3548 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3549 $ctxmmg add separator
3550 $ctxmmg add command \
3551         -label [mc "Show Less Context"] \
3552         -command show_less_context
3553 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3554 $ctxmmg add command \
3555         -label [mc "Show More Context"] \
3556         -command show_more_context
3557 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3558 $ctxmmg add separator
3559 create_common_diff_popup $ctxmmg
3560
3561 set ctxmsm .vpane.lower.diff.body.ctxmsm
3562 menu $ctxmsm -tearoff 0
3563 $ctxmsm add command \
3564         -label [mc "Visualize These Changes In The Submodule"] \
3565         -command {do_gitk -- true}
3566 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3567 $ctxmsm add command \
3568         -label [mc "Visualize Current Branch History In The Submodule"] \
3569         -command {do_gitk {} true}
3570 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3571 $ctxmsm add command \
3572         -label [mc "Visualize All Branch History In The Submodule"] \
3573         -command {do_gitk --all true}
3574 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3575 $ctxmsm add separator
3576 $ctxmsm add command \
3577         -label [mc "Start git gui In The Submodule"] \
3578         -command {do_git_gui}
3579 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3580 $ctxmsm add separator
3581 create_common_diff_popup $ctxmsm
3582
3583 proc has_textconv {path} {
3584         if {[is_config_false gui.textconv]} {
3585                 return 0
3586         }
3587         set filter [gitattr $path diff set]
3588         set textconv [get_config [join [list diff $filter textconv] .]]
3589         if {$filter ne {set} && $textconv ne {}} {
3590                 return 1
3591         } else {
3592                 return 0
3593         }
3594 }
3595
3596 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3597         global current_diff_path file_states
3598         set ::cursorX $x
3599         set ::cursorY $y
3600         if {[info exists file_states($current_diff_path)]} {
3601                 set state [lindex $file_states($current_diff_path) 0]
3602         } else {
3603                 set state {__}
3604         }
3605         if {[string first {U} $state] >= 0} {
3606                 tk_popup $ctxmmg $X $Y
3607         } elseif {$::is_submodule_diff} {
3608                 tk_popup $ctxmsm $X $Y
3609         } else {
3610                 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3611                 if {$::ui_index eq $::current_diff_side} {
3612                         set l [mc "Unstage Hunk From Commit"]
3613                         if {$has_range} {
3614                                 set t [mc "Unstage Lines From Commit"]
3615                         } else {
3616                                 set t [mc "Unstage Line From Commit"]
3617                         }
3618                 } else {
3619                         set l [mc "Stage Hunk For Commit"]
3620                         if {$has_range} {
3621                                 set t [mc "Stage Lines For Commit"]
3622                         } else {
3623                                 set t [mc "Stage Line For Commit"]
3624                         }
3625                 }
3626                 if {$::is_3way_diff
3627                         || $current_diff_path eq {}
3628                         || {__} eq $state
3629                         || {_O} eq $state
3630                         || [string match {?T} $state]
3631                         || [string match {T?} $state]
3632                         || [has_textconv $current_diff_path]} {
3633                         set s disabled
3634                 } else {
3635                         set s normal
3636                 }
3637                 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3638                 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3639                 tk_popup $ctxm $X $Y
3640         }
3641 }
3642 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3643
3644 # -- Status Bar
3645 #
3646 set main_status [::status_bar::new .status]
3647 pack .status -anchor w -side bottom -fill x
3648 $main_status show [mc "Initializing..."]
3649
3650 # -- Load geometry
3651 #
3652 proc on_ttk_pane_mapped {w pane pos} {
3653         bind $w <Map> {}
3654         after 0 [list after idle [list $w sashpos $pane $pos]]
3655 }
3656 proc on_tk_pane_mapped {w pane x y} {
3657         bind $w <Map> {}
3658         after 0 [list after idle [list $w sash place $pane $x $y]]
3659 }
3660 proc on_application_mapped {} {
3661         global repo_config use_ttk
3662         bind . <Map> {}
3663         set gm $repo_config(gui.geometry)
3664         if {$use_ttk} {
3665                 bind .vpane <Map> \
3666                     [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3667                 bind .vpane.files <Map> \
3668                     [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3669         } else {
3670                 bind .vpane <Map> \
3671                     [list on_tk_pane_mapped %W 0 \
3672                          [lindex $gm 1] \
3673                          [lindex [.vpane sash coord 0] 1]]
3674                 bind .vpane.files <Map> \
3675                     [list on_tk_pane_mapped %W 0 \
3676                          [lindex [.vpane.files sash coord 0] 0] \
3677                          [lindex $gm 2]]
3678         }
3679         wm geometry . [lindex $gm 0]
3680 }
3681 if {[info exists repo_config(gui.geometry)]} {
3682         bind . <Map> [list on_application_mapped]
3683         wm geometry . [lindex $repo_config(gui.geometry) 0]
3684 }
3685
3686 # -- Load window state
3687 #
3688 if {[info exists repo_config(gui.wmstate)]} {
3689         catch {wm state . $repo_config(gui.wmstate)}
3690 }
3691
3692 # -- Key Bindings
3693 #
3694 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3695 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3696 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3697 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3698 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3699 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3700 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3701 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3702 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3703 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3704 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3705 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3706 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3707 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3708 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3709 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3710 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3711 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3712 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3713 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3714 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3715 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3716
3717 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3718 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3719 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3720 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3721 bind $ui_diff <$M1B-Key-v> {break}
3722 bind $ui_diff <$M1B-Key-V> {break}
3723 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3724 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3725 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3726 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3727 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3728 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3729 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3730 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3731 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3732 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3733 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3734 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3735 bind $ui_diff <Button-1>   {focus %W}
3736
3737 if {[is_enabled branch]} {
3738         bind . <$M1B-Key-n> branch_create::dialog
3739         bind . <$M1B-Key-N> branch_create::dialog
3740         bind . <$M1B-Key-o> branch_checkout::dialog
3741         bind . <$M1B-Key-O> branch_checkout::dialog
3742         bind . <$M1B-Key-m> merge::dialog
3743         bind . <$M1B-Key-M> merge::dialog
3744 }
3745 if {[is_enabled transport]} {
3746         bind . <$M1B-Key-p> do_push_anywhere
3747         bind . <$M1B-Key-P> do_push_anywhere
3748 }
3749
3750 bind .   <Key-F5>     ui_do_rescan
3751 bind .   <$M1B-Key-r> ui_do_rescan
3752 bind .   <$M1B-Key-R> ui_do_rescan
3753 bind .   <$M1B-Key-s> do_signoff
3754 bind .   <$M1B-Key-S> do_signoff
3755 bind .   <$M1B-Key-t> do_add_selection
3756 bind .   <$M1B-Key-T> do_add_selection
3757 bind .   <$M1B-Key-j> do_revert_selection
3758 bind .   <$M1B-Key-J> do_revert_selection
3759 bind .   <$M1B-Key-i> do_add_all
3760 bind .   <$M1B-Key-I> do_add_all
3761 bind .   <$M1B-Key-minus> {show_less_context;break}
3762 bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3763 bind .   <$M1B-Key-equal> {show_more_context;break}
3764 bind .   <$M1B-Key-plus> {show_more_context;break}
3765 bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3766 bind .   <$M1B-Key-Return> do_commit
3767 foreach i [list $ui_index $ui_workdir] {
3768         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3769         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3770         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3771 }
3772 unset i
3773
3774 set file_lists($ui_index) [list]
3775 set file_lists($ui_workdir) [list]
3776
3777 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3778 focus -force $ui_comm
3779
3780 # -- Warn the user about environmental problems.  Cygwin's Tcl
3781 #    does *not* pass its env array onto any processes it spawns.
3782 #    This means that git processes get none of our environment.
3783 #
3784 if {[is_Cygwin]} {
3785         set ignored_env 0
3786         set suggest_user {}
3787         set msg [mc "Possible environment issues exist.
3788
3789 The following environment variables are probably
3790 going to be ignored by any Git subprocess run
3791 by %s:
3792
3793 " [appname]]
3794         foreach name [array names env] {
3795                 switch -regexp -- $name {
3796                 {^GIT_INDEX_FILE$} -
3797                 {^GIT_OBJECT_DIRECTORY$} -
3798                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3799                 {^GIT_DIFF_OPTS$} -
3800                 {^GIT_EXTERNAL_DIFF$} -
3801                 {^GIT_PAGER$} -
3802                 {^GIT_TRACE$} -
3803                 {^GIT_CONFIG$} -
3804                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3805                         append msg " - $name\n"
3806                         incr ignored_env
3807                 }
3808                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3809                         append msg " - $name\n"
3810                         incr ignored_env
3811                         set suggest_user $name
3812                 }
3813                 }
3814         }
3815         if {$ignored_env > 0} {
3816                 append msg [mc "
3817 This is due to a known issue with the
3818 Tcl binary distributed by Cygwin."]
3819
3820                 if {$suggest_user ne {}} {
3821                         append msg [mc "
3822
3823 A good replacement for %s
3824 is placing values for the user.name and
3825 user.email settings into your personal
3826 ~/.gitconfig file.
3827 " $suggest_user]
3828                 }
3829                 warn_popup $msg
3830         }
3831         unset ignored_env msg suggest_user name
3832 }
3833
3834 # -- Only initialize complex UI if we are going to stay running.
3835 #
3836 if {[is_enabled transport]} {
3837         load_all_remotes
3838
3839         set n [.mbar.remote index end]
3840         populate_remotes_menu
3841         set n [expr {[.mbar.remote index end] - $n}]
3842         if {$n > 0} {
3843                 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3844                 .mbar.remote insert $n separator
3845         }
3846         unset n
3847 }
3848
3849 if {[winfo exists $ui_comm]} {
3850         set GITGUI_BCK_exists [load_message GITGUI_BCK]
3851
3852         # -- If both our backup and message files exist use the
3853         #    newer of the two files to initialize the buffer.
3854         #
3855         if {$GITGUI_BCK_exists} {
3856                 set m [gitdir GITGUI_MSG]
3857                 if {[file isfile $m]} {
3858                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3859                                 catch {file delete [gitdir GITGUI_MSG]}
3860                         } else {
3861                                 $ui_comm delete 0.0 end
3862                                 $ui_comm edit reset
3863                                 $ui_comm edit modified false
3864                                 catch {file delete [gitdir GITGUI_BCK]}
3865                                 set GITGUI_BCK_exists 0
3866                         }
3867                 }
3868                 unset m
3869         }
3870
3871         proc backup_commit_buffer {} {
3872                 global ui_comm GITGUI_BCK_exists
3873
3874                 set m [$ui_comm edit modified]
3875                 if {$m || $GITGUI_BCK_exists} {
3876                         set msg [string trim [$ui_comm get 0.0 end]]
3877                         regsub -all -line {[ \r\t]+$} $msg {} msg
3878
3879                         if {$msg eq {}} {
3880                                 if {$GITGUI_BCK_exists} {
3881                                         catch {file delete [gitdir GITGUI_BCK]}
3882                                         set GITGUI_BCK_exists 0
3883                                 }
3884                         } elseif {$m} {
3885                                 catch {
3886                                         set fd [open [gitdir GITGUI_BCK] w]
3887                                         puts -nonewline $fd $msg
3888                                         close $fd
3889                                         set GITGUI_BCK_exists 1
3890                                 }
3891                         }
3892
3893                         $ui_comm edit modified false
3894                 }
3895
3896                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3897         }
3898
3899         backup_commit_buffer
3900
3901         # -- If the user has aspell available we can drive it
3902         #    in pipe mode to spellcheck the commit message.
3903         #
3904         set spell_cmd [list |]
3905         set spell_dict [get_config gui.spellingdictionary]
3906         lappend spell_cmd aspell
3907         if {$spell_dict ne {}} {
3908                 lappend spell_cmd --master=$spell_dict
3909         }
3910         lappend spell_cmd --mode=none
3911         lappend spell_cmd --encoding=utf-8
3912         lappend spell_cmd pipe
3913         if {$spell_dict eq {none}
3914          || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3915                 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3916         } else {
3917                 set ui_comm_spell [spellcheck::init \
3918                         $spell_fd \
3919                         $ui_comm \
3920                         $ui_comm_ctxm \
3921                 ]
3922         }
3923         unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3924 }
3925
3926 lock_index begin-read
3927 if {![winfo ismapped .]} {
3928         wm deiconify .
3929 }
3930 after 1 {
3931         if {[is_enabled initialamend]} {
3932                 force_amend
3933         } else {
3934                 do_rescan
3935         }
3936
3937         if {[is_enabled nocommitmsg]} {
3938                 $ui_comm configure -state disabled -background gray
3939         }
3940 }
3941 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
3942         after 1000 hint_gc
3943 }
3944 if {[is_enabled retcode]} {
3945         bind . <Destroy> {+terminate_me %W}
3946 }
3947 if {$picked && [is_config_true gui.autoexplore]} {
3948         do_explore
3949 }
3950
3951 # Local variables:
3952 # mode: tcl
3953 # indent-tabs-mode: t
3954 # tab-width: 4
3955 # End: