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