git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 set appvers {@@GIT_VERSION@@}
   6 set copyright {
   7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23 ######################################################################
  24 ##
  25 ## read only globals
  26
  27 set _appname [lindex [file split $argv0] end]
  28 set _gitdir {}
  29 set _gitexec {}
  30 set _reponame {}
  31 set _iscygwin {}
  32
  33 proc appname {} {
  34         global _appname
  35         return $_appname
  36 }
  37
  38 proc gitdir {args} {
  39         global _gitdir
  40         if {$args eq {}} {
  41                 return $_gitdir
  42         }
  43         return [eval [concat [list file join $_gitdir] $args]]
  44 }
  45
  46 proc gitexec {args} {
  47         global _gitexec
  48         if {$_gitexec eq {}} {
  49                 if {[catch {set _gitexec [exec git --exec-path]} err]} {
  50                         error "Git not installed?\n\n$err"
  51                 }
  52         }
  53         if {$args eq {}} {
  54                 return $_gitexec
  55         }
  56         return [eval [concat [list file join $_gitexec] $args]]
  57 }
  58
  59 proc reponame {} {
  60         global _reponame
  61         return $_reponame
  62 }
  63
  64 proc is_MacOSX {} {
  65         global tcl_platform tk_library
  66         if {[tk windowingsystem] eq {aqua}} {
  67                 return 1
  68         }
  69         return 0
  70 }
  71
  72 proc is_Windows {} {
  73         global tcl_platform
  74         if {$tcl_platform(platform) eq {windows}} {
  75                 return 1
  76         }
  77         return 0
  78 }
  79
  80 proc is_Cygwin {} {
  81         global tcl_platform _iscygwin
  82         if {$_iscygwin eq {}} {
  83                 if {$tcl_platform(platform) eq {windows}} {
  84                         if {[catch {set p [exec cygpath --windir]} err]} {
  85                                 set _iscygwin 0
  86                         } else {
  87                                 set _iscygwin 1
  88                         }
  89                 } else {
  90                         set _iscygwin 0
  91                 }
  92         }
  93         return $_iscygwin
  94 }
  95
  96 proc is_enabled {option} {
  97         global enabled_options
  98         if {[catch {set on $enabled_options($option)}]} {return 0}
  99         return $on
 100 }
 101
 102 proc enable_option {option} {
 103         global enabled_options
 104         set enabled_options($option) 1
 105 }
 106
 107 proc disable_option {option} {
 108         global enabled_options
 109         set enabled_options($option) 0
 110 }
 111
 112 ######################################################################
 113 ##
 114 ## config
 115
 116 proc is_many_config {name} {
 117         switch -glob -- $name {
 118         remote.*.fetch -
 119         remote.*.push
 120                 {return 1}
 121         *
 122                 {return 0}
 123         }
 124 }
 125
 126 proc is_config_true {name} {
 127         global repo_config
 128         if {[catch {set v $repo_config($name)}]} {
 129                 return 0
 130         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 131                 return 1
 132         } else {
 133                 return 0
 134         }
 135 }
 136
 137 proc load_config {include_global} {
 138         global repo_config global_config default_config
 139
 140         array unset global_config
 141         if {$include_global} {
 142                 catch {
 143                         set fd_rc [open "| git repo-config --global --list" r]
 144                         while {[gets $fd_rc line] >= 0} {
 145                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 146                                         if {[is_many_config $name]} {
 147                                                 lappend global_config($name) $value
 148                                         } else {
 149                                                 set global_config($name) $value
 150                                         }
 151                                 }
 152                         }
 153                         close $fd_rc
 154                 }
 155         }
 156
 157         array unset repo_config
 158         catch {
 159                 set fd_rc [open "| git repo-config --list" r]
 160                 while {[gets $fd_rc line] >= 0} {
 161                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 162                                 if {[is_many_config $name]} {
 163                                         lappend repo_config($name) $value
 164                                 } else {
 165                                         set repo_config($name) $value
 166                                 }
 167                         }
 168                 }
 169                 close $fd_rc
 170         }
 171
 172         foreach name [array names default_config] {
 173                 if {[catch {set v $global_config($name)}]} {
 174                         set global_config($name) $default_config($name)
 175                 }
 176                 if {[catch {set v $repo_config($name)}]} {
 177                         set repo_config($name) $default_config($name)
 178                 }
 179         }
 180 }
 181
 182 proc save_config {} {
 183         global default_config font_descs
 184         global repo_config global_config
 185         global repo_config_new global_config_new
 186
 187         foreach option $font_descs {
 188                 set name [lindex $option 0]
 189                 set font [lindex $option 1]
 190                 font configure $font \
 191                         -family $global_config_new(gui.$font^^family) \
 192                         -size $global_config_new(gui.$font^^size)
 193                 font configure ${font}bold \
 194                         -family $global_config_new(gui.$font^^family) \
 195                         -size $global_config_new(gui.$font^^size)
 196                 set global_config_new(gui.$name) [font configure $font]
 197                 unset global_config_new(gui.$font^^family)
 198                 unset global_config_new(gui.$font^^size)
 199         }
 200
 201         foreach name [array names default_config] {
 202                 set value $global_config_new($name)
 203                 if {$value ne $global_config($name)} {
 204                         if {$value eq $default_config($name)} {
 205                                 catch {exec git repo-config --global --unset $name}
 206                         } else {
 207                                 regsub -all "\[{}\]" $value {"} value
 208                                 exec git repo-config --global $name $value
 209                         }
 210                         set global_config($name) $value
 211                         if {$value eq $repo_config($name)} {
 212                                 catch {exec git repo-config --unset $name}
 213                                 set repo_config($name) $value
 214                         }
 215                 }
 216         }
 217
 218         foreach name [array names default_config] {
 219                 set value $repo_config_new($name)
 220                 if {$value ne $repo_config($name)} {
 221                         if {$value eq $global_config($name)} {
 222                                 catch {exec git repo-config --unset $name}
 223                         } else {
 224                                 regsub -all "\[{}\]" $value {"} value
 225                                 exec git repo-config $name $value
 226                         }
 227                         set repo_config($name) $value
 228                 }
 229         }
 230 }
 231
 232 proc error_popup {msg} {
 233         set title [appname]
 234         if {[reponame] ne {}} {
 235                 append title " ([reponame])"
 236         }
 237         set cmd [list tk_messageBox \
 238                 -icon error \
 239                 -type ok \
 240                 -title "$title: error" \
 241                 -message $msg]
 242         if {[winfo ismapped .]} {
 243                 lappend cmd -parent .
 244         }
 245         eval $cmd
 246 }
 247
 248 proc warn_popup {msg} {
 249         set title [appname]
 250         if {[reponame] ne {}} {
 251                 append title " ([reponame])"
 252         }
 253         set cmd [list tk_messageBox \
 254                 -icon warning \
 255                 -type ok \
 256                 -title "$title: warning" \
 257                 -message $msg]
 258         if {[winfo ismapped .]} {
 259                 lappend cmd -parent .
 260         }
 261         eval $cmd
 262 }
 263
 264 proc info_popup {msg {parent .}} {
 265         set title [appname]
 266         if {[reponame] ne {}} {
 267                 append title " ([reponame])"
 268         }
 269         tk_messageBox \
 270                 -parent $parent \
 271                 -icon info \
 272                 -type ok \
 273                 -title $title \
 274                 -message $msg
 275 }
 276
 277 proc ask_popup {msg} {
 278         set title [appname]
 279         if {[reponame] ne {}} {
 280                 append title " ([reponame])"
 281         }
 282         return [tk_messageBox \
 283                 -parent . \
 284                 -icon question \
 285                 -type yesno \
 286                 -title $title \
 287                 -message $msg]
 288 }
 289
 290 ######################################################################
 291 ##
 292 ## repository setup
 293
 294 if {   [catch {set _gitdir $env(GIT_DIR)}]
 295         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 296         catch {wm withdraw .}
 297         error_popup "Cannot find the git directory:\n\n$err"
 298         exit 1
 299 }
 300 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 301         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 302 }
 303 if {![file isdirectory $_gitdir]} {
 304         catch {wm withdraw .}
 305         error_popup "Git directory not found:\n\n$_gitdir"
 306         exit 1
 307 }
 308 if {[lindex [file split $_gitdir] end] ne {.git}} {
 309         catch {wm withdraw .}
 310         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 311         exit 1
 312 }
 313 if {[catch {cd [file dirname $_gitdir]} err]} {
 314         catch {wm withdraw .}
 315         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 316         exit 1
 317 }
 318 set _reponame [lindex [file split \
 319         [file normalize [file dirname $_gitdir]]] \
 320         end]
 321
 322 enable_option multicommit
 323 if {[appname] eq {git-citool}} {
 324         disable_option multicommit
 325 }
 326
 327 ######################################################################
 328 ##
 329 ## task management
 330
 331 set rescan_active 0
 332 set diff_active 0
 333 set last_clicked {}
 334
 335 set disable_on_lock [list]
 336 set index_lock_type none
 337
 338 proc lock_index {type} {
 339         global index_lock_type disable_on_lock
 340
 341         if {$index_lock_type eq {none}} {
 342                 set index_lock_type $type
 343                 foreach w $disable_on_lock {
 344                         uplevel #0 $w disabled
 345                 }
 346                 return 1
 347         } elseif {$index_lock_type eq "begin-$type"} {
 348                 set index_lock_type $type
 349                 return 1
 350         }
 351         return 0
 352 }
 353
 354 proc unlock_index {} {
 355         global index_lock_type disable_on_lock
 356
 357         set index_lock_type none
 358         foreach w $disable_on_lock {
 359                 uplevel #0 $w normal
 360         }
 361 }
 362
 363 ######################################################################
 364 ##
 365 ## status
 366
 367 proc repository_state {ctvar hdvar mhvar} {
 368         global current_branch
 369         upvar $ctvar ct $hdvar hd $mhvar mh
 370
 371         set mh [list]
 372
 373         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 374                 set current_branch {}
 375         } else {
 376                 regsub ^refs/((heads|tags|remotes)/)? \
 377                         $current_branch \
 378                         {} \
 379                         current_branch
 380         }
 381
 382         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 383                 set hd {}
 384                 set ct initial
 385                 return
 386         }
 387
 388         set merge_head [gitdir MERGE_HEAD]
 389         if {[file exists $merge_head]} {
 390                 set ct merge
 391                 set fd_mh [open $merge_head r]
 392                 while {[gets $fd_mh line] >= 0} {
 393                         lappend mh $line
 394                 }
 395                 close $fd_mh
 396                 return
 397         }
 398
 399         set ct normal
 400 }
 401
 402 proc PARENT {} {
 403         global PARENT empty_tree
 404
 405         set p [lindex $PARENT 0]
 406         if {$p ne {}} {
 407                 return $p
 408         }
 409         if {$empty_tree eq {}} {
 410                 set empty_tree [exec git mktree << {}]
 411         }
 412         return $empty_tree
 413 }
 414
 415 proc rescan {after {honor_trustmtime 1}} {
 416         global HEAD PARENT MERGE_HEAD commit_type
 417         global ui_index ui_workdir ui_status_value ui_comm
 418         global rescan_active file_states
 419         global repo_config
 420
 421         if {$rescan_active > 0 || ![lock_index read]} return
 422
 423         repository_state newType newHEAD newMERGE_HEAD
 424         if {[string match amend* $commit_type]
 425                 && $newType eq {normal}
 426                 && $newHEAD eq $HEAD} {
 427         } else {
 428                 set HEAD $newHEAD
 429                 set PARENT $newHEAD
 430                 set MERGE_HEAD $newMERGE_HEAD
 431                 set commit_type $newType
 432         }
 433
 434         array unset file_states
 435
 436         if {![$ui_comm edit modified]
 437                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 438                 if {[load_message GITGUI_MSG]} {
 439                 } elseif {[load_message MERGE_MSG]} {
 440                 } elseif {[load_message SQUASH_MSG]} {
 441                 }
 442                 $ui_comm edit reset
 443                 $ui_comm edit modified false
 444         }
 445
 446         if {[is_enabled multicommit]} {
 447                 load_all_heads
 448                 populate_branch_menu
 449         }
 450
 451         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 452                 rescan_stage2 {} $after
 453         } else {
 454                 set rescan_active 1
 455                 set ui_status_value {Refreshing file status...}
 456                 set cmd [list git update-index]
 457                 lappend cmd -q
 458                 lappend cmd --unmerged
 459                 lappend cmd --ignore-missing
 460                 lappend cmd --refresh
 461                 set fd_rf [open "| $cmd" r]
 462                 fconfigure $fd_rf -blocking 0 -translation binary
 463                 fileevent $fd_rf readable \
 464                         [list rescan_stage2 $fd_rf $after]
 465         }
 466 }
 467
 468 proc rescan_stage2 {fd after} {
 469         global ui_status_value
 470         global rescan_active buf_rdi buf_rdf buf_rlo
 471
 472         if {$fd ne {}} {
 473                 read $fd
 474                 if {![eof $fd]} return
 475                 close $fd
 476         }
 477
 478         set ls_others [list | git ls-files --others -z \
 479                 --exclude-per-directory=.gitignore]
 480         set info_exclude [gitdir info exclude]
 481         if {[file readable $info_exclude]} {
 482                 lappend ls_others "--exclude-from=$info_exclude"
 483         }
 484
 485         set buf_rdi {}
 486         set buf_rdf {}
 487         set buf_rlo {}
 488
 489         set rescan_active 3
 490         set ui_status_value {Scanning for modified files ...}
 491         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 492         set fd_df [open "| git diff-files -z" r]
 493         set fd_lo [open $ls_others r]
 494
 495         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 496         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 497         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 498         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 499         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 500         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 501 }
 502
 503 proc load_message {file} {
 504         global ui_comm
 505
 506         set f [gitdir $file]
 507         if {[file isfile $f]} {
 508                 if {[catch {set fd [open $f r]}]} {
 509                         return 0
 510                 }
 511                 set content [string trim [read $fd]]
 512                 close $fd
 513                 regsub -all -line {[ \r\t]+$} $content {} content
 514                 $ui_comm delete 0.0 end
 515                 $ui_comm insert end $content
 516                 return 1
 517         }
 518         return 0
 519 }
 520
 521 proc read_diff_index {fd after} {
 522         global buf_rdi
 523
 524         append buf_rdi [read $fd]
 525         set c 0
 526         set n [string length $buf_rdi]
 527         while {$c < $n} {
 528                 set z1 [string first "\0" $buf_rdi $c]
 529                 if {$z1 == -1} break
 530                 incr z1
 531                 set z2 [string first "\0" $buf_rdi $z1]
 532                 if {$z2 == -1} break
 533
 534                 incr c
 535                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 536                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 537                 merge_state \
 538                         [encoding convertfrom $p] \
 539                         [lindex $i 4]? \
 540                         [list [lindex $i 0] [lindex $i 2]] \
 541                         [list]
 542                 set c $z2
 543                 incr c
 544         }
 545         if {$c < $n} {
 546                 set buf_rdi [string range $buf_rdi $c end]
 547         } else {
 548                 set buf_rdi {}
 549         }
 550
 551         rescan_done $fd buf_rdi $after
 552 }
 553
 554 proc read_diff_files {fd after} {
 555         global buf_rdf
 556
 557         append buf_rdf [read $fd]
 558         set c 0
 559         set n [string length $buf_rdf]
 560         while {$c < $n} {
 561                 set z1 [string first "\0" $buf_rdf $c]
 562                 if {$z1 == -1} break
 563                 incr z1
 564                 set z2 [string first "\0" $buf_rdf $z1]
 565                 if {$z2 == -1} break
 566
 567                 incr c
 568                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 569                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 570                 merge_state \
 571                         [encoding convertfrom $p] \
 572                         ?[lindex $i 4] \
 573                         [list] \
 574                         [list [lindex $i 0] [lindex $i 2]]
 575                 set c $z2
 576                 incr c
 577         }
 578         if {$c < $n} {
 579                 set buf_rdf [string range $buf_rdf $c end]
 580         } else {
 581                 set buf_rdf {}
 582         }
 583
 584         rescan_done $fd buf_rdf $after
 585 }
 586
 587 proc read_ls_others {fd after} {
 588         global buf_rlo
 589
 590         append buf_rlo [read $fd]
 591         set pck [split $buf_rlo "\0"]
 592         set buf_rlo [lindex $pck end]
 593         foreach p [lrange $pck 0 end-1] {
 594                 merge_state [encoding convertfrom $p] ?O
 595         }
 596         rescan_done $fd buf_rlo $after
 597 }
 598
 599 proc rescan_done {fd buf after} {
 600         global rescan_active
 601         global file_states repo_config
 602         upvar $buf to_clear
 603
 604         if {![eof $fd]} return
 605         set to_clear {}
 606         close $fd
 607         if {[incr rescan_active -1] > 0} return
 608
 609         prune_selection
 610         unlock_index
 611         display_all_files
 612         reshow_diff
 613         uplevel #0 $after
 614 }
 615
 616 proc prune_selection {} {
 617         global file_states selected_paths
 618
 619         foreach path [array names selected_paths] {
 620                 if {[catch {set still_here $file_states($path)}]} {
 621                         unset selected_paths($path)
 622                 }
 623         }
 624 }
 625
 626 ######################################################################
 627 ##
 628 ## diff
 629
 630 proc clear_diff {} {
 631         global ui_diff current_diff_path current_diff_header
 632         global ui_index ui_workdir
 633
 634         $ui_diff conf -state normal
 635         $ui_diff delete 0.0 end
 636         $ui_diff conf -state disabled
 637
 638         set current_diff_path {}
 639         set current_diff_header {}
 640
 641         $ui_index tag remove in_diff 0.0 end
 642         $ui_workdir tag remove in_diff 0.0 end
 643 }
 644
 645 proc reshow_diff {} {
 646         global ui_status_value file_states file_lists
 647         global current_diff_path current_diff_side
 648
 649         set p $current_diff_path
 650         if {$p eq {}
 651                 || $current_diff_side eq {}
 652                 || [catch {set s $file_states($p)}]
 653                 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 654                 clear_diff
 655         } else {
 656                 show_diff $p $current_diff_side
 657         }
 658 }
 659
 660 proc handle_empty_diff {} {
 661         global current_diff_path file_states file_lists
 662
 663         set path $current_diff_path
 664         set s $file_states($path)
 665         if {[lindex $s 0] ne {_M}} return
 666
 667         info_popup "No differences detected.
 668
 669 [short_path $path] has no changes.
 670
 671 The modification date of this file was updated
 672 by another application, but the content within
 673 the file was not changed.
 674
 675 A rescan will be automatically started to find
 676 other files which may have the same state."
 677
 678         clear_diff
 679         display_file $path __
 680         rescan {set ui_status_value {Ready.}} 0
 681 }
 682
 683 proc show_diff {path w {lno {}}} {
 684         global file_states file_lists
 685         global is_3way_diff diff_active repo_config
 686         global ui_diff ui_status_value ui_index ui_workdir
 687         global current_diff_path current_diff_side current_diff_header
 688
 689         if {$diff_active || ![lock_index read]} return
 690
 691         clear_diff
 692         if {$lno == {}} {
 693                 set lno [lsearch -sorted -exact $file_lists($w) $path]
 694                 if {$lno >= 0} {
 695                         incr lno
 696                 }
 697         }
 698         if {$lno >= 1} {
 699                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 700         }
 701
 702         set s $file_states($path)
 703         set m [lindex $s 0]
 704         set is_3way_diff 0
 705         set diff_active 1
 706         set current_diff_path $path
 707         set current_diff_side $w
 708         set current_diff_header {}
 709         set ui_status_value "Loading diff of [escape_path $path]..."
 710
 711         # - Git won't give us the diff, there's nothing to compare to!
 712         #
 713         if {$m eq {_O}} {
 714                 set max_sz [expr {128 * 1024}]
 715                 if {[catch {
 716                                 set fd [open $path r]
 717                                 set content [read $fd $max_sz]
 718                                 close $fd
 719                                 set sz [file size $path]
 720                         } err ]} {
 721                         set diff_active 0
 722                         unlock_index
 723                         set ui_status_value "Unable to display [escape_path $path]"
 724                         error_popup "Error loading file:\n\n$err"
 725                         return
 726                 }
 727                 $ui_diff conf -state normal
 728                 if {![catch {set type [exec file $path]}]} {
 729                         set n [string length $path]
 730                         if {[string equal -length $n $path $type]} {
 731                                 set type [string range $type $n end]
 732                                 regsub {^:?\s*} $type {} type
 733                         }
 734                         $ui_diff insert end "* $type\n" d_@
 735                 }
 736                 if {[string first "\0" $content] != -1} {
 737                         $ui_diff insert end \
 738                                 "* Binary file (not showing content)." \
 739                                 d_@
 740                 } else {
 741                         if {$sz > $max_sz} {
 742                                 $ui_diff insert end \
 743 "* Untracked file is $sz bytes.
 744 * Showing only first $max_sz bytes.
 745 " d_@
 746                         }
 747                         $ui_diff insert end $content
 748                         if {$sz > $max_sz} {
 749                                 $ui_diff insert end "
 750 * Untracked file clipped here by [appname].
 751 * To see the entire file, use an external editor.
 752 " d_@
 753                         }
 754                 }
 755                 $ui_diff conf -state disabled
 756                 set diff_active 0
 757                 unlock_index
 758                 set ui_status_value {Ready.}
 759                 return
 760         }
 761
 762         set cmd [list | git]
 763         if {$w eq $ui_index} {
 764                 lappend cmd diff-index
 765                 lappend cmd --cached
 766         } elseif {$w eq $ui_workdir} {
 767                 if {[string index $m 0] eq {U}} {
 768                         lappend cmd diff
 769                 } else {
 770                         lappend cmd diff-files
 771                 }
 772         }
 773
 774         lappend cmd -p
 775         lappend cmd --no-color
 776         if {$repo_config(gui.diffcontext) > 0} {
 777                 lappend cmd "-U$repo_config(gui.diffcontext)"
 778         }
 779         if {$w eq $ui_index} {
 780                 lappend cmd [PARENT]
 781         }
 782         lappend cmd --
 783         lappend cmd $path
 784
 785         if {[catch {set fd [open $cmd r]} err]} {
 786                 set diff_active 0
 787                 unlock_index
 788                 set ui_status_value "Unable to display [escape_path $path]"
 789                 error_popup "Error loading diff:\n\n$err"
 790                 return
 791         }
 792
 793         fconfigure $fd \
 794                 -blocking 0 \
 795                 -encoding binary \
 796                 -translation binary
 797         fileevent $fd readable [list read_diff $fd]
 798 }
 799
 800 proc read_diff {fd} {
 801         global ui_diff ui_status_value diff_active
 802         global is_3way_diff current_diff_header
 803
 804         $ui_diff conf -state normal
 805         while {[gets $fd line] >= 0} {
 806                 # -- Cleanup uninteresting diff header lines.
 807                 #
 808                 if {   [string match {diff --git *}      $line]
 809                         || [string match {diff --cc *}       $line]
 810                         || [string match {diff --combined *} $line]
 811                         || [string match {--- *}             $line]
 812                         || [string match {+++ *}             $line]} {
 813                         append current_diff_header $line "\n"
 814                         continue
 815                 }
 816                 if {[string match {index *} $line]} continue
 817                 if {$line eq {deleted file mode 120000}} {
 818                         set line "deleted symlink"
 819                 }
 820
 821                 # -- Automatically detect if this is a 3 way diff.
 822                 #
 823                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 824
 825                 if {[string match {mode *} $line]
 826                         || [string match {new file *} $line]
 827                         || [string match {deleted file *} $line]
 828                         || [string match {Binary files * and * differ} $line]
 829                         || $line eq {\ No newline at end of file}
 830                         || [regexp {^\* Unmerged path } $line]} {
 831                         set tags {}
 832                 } elseif {$is_3way_diff} {
 833                         set op [string range $line 0 1]
 834                         switch -- $op {
 835                         {  } {set tags {}}
 836                         {@@} {set tags d_@}
 837                         { +} {set tags d_s+}
 838                         { -} {set tags d_s-}
 839                         {+ } {set tags d_+s}
 840                         {- } {set tags d_-s}
 841                         {--} {set tags d_--}
 842                         {++} {
 843                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 844                                         set line [string replace $line 0 1 {  }]
 845                                         set tags d$op
 846                                 } else {
 847                                         set tags d_++
 848                                 }
 849                         }
 850                         default {
 851                                 puts "error: Unhandled 3 way diff marker: {$op}"
 852                                 set tags {}
 853                         }
 854                         }
 855                 } else {
 856                         set op [string index $line 0]
 857                         switch -- $op {
 858                         { } {set tags {}}
 859                         {@} {set tags d_@}
 860                         {-} {set tags d_-}
 861                         {+} {
 862                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 863                                         set line [string replace $line 0 0 { }]
 864                                         set tags d$op
 865                                 } else {
 866                                         set tags d_+
 867                                 }
 868                         }
 869                         default {
 870                                 puts "error: Unhandled 2 way diff marker: {$op}"
 871                                 set tags {}
 872                         }
 873                         }
 874                 }
 875                 $ui_diff insert end $line $tags
 876                 if {[string index $line end] eq "\r"} {
 877                         $ui_diff tag add d_cr {end - 2c}
 878                 }
 879                 $ui_diff insert end "\n" $tags
 880         }
 881         $ui_diff conf -state disabled
 882
 883         if {[eof $fd]} {
 884                 close $fd
 885                 set diff_active 0
 886                 unlock_index
 887                 set ui_status_value {Ready.}
 888
 889                 if {[$ui_diff index end] eq {2.0}} {
 890                         handle_empty_diff
 891                 }
 892         }
 893 }
 894
 895 proc apply_hunk {x y} {
 896         global current_diff_path current_diff_header current_diff_side
 897         global ui_diff ui_index file_states
 898
 899         if {$current_diff_path eq {} || $current_diff_header eq {}} return
 900         if {![lock_index apply_hunk]} return
 901
 902         set apply_cmd {git apply --cached --whitespace=nowarn}
 903         set mi [lindex $file_states($current_diff_path) 0]
 904         if {$current_diff_side eq $ui_index} {
 905                 set mode unstage
 906                 lappend apply_cmd --reverse
 907                 if {[string index $mi 0] ne {M}} {
 908                         unlock_index
 909                         return
 910                 }
 911         } else {
 912                 set mode stage
 913                 if {[string index $mi 1] ne {M}} {
 914                         unlock_index
 915                         return
 916                 }
 917         }
 918
 919         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 920         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 921         if {$s_lno eq {}} {
 922                 unlock_index
 923                 return
 924         }
 925
 926         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 927         if {$e_lno eq {}} {
 928                 set e_lno end
 929         }
 930
 931         if {[catch {
 932                 set p [open "| $apply_cmd" w]
 933                 fconfigure $p -translation binary -encoding binary
 934                 puts -nonewline $p $current_diff_header
 935                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 936                 close $p} err]} {
 937                 error_popup "Failed to $mode selected hunk.\n\n$err"
 938                 unlock_index
 939                 return
 940         }
 941
 942         $ui_diff conf -state normal
 943         $ui_diff delete $s_lno $e_lno
 944         $ui_diff conf -state disabled
 945
 946         if {[$ui_diff get 1.0 end] eq "\n"} {
 947                 set o _
 948         } else {
 949                 set o ?
 950         }
 951
 952         if {$current_diff_side eq $ui_index} {
 953                 set mi ${o}M
 954         } elseif {[string index $mi 0] eq {_}} {
 955                 set mi M$o
 956         } else {
 957                 set mi ?$o
 958         }
 959         unlock_index
 960         display_file $current_diff_path $mi
 961         if {$o eq {_}} {
 962                 clear_diff
 963         }
 964 }
 965
 966 ######################################################################
 967 ##
 968 ## commit
 969
 970 proc load_last_commit {} {
 971         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 972         global repo_config
 973
 974         if {[llength $PARENT] == 0} {
 975                 error_popup {There is nothing to amend.
 976
 977 You are about to create the initial commit.
 978 There is no commit before this to amend.
 979 }
 980                 return
 981         }
 982
 983         repository_state curType curHEAD curMERGE_HEAD
 984         if {$curType eq {merge}} {
 985                 error_popup {Cannot amend while merging.
 986
 987 You are currently in the middle of a merge that
 988 has not been fully completed.  You cannot amend
 989 the prior commit unless you first abort the
 990 current merge activity.
 991 }
 992                 return
 993         }
 994
 995         set msg {}
 996         set parents [list]
 997         if {[catch {
 998                         set fd [open "| git cat-file commit $curHEAD" r]
 999                         fconfigure $fd -encoding binary -translation lf
1000                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1001                                 set enc utf-8
1002                         }
1003                         while {[gets $fd line] > 0} {
1004                                 if {[string match {parent *} $line]} {
1005                                         lappend parents [string range $line 7 end]
1006                                 } elseif {[string match {encoding *} $line]} {
1007                                         set enc [string tolower [string range $line 9 end]]
1008                                 }
1009                         }
1010                         fconfigure $fd -encoding $enc
1011                         set msg [string trim [read $fd]]
1012                         close $fd
1013                 } err]} {
1014                 error_popup "Error loading commit data for amend:\n\n$err"
1015                 return
1016         }
1017
1018         set HEAD $curHEAD
1019         set PARENT $parents
1020         set MERGE_HEAD [list]
1021         switch -- [llength $parents] {
1022         0       {set commit_type amend-initial}
1023         1       {set commit_type amend}
1024         default {set commit_type amend-merge}
1025         }
1026
1027         $ui_comm delete 0.0 end
1028         $ui_comm insert end $msg
1029         $ui_comm edit reset
1030         $ui_comm edit modified false
1031         rescan {set ui_status_value {Ready.}}
1032 }
1033
1034 proc create_new_commit {} {
1035         global commit_type ui_comm
1036
1037         set commit_type normal
1038         $ui_comm delete 0.0 end
1039         $ui_comm edit reset
1040         $ui_comm edit modified false
1041         rescan {set ui_status_value {Ready.}}
1042 }
1043
1044 set GIT_COMMITTER_IDENT {}
1045
1046 proc committer_ident {} {
1047         global GIT_COMMITTER_IDENT
1048
1049         if {$GIT_COMMITTER_IDENT eq {}} {
1050                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1051                         error_popup "Unable to obtain your identity:\n\n$err"
1052                         return {}
1053                 }
1054                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1055                         $me me GIT_COMMITTER_IDENT]} {
1056                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1057                         return {}
1058                 }
1059         }
1060
1061         return $GIT_COMMITTER_IDENT
1062 }
1063
1064 proc commit_tree {} {
1065         global HEAD commit_type file_states ui_comm repo_config
1066         global ui_status_value pch_error
1067
1068         if {[committer_ident] eq {}} return
1069         if {![lock_index update]} return
1070
1071         # -- Our in memory state should match the repository.
1072         #
1073         repository_state curType curHEAD curMERGE_HEAD
1074         if {[string match amend* $commit_type]
1075                 && $curType eq {normal}
1076                 && $curHEAD eq $HEAD} {
1077         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1078                 info_popup {Last scanned state does not match repository state.
1079
1080 Another Git program has modified this repository
1081 since the last scan.  A rescan must be performed
1082 before another commit can be created.
1083
1084 The rescan will be automatically started now.
1085 }
1086                 unlock_index
1087                 rescan {set ui_status_value {Ready.}}
1088                 return
1089         }
1090
1091         # -- At least one file should differ in the index.
1092         #
1093         set files_ready 0
1094         foreach path [array names file_states] {
1095                 switch -glob -- [lindex $file_states($path) 0] {
1096                 _? {continue}
1097                 A? -
1098                 D? -
1099                 M? {set files_ready 1}
1100                 U? {
1101                         error_popup "Unmerged files cannot be committed.
1102
1103 File [short_path $path] has merge conflicts.
1104 You must resolve them and add the file before committing.
1105 "
1106                         unlock_index
1107                         return
1108                 }
1109                 default {
1110                         error_popup "Unknown file state [lindex $s 0] detected.
1111
1112 File [short_path $path] cannot be committed by this program.
1113 "
1114                 }
1115                 }
1116         }
1117         if {!$files_ready} {
1118                 info_popup {No changes to commit.
1119
1120 You must add at least 1 file before you can commit.
1121 }
1122                 unlock_index
1123                 return
1124         }
1125
1126         # -- A message is required.
1127         #
1128         set msg [string trim [$ui_comm get 1.0 end]]
1129         regsub -all -line {[ \t\r]+$} $msg {} msg
1130         if {$msg eq {}} {
1131                 error_popup {Please supply a commit message.
1132
1133 A good commit message has the following format:
1134
1135 - First line: Describe in one sentance what you did.
1136 - Second line: Blank
1137 - Remaining lines: Describe why this change is good.
1138 }
1139                 unlock_index
1140                 return
1141         }
1142
1143         # -- Run the pre-commit hook.
1144         #
1145         set pchook [gitdir hooks pre-commit]
1146
1147         # On Cygwin [file executable] might lie so we need to ask
1148         # the shell if the hook is executable.  Yes that's annoying.
1149         #
1150         if {[is_Cygwin] && [file isfile $pchook]} {
1151                 set pchook [list sh -c [concat \
1152                         "if test -x \"$pchook\";" \
1153                         "then exec \"$pchook\" 2>&1;" \
1154                         "fi"]]
1155         } elseif {[file executable $pchook]} {
1156                 set pchook [list $pchook |& cat]
1157         } else {
1158                 commit_writetree $curHEAD $msg
1159                 return
1160         }
1161
1162         set ui_status_value {Calling pre-commit hook...}
1163         set pch_error {}
1164         set fd_ph [open "| $pchook" r]
1165         fconfigure $fd_ph -blocking 0 -translation binary
1166         fileevent $fd_ph readable \
1167                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1168 }
1169
1170 proc commit_prehook_wait {fd_ph curHEAD msg} {
1171         global pch_error ui_status_value
1172
1173         append pch_error [read $fd_ph]
1174         fconfigure $fd_ph -blocking 1
1175         if {[eof $fd_ph]} {
1176                 if {[catch {close $fd_ph}]} {
1177                         set ui_status_value {Commit declined by pre-commit hook.}
1178                         hook_failed_popup pre-commit $pch_error
1179                         unlock_index
1180                 } else {
1181                         commit_writetree $curHEAD $msg
1182                 }
1183                 set pch_error {}
1184                 return
1185         }
1186         fconfigure $fd_ph -blocking 0
1187 }
1188
1189 proc commit_writetree {curHEAD msg} {
1190         global ui_status_value
1191
1192         set ui_status_value {Committing changes...}
1193         set fd_wt [open "| git write-tree" r]
1194         fileevent $fd_wt readable \
1195                 [list commit_committree $fd_wt $curHEAD $msg]
1196 }
1197
1198 proc commit_committree {fd_wt curHEAD msg} {
1199         global HEAD PARENT MERGE_HEAD commit_type
1200         global all_heads current_branch
1201         global ui_status_value ui_comm selected_commit_type
1202         global file_states selected_paths rescan_active
1203         global repo_config
1204
1205         gets $fd_wt tree_id
1206         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1207                 error_popup "write-tree failed:\n\n$err"
1208                 set ui_status_value {Commit failed.}
1209                 unlock_index
1210                 return
1211         }
1212
1213         # -- Build the message.
1214         #
1215         set msg_p [gitdir COMMIT_EDITMSG]
1216         set msg_wt [open $msg_p w]
1217         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1218                 set enc utf-8
1219         }
1220         fconfigure $msg_wt -encoding $enc -translation binary
1221         puts -nonewline $msg_wt $msg
1222         close $msg_wt
1223
1224         # -- Create the commit.
1225         #
1226         set cmd [list git commit-tree $tree_id]
1227         set parents [concat $PARENT $MERGE_HEAD]
1228         if {[llength $parents] > 0} {
1229                 foreach p $parents {
1230                         lappend cmd -p $p
1231                 }
1232         } else {
1233                 # git commit-tree writes to stderr during initial commit.
1234                 lappend cmd 2>/dev/null
1235         }
1236         lappend cmd <$msg_p
1237         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1238                 error_popup "commit-tree failed:\n\n$err"
1239                 set ui_status_value {Commit failed.}
1240                 unlock_index
1241                 return
1242         }
1243
1244         # -- Update the HEAD ref.
1245         #
1246         set reflogm commit
1247         if {$commit_type ne {normal}} {
1248                 append reflogm " ($commit_type)"
1249         }
1250         set i [string first "\n" $msg]
1251         if {$i >= 0} {
1252                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1253         } else {
1254                 append reflogm {: } $msg
1255         }
1256         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1257         if {[catch {eval exec $cmd} err]} {
1258                 error_popup "update-ref failed:\n\n$err"
1259                 set ui_status_value {Commit failed.}
1260                 unlock_index
1261                 return
1262         }
1263
1264         # -- Make sure our current branch exists.
1265         #
1266         if {$commit_type eq {initial}} {
1267                 lappend all_heads $current_branch
1268                 set all_heads [lsort -unique $all_heads]
1269                 populate_branch_menu
1270         }
1271
1272         # -- Cleanup after ourselves.
1273         #
1274         catch {file delete $msg_p}
1275         catch {file delete [gitdir MERGE_HEAD]}
1276         catch {file delete [gitdir MERGE_MSG]}
1277         catch {file delete [gitdir SQUASH_MSG]}
1278         catch {file delete [gitdir GITGUI_MSG]}
1279
1280         # -- Let rerere do its thing.
1281         #
1282         if {[file isdirectory [gitdir rr-cache]]} {
1283                 catch {exec git rerere}
1284         }
1285
1286         # -- Run the post-commit hook.
1287         #
1288         set pchook [gitdir hooks post-commit]
1289         if {[is_Cygwin] && [file isfile $pchook]} {
1290                 set pchook [list sh -c [concat \
1291                         "if test -x \"$pchook\";" \
1292                         "then exec \"$pchook\";" \
1293                         "fi"]]
1294         } elseif {![file executable $pchook]} {
1295                 set pchook {}
1296         }
1297         if {$pchook ne {}} {
1298                 catch {exec $pchook &}
1299         }
1300
1301         $ui_comm delete 0.0 end
1302         $ui_comm edit reset
1303         $ui_comm edit modified false
1304
1305         if {![is_enabled multicommit]} do_quit
1306
1307         # -- Update in memory status
1308         #
1309         set selected_commit_type new
1310         set commit_type normal
1311         set HEAD $cmt_id
1312         set PARENT $cmt_id
1313         set MERGE_HEAD [list]
1314
1315         foreach path [array names file_states] {
1316                 set s $file_states($path)
1317                 set m [lindex $s 0]
1318                 switch -glob -- $m {
1319                 _O -
1320                 _M -
1321                 _D {continue}
1322                 __ -
1323                 A_ -
1324                 M_ -
1325                 D_ {
1326                         unset file_states($path)
1327                         catch {unset selected_paths($path)}
1328                 }
1329                 DO {
1330                         set file_states($path) [list _O [lindex $s 1] {} {}]
1331                 }
1332                 AM -
1333                 AD -
1334                 MM -
1335                 MD {
1336                         set file_states($path) [list \
1337                                 _[string index $m 1] \
1338                                 [lindex $s 1] \
1339                                 [lindex $s 3] \
1340                                 {}]
1341                 }
1342                 }
1343         }
1344
1345         display_all_files
1346         unlock_index
1347         reshow_diff
1348         set ui_status_value \
1349                 "Changes committed as [string range $cmt_id 0 7]."
1350 }
1351
1352 ######################################################################
1353 ##
1354 ## fetch push
1355
1356 proc fetch_from {remote} {
1357         set w [new_console \
1358                 "fetch $remote" \
1359                 "Fetching new changes from $remote"]
1360         set cmd [list git fetch]
1361         lappend cmd $remote
1362         console_exec $w $cmd console_done
1363 }
1364
1365 proc push_to {remote} {
1366         set w [new_console \
1367                 "push $remote" \
1368                 "Pushing changes to $remote"]
1369         set cmd [list git push]
1370         lappend cmd -v
1371         lappend cmd $remote
1372         console_exec $w $cmd console_done
1373 }
1374
1375 ######################################################################
1376 ##
1377 ## ui helpers
1378
1379 proc mapicon {w state path} {
1380         global all_icons
1381
1382         if {[catch {set r $all_icons($state$w)}]} {
1383                 puts "error: no icon for $w state={$state} $path"
1384                 return file_plain
1385         }
1386         return $r
1387 }
1388
1389 proc mapdesc {state path} {
1390         global all_descs
1391
1392         if {[catch {set r $all_descs($state)}]} {
1393                 puts "error: no desc for state={$state} $path"
1394                 return $state
1395         }
1396         return $r
1397 }
1398
1399 proc escape_path {path} {
1400         regsub -all {\\} $path "\\\\" path
1401         regsub -all "\n" $path "\\n" path
1402         return $path
1403 }
1404
1405 proc short_path {path} {
1406         return [escape_path [lindex [file split $path] end]]
1407 }
1408
1409 set next_icon_id 0
1410 set null_sha1 [string repeat 0 40]
1411
1412 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1413         global file_states next_icon_id null_sha1
1414
1415         set s0 [string index $new_state 0]
1416         set s1 [string index $new_state 1]
1417
1418         if {[catch {set info $file_states($path)}]} {
1419                 set state __
1420                 set icon n[incr next_icon_id]
1421         } else {
1422                 set state [lindex $info 0]
1423                 set icon [lindex $info 1]
1424                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1425                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1426         }
1427
1428         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1429         elseif {$s0 eq {_}} {set s0 _}
1430
1431         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1432         elseif {$s1 eq {_}} {set s1 _}
1433
1434         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1435                 set head_info [list 0 $null_sha1]
1436         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1437                 && $head_info eq {}} {
1438                 set head_info $index_info
1439         }
1440
1441         set file_states($path) [list $s0$s1 $icon \
1442                 $head_info $index_info \
1443                 ]
1444         return $state
1445 }
1446
1447 proc display_file_helper {w path icon_name old_m new_m} {
1448         global file_lists
1449
1450         if {$new_m eq {_}} {
1451                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1452                 if {$lno >= 0} {
1453                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1454                         incr lno
1455                         $w conf -state normal
1456                         $w delete $lno.0 [expr {$lno + 1}].0
1457                         $w conf -state disabled
1458                 }
1459         } elseif {$old_m eq {_} && $new_m ne {_}} {
1460                 lappend file_lists($w) $path
1461                 set file_lists($w) [lsort -unique $file_lists($w)]
1462                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1463                 incr lno
1464                 $w conf -state normal
1465                 $w image create $lno.0 \
1466                         -align center -padx 5 -pady 1 \
1467                         -name $icon_name \
1468                         -image [mapicon $w $new_m $path]
1469                 $w insert $lno.1 "[escape_path $path]\n"
1470                 $w conf -state disabled
1471         } elseif {$old_m ne $new_m} {
1472                 $w conf -state normal
1473                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1474                 $w conf -state disabled
1475         }
1476 }
1477
1478 proc display_file {path state} {
1479         global file_states selected_paths
1480         global ui_index ui_workdir
1481
1482         set old_m [merge_state $path $state]
1483         set s $file_states($path)
1484         set new_m [lindex $s 0]
1485         set icon_name [lindex $s 1]
1486
1487         set o [string index $old_m 0]
1488         set n [string index $new_m 0]
1489         if {$o eq {U}} {
1490                 set o _
1491         }
1492         if {$n eq {U}} {
1493                 set n _
1494         }
1495         display_file_helper     $ui_index $path $icon_name $o $n
1496
1497         if {[string index $old_m 0] eq {U}} {
1498                 set o U
1499         } else {
1500                 set o [string index $old_m 1]
1501         }
1502         if {[string index $new_m 0] eq {U}} {
1503                 set n U
1504         } else {
1505                 set n [string index $new_m 1]
1506         }
1507         display_file_helper     $ui_workdir $path $icon_name $o $n
1508
1509         if {$new_m eq {__}} {
1510                 unset file_states($path)
1511                 catch {unset selected_paths($path)}
1512         }
1513 }
1514
1515 proc display_all_files_helper {w path icon_name m} {
1516         global file_lists
1517
1518         lappend file_lists($w) $path
1519         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1520         $w image create end \
1521                 -align center -padx 5 -pady 1 \
1522                 -name $icon_name \
1523                 -image [mapicon $w $m $path]
1524         $w insert end "[escape_path $path]\n"
1525 }
1526
1527 proc display_all_files {} {
1528         global ui_index ui_workdir
1529         global file_states file_lists
1530         global last_clicked
1531
1532         $ui_index conf -state normal
1533         $ui_workdir conf -state normal
1534
1535         $ui_index delete 0.0 end
1536         $ui_workdir delete 0.0 end
1537         set last_clicked {}
1538
1539         set file_lists($ui_index) [list]
1540         set file_lists($ui_workdir) [list]
1541
1542         foreach path [lsort [array names file_states]] {
1543                 set s $file_states($path)
1544                 set m [lindex $s 0]
1545                 set icon_name [lindex $s 1]
1546
1547                 set s [string index $m 0]
1548                 if {$s ne {U} && $s ne {_}} {
1549                         display_all_files_helper $ui_index $path \
1550                                 $icon_name $s
1551                 }
1552
1553                 if {[string index $m 0] eq {U}} {
1554                         set s U
1555                 } else {
1556                         set s [string index $m 1]
1557                 }
1558                 if {$s ne {_}} {
1559                         display_all_files_helper $ui_workdir $path \
1560                                 $icon_name $s
1561                 }
1562         }
1563
1564         $ui_index conf -state disabled
1565         $ui_workdir conf -state disabled
1566 }
1567
1568 proc update_indexinfo {msg pathList after} {
1569         global update_index_cp ui_status_value
1570
1571         if {![lock_index update]} return
1572
1573         set update_index_cp 0
1574         set pathList [lsort $pathList]
1575         set totalCnt [llength $pathList]
1576         set batch [expr {int($totalCnt * .01) + 1}]
1577         if {$batch > 25} {set batch 25}
1578
1579         set ui_status_value [format \
1580                 "$msg... %i/%i files (%.2f%%)" \
1581                 $update_index_cp \
1582                 $totalCnt \
1583                 0.0]
1584         set fd [open "| git update-index -z --index-info" w]
1585         fconfigure $fd \
1586                 -blocking 0 \
1587                 -buffering full \
1588                 -buffersize 512 \
1589                 -encoding binary \
1590                 -translation binary
1591         fileevent $fd writable [list \
1592                 write_update_indexinfo \
1593                 $fd \
1594                 $pathList \
1595                 $totalCnt \
1596                 $batch \
1597                 $msg \
1598                 $after \
1599                 ]
1600 }
1601
1602 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1603         global update_index_cp ui_status_value
1604         global file_states current_diff_path
1605
1606         if {$update_index_cp >= $totalCnt} {
1607                 close $fd
1608                 unlock_index
1609                 uplevel #0 $after
1610                 return
1611         }
1612
1613         for {set i $batch} \
1614                 {$update_index_cp < $totalCnt && $i > 0} \
1615                 {incr i -1} {
1616                 set path [lindex $pathList $update_index_cp]
1617                 incr update_index_cp
1618
1619                 set s $file_states($path)
1620                 switch -glob -- [lindex $s 0] {
1621                 A? {set new _O}
1622                 M? {set new _M}
1623                 D_ {set new _D}
1624                 D? {set new _?}
1625                 ?? {continue}
1626                 }
1627                 set info [lindex $s 2]
1628                 if {$info eq {}} continue
1629
1630                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1631                 display_file $path $new
1632         }
1633
1634         set ui_status_value [format \
1635                 "$msg... %i/%i files (%.2f%%)" \
1636                 $update_index_cp \
1637                 $totalCnt \
1638                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1639 }
1640
1641 proc update_index {msg pathList after} {
1642         global update_index_cp ui_status_value
1643
1644         if {![lock_index update]} return
1645
1646         set update_index_cp 0
1647         set pathList [lsort $pathList]
1648         set totalCnt [llength $pathList]
1649         set batch [expr {int($totalCnt * .01) + 1}]
1650         if {$batch > 25} {set batch 25}
1651
1652         set ui_status_value [format \
1653                 "$msg... %i/%i files (%.2f%%)" \
1654                 $update_index_cp \
1655                 $totalCnt \
1656                 0.0]
1657         set fd [open "| git update-index --add --remove -z --stdin" w]
1658         fconfigure $fd \
1659                 -blocking 0 \
1660                 -buffering full \
1661                 -buffersize 512 \
1662                 -encoding binary \
1663                 -translation binary
1664         fileevent $fd writable [list \
1665                 write_update_index \
1666                 $fd \
1667                 $pathList \
1668                 $totalCnt \
1669                 $batch \
1670                 $msg \
1671                 $after \
1672                 ]
1673 }
1674
1675 proc write_update_index {fd pathList totalCnt batch msg after} {
1676         global update_index_cp ui_status_value
1677         global file_states current_diff_path
1678
1679         if {$update_index_cp >= $totalCnt} {
1680                 close $fd
1681                 unlock_index
1682                 uplevel #0 $after
1683                 return
1684         }
1685
1686         for {set i $batch} \
1687                 {$update_index_cp < $totalCnt && $i > 0} \
1688                 {incr i -1} {
1689                 set path [lindex $pathList $update_index_cp]
1690                 incr update_index_cp
1691
1692                 switch -glob -- [lindex $file_states($path) 0] {
1693                 AD {set new __}
1694                 ?D {set new D_}
1695                 _O -
1696                 AM {set new A_}
1697                 U? {
1698                         if {[file exists $path]} {
1699                                 set new M_
1700                         } else {
1701                                 set new D_
1702                         }
1703                 }
1704                 ?M {set new M_}
1705                 ?? {continue}
1706                 }
1707                 puts -nonewline $fd "[encoding convertto $path]\0"
1708                 display_file $path $new
1709         }
1710
1711         set ui_status_value [format \
1712                 "$msg... %i/%i files (%.2f%%)" \
1713                 $update_index_cp \
1714                 $totalCnt \
1715                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1716 }
1717
1718 proc checkout_index {msg pathList after} {
1719         global update_index_cp ui_status_value
1720
1721         if {![lock_index update]} return
1722
1723         set update_index_cp 0
1724         set pathList [lsort $pathList]
1725         set totalCnt [llength $pathList]
1726         set batch [expr {int($totalCnt * .01) + 1}]
1727         if {$batch > 25} {set batch 25}
1728
1729         set ui_status_value [format \
1730                 "$msg... %i/%i files (%.2f%%)" \
1731                 $update_index_cp \
1732                 $totalCnt \
1733                 0.0]
1734         set cmd [list git checkout-index]
1735         lappend cmd --index
1736         lappend cmd --quiet
1737         lappend cmd --force
1738         lappend cmd -z
1739         lappend cmd --stdin
1740         set fd [open "| $cmd " w]
1741         fconfigure $fd \
1742                 -blocking 0 \
1743                 -buffering full \
1744                 -buffersize 512 \
1745                 -encoding binary \
1746                 -translation binary
1747         fileevent $fd writable [list \
1748                 write_checkout_index \
1749                 $fd \
1750                 $pathList \
1751                 $totalCnt \
1752                 $batch \
1753                 $msg \
1754                 $after \
1755                 ]
1756 }
1757
1758 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1759         global update_index_cp ui_status_value
1760         global file_states current_diff_path
1761
1762         if {$update_index_cp >= $totalCnt} {
1763                 close $fd
1764                 unlock_index
1765                 uplevel #0 $after
1766                 return
1767         }
1768
1769         for {set i $batch} \
1770                 {$update_index_cp < $totalCnt && $i > 0} \
1771                 {incr i -1} {
1772                 set path [lindex $pathList $update_index_cp]
1773                 incr update_index_cp
1774                 switch -glob -- [lindex $file_states($path) 0] {
1775                 U? {continue}
1776                 ?M -
1777                 ?D {
1778                         puts -nonewline $fd "[encoding convertto $path]\0"
1779                         display_file $path ?_
1780                 }
1781                 }
1782         }
1783
1784         set ui_status_value [format \
1785                 "$msg... %i/%i files (%.2f%%)" \
1786                 $update_index_cp \
1787                 $totalCnt \
1788                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1789 }
1790
1791 ######################################################################
1792 ##
1793 ## branch management
1794
1795 proc is_tracking_branch {name} {
1796         global tracking_branches
1797
1798         if {![catch {set info $tracking_branches($name)}]} {
1799                 return 1
1800         }
1801         foreach t [array names tracking_branches] {
1802                 if {[string match {*/\*} $t] && [string match $t $name]} {
1803                         return 1
1804                 }
1805         }
1806         return 0
1807 }
1808
1809 proc load_all_heads {} {
1810         global all_heads
1811
1812         set all_heads [list]
1813         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1814         while {[gets $fd line] > 0} {
1815                 if {[is_tracking_branch $line]} continue
1816                 if {![regsub ^refs/heads/ $line {} name]} continue
1817                 lappend all_heads $name
1818         }
1819         close $fd
1820
1821         set all_heads [lsort $all_heads]
1822 }
1823
1824 proc populate_branch_menu {} {
1825         global all_heads disable_on_lock
1826
1827         set m .mbar.branch
1828         set last [$m index last]
1829         for {set i 0} {$i <= $last} {incr i} {
1830                 if {[$m type $i] eq {separator}} {
1831                         $m delete $i last
1832                         set new_dol [list]
1833                         foreach a $disable_on_lock {
1834                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1835                                         lappend new_dol $a
1836                                 }
1837                         }
1838                         set disable_on_lock $new_dol
1839                         break
1840                 }
1841         }
1842
1843         if {$all_heads ne {}} {
1844                 $m add separator
1845         }
1846         foreach b $all_heads {
1847                 $m add radiobutton \
1848                         -label $b \
1849                         -command [list switch_branch $b] \
1850                         -variable current_branch \
1851                         -value $b \
1852                         -font font_ui
1853                 lappend disable_on_lock \
1854                         [list $m entryconf [$m index last] -state]
1855         }
1856 }
1857
1858 proc all_tracking_branches {} {
1859         global tracking_branches
1860
1861         set all_trackings {}
1862         set cmd {}
1863         foreach name [array names tracking_branches] {
1864                 if {[regsub {/\*$} $name {} name]} {
1865                         lappend cmd $name
1866                 } else {
1867                         regsub ^refs/(heads|remotes)/ $name {} name
1868                         lappend all_trackings $name
1869                 }
1870         }
1871
1872         if {$cmd ne {}} {
1873                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1874                 while {[gets $fd name] > 0} {
1875                         regsub ^refs/(heads|remotes)/ $name {} name
1876                         lappend all_trackings $name
1877                 }
1878                 close $fd
1879         }
1880
1881         return [lsort -unique $all_trackings]
1882 }
1883
1884 proc do_create_branch_action {w} {
1885         global all_heads null_sha1 repo_config
1886         global create_branch_checkout create_branch_revtype
1887         global create_branch_head create_branch_trackinghead
1888         global create_branch_name create_branch_revexp
1889
1890         set newbranch $create_branch_name
1891         if {$newbranch eq {}
1892                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1893                 tk_messageBox \
1894                         -icon error \
1895                         -type ok \
1896                         -title [wm title $w] \
1897                         -parent $w \
1898                         -message "Please supply a branch name."
1899                 focus $w.desc.name_t
1900                 return
1901         }
1902         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1903                 tk_messageBox \
1904                         -icon error \
1905                         -type ok \
1906                         -title [wm title $w] \
1907                         -parent $w \
1908                         -message "Branch '$newbranch' already exists."
1909                 focus $w.desc.name_t
1910                 return
1911         }
1912         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1913                 tk_messageBox \
1914                         -icon error \
1915                         -type ok \
1916                         -title [wm title $w] \
1917                         -parent $w \
1918                         -message "We do not like '$newbranch' as a branch name."
1919                 focus $w.desc.name_t
1920                 return
1921         }
1922
1923         set rev {}
1924         switch -- $create_branch_revtype {
1925         head {set rev $create_branch_head}
1926         tracking {set rev $create_branch_trackinghead}
1927         expression {set rev $create_branch_revexp}
1928         }
1929         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1930                 tk_messageBox \
1931                         -icon error \
1932                         -type ok \
1933                         -title [wm title $w] \
1934                         -parent $w \
1935                         -message "Invalid starting revision: $rev"
1936                 return
1937         }
1938         set cmd [list git update-ref]
1939         lappend cmd -m
1940         lappend cmd "branch: Created from $rev"
1941         lappend cmd "refs/heads/$newbranch"
1942         lappend cmd $cmt
1943         lappend cmd $null_sha1
1944         if {[catch {eval exec $cmd} err]} {
1945                 tk_messageBox \
1946                         -icon error \
1947                         -type ok \
1948                         -title [wm title $w] \
1949                         -parent $w \
1950                         -message "Failed to create '$newbranch'.\n\n$err"
1951                 return
1952         }
1953
1954         lappend all_heads $newbranch
1955         set all_heads [lsort $all_heads]
1956         populate_branch_menu
1957         destroy $w
1958         if {$create_branch_checkout} {
1959                 switch_branch $newbranch
1960         }
1961 }
1962
1963 proc radio_selector {varname value args} {
1964         upvar #0 $varname var
1965         set var $value
1966 }
1967
1968 trace add variable create_branch_head write \
1969         [list radio_selector create_branch_revtype head]
1970 trace add variable create_branch_trackinghead write \
1971         [list radio_selector create_branch_revtype tracking]
1972
1973 trace add variable delete_branch_head write \
1974         [list radio_selector delete_branch_checktype head]
1975 trace add variable delete_branch_trackinghead write \
1976         [list radio_selector delete_branch_checktype tracking]
1977
1978 proc do_create_branch {} {
1979         global all_heads current_branch repo_config
1980         global create_branch_checkout create_branch_revtype
1981         global create_branch_head create_branch_trackinghead
1982         global create_branch_name create_branch_revexp
1983
1984         set w .branch_editor
1985         toplevel $w
1986         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1987
1988         label $w.header -text {Create New Branch} \
1989                 -font font_uibold
1990         pack $w.header -side top -fill x
1991
1992         frame $w.buttons
1993         button $w.buttons.create -text Create \
1994                 -font font_ui \
1995                 -default active \
1996                 -command [list do_create_branch_action $w]
1997         pack $w.buttons.create -side right
1998         button $w.buttons.cancel -text {Cancel} \
1999                 -font font_ui \
2000                 -command [list destroy $w]
2001         pack $w.buttons.cancel -side right -padx 5
2002         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2003
2004         labelframe $w.desc \
2005                 -text {Branch Description} \
2006                 -font font_ui
2007         label $w.desc.name_l -text {Name:} -font font_ui
2008         entry $w.desc.name_t \
2009                 -borderwidth 1 \
2010                 -relief sunken \
2011                 -width 40 \
2012                 -textvariable create_branch_name \
2013                 -font font_ui \
2014                 -validate key \
2015                 -validatecommand {
2016                         if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2017                         return 1
2018                 }
2019         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2020         grid columnconfigure $w.desc 1 -weight 1
2021         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2022
2023         labelframe $w.from \
2024                 -text {Starting Revision} \
2025                 -font font_ui
2026         radiobutton $w.from.head_r \
2027                 -text {Local Branch:} \
2028                 -value head \
2029                 -variable create_branch_revtype \
2030                 -font font_ui
2031         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2032         grid $w.from.head_r $w.from.head_m -sticky w
2033         set all_trackings [all_tracking_branches]
2034         if {$all_trackings ne {}} {
2035                 set create_branch_trackinghead [lindex $all_trackings 0]
2036                 radiobutton $w.from.tracking_r \
2037                         -text {Tracking Branch:} \
2038                         -value tracking \
2039                         -variable create_branch_revtype \
2040                         -font font_ui
2041                 eval tk_optionMenu $w.from.tracking_m \
2042                         create_branch_trackinghead \
2043                         $all_trackings
2044                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2045         }
2046         radiobutton $w.from.exp_r \
2047                 -text {Revision Expression:} \
2048                 -value expression \
2049                 -variable create_branch_revtype \
2050                 -font font_ui
2051         entry $w.from.exp_t \
2052                 -borderwidth 1 \
2053                 -relief sunken \
2054                 -width 50 \
2055                 -textvariable create_branch_revexp \
2056                 -font font_ui \
2057                 -validate key \
2058                 -validatecommand {
2059                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2060                         if {%d == 1 && [string length %S] > 0} {
2061                                 set create_branch_revtype expression
2062                         }
2063                         return 1
2064                 }
2065         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2066         grid columnconfigure $w.from 1 -weight 1
2067         pack $w.from -anchor nw -fill x -pady 5 -padx 5
2068
2069         labelframe $w.postActions \
2070                 -text {Post Creation Actions} \
2071                 -font font_ui
2072         checkbutton $w.postActions.checkout \
2073                 -text {Checkout after creation} \
2074                 -variable create_branch_checkout \
2075                 -font font_ui
2076         pack $w.postActions.checkout -anchor nw
2077         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2078
2079         set create_branch_checkout 1
2080         set create_branch_head $current_branch
2081         set create_branch_revtype head
2082         set create_branch_name $repo_config(gui.newbranchtemplate)
2083         set create_branch_revexp {}
2084
2085         bind $w <Visibility> "
2086                 grab $w
2087                 $w.desc.name_t icursor end
2088                 focus $w.desc.name_t
2089         "
2090         bind $w <Key-Escape> "destroy $w"
2091         bind $w <Key-Return> "do_create_branch_action $w;break"
2092         wm title $w "[appname] ([reponame]): Create Branch"
2093         tkwait window $w
2094 }
2095
2096 proc do_delete_branch_action {w} {
2097         global all_heads
2098         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2099
2100         set check_rev {}
2101         switch -- $delete_branch_checktype {
2102         head {set check_rev $delete_branch_head}
2103         tracking {set check_rev $delete_branch_trackinghead}
2104         always {set check_rev {:none}}
2105         }
2106         if {$check_rev eq {:none}} {
2107                 set check_cmt {}
2108         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2109                 tk_messageBox \
2110                         -icon error \
2111                         -type ok \
2112                         -title [wm title $w] \
2113                         -parent $w \
2114                         -message "Invalid check revision: $check_rev"
2115                 return
2116         }
2117
2118         set to_delete [list]
2119         set not_merged [list]
2120         foreach i [$w.list.l curselection] {
2121                 set b [$w.list.l get $i]
2122                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2123                 if {$check_cmt ne {}} {
2124                         if {$b eq $check_rev} continue
2125                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2126                         if {$o ne $m} {
2127                                 lappend not_merged $b
2128                                 continue
2129                         }
2130                 }
2131                 lappend to_delete [list $b $o]
2132         }
2133         if {$not_merged ne {}} {
2134                 set msg "The following branches are not completely merged into $check_rev:
2135
2136  - [join $not_merged "\n - "]"
2137                 tk_messageBox \
2138                         -icon info \
2139                         -type ok \
2140                         -title [wm title $w] \
2141                         -parent $w \
2142                         -message $msg
2143         }
2144         if {$to_delete eq {}} return
2145         if {$delete_branch_checktype eq {always}} {
2146                 set msg {Recovering deleted branches is difficult.
2147
2148 Delete the selected branches?}
2149                 if {[tk_messageBox \
2150                         -icon warning \
2151                         -type yesno \
2152                         -title [wm title $w] \
2153                         -parent $w \
2154                         -message $msg] ne yes} {
2155                         return
2156                 }
2157         }
2158
2159         set failed {}
2160         foreach i $to_delete {
2161                 set b [lindex $i 0]
2162                 set o [lindex $i 1]
2163                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2164                         append failed " - $b: $err\n"
2165                 } else {
2166                         set x [lsearch -sorted -exact $all_heads $b]
2167                         if {$x >= 0} {
2168                                 set all_heads [lreplace $all_heads $x $x]
2169                         }
2170                 }
2171         }
2172
2173         if {$failed ne {}} {
2174                 tk_messageBox \
2175                         -icon error \
2176                         -type ok \
2177                         -title [wm title $w] \
2178                         -parent $w \
2179                         -message "Failed to delete branches:\n$failed"
2180         }
2181
2182         set all_heads [lsort $all_heads]
2183         populate_branch_menu
2184         destroy $w
2185 }
2186
2187 proc do_delete_branch {} {
2188         global all_heads tracking_branches current_branch
2189         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2190
2191         set w .branch_editor
2192         toplevel $w
2193         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2194
2195         label $w.header -text {Delete Local Branch} \
2196                 -font font_uibold
2197         pack $w.header -side top -fill x
2198
2199         frame $w.buttons
2200         button $w.buttons.create -text Delete \
2201                 -font font_ui \
2202                 -command [list do_delete_branch_action $w]
2203         pack $w.buttons.create -side right
2204         button $w.buttons.cancel -text {Cancel} \
2205                 -font font_ui \
2206                 -command [list destroy $w]
2207         pack $w.buttons.cancel -side right -padx 5
2208         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2209
2210         labelframe $w.list \
2211                 -text {Local Branches} \
2212                 -font font_ui
2213         listbox $w.list.l \
2214                 -height 10 \
2215                 -width 70 \
2216                 -selectmode extended \
2217                 -yscrollcommand [list $w.list.sby set] \
2218                 -font font_ui
2219         foreach h $all_heads {
2220                 if {$h ne $current_branch} {
2221                         $w.list.l insert end $h
2222                 }
2223         }
2224         scrollbar $w.list.sby -command [list $w.list.l yview]
2225         pack $w.list.sby -side right -fill y
2226         pack $w.list.l -side left -fill both -expand 1
2227         pack $w.list -fill both -expand 1 -pady 5 -padx 5
2228
2229         labelframe $w.validate \
2230                 -text {Delete Only If} \
2231                 -font font_ui
2232         radiobutton $w.validate.head_r \
2233                 -text {Merged Into Local Branch:} \
2234                 -value head \
2235                 -variable delete_branch_checktype \
2236                 -font font_ui
2237         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2238         grid $w.validate.head_r $w.validate.head_m -sticky w
2239         set all_trackings [all_tracking_branches]
2240         if {$all_trackings ne {}} {
2241                 set delete_branch_trackinghead [lindex $all_trackings 0]
2242                 radiobutton $w.validate.tracking_r \
2243                         -text {Merged Into Tracking Branch:} \
2244                         -value tracking \
2245                         -variable delete_branch_checktype \
2246                         -font font_ui
2247                 eval tk_optionMenu $w.validate.tracking_m \
2248                         delete_branch_trackinghead \
2249                         $all_trackings
2250                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2251         }
2252         radiobutton $w.validate.always_r \
2253                 -text {Always (Do not perform merge checks)} \
2254                 -value always \
2255                 -variable delete_branch_checktype \
2256                 -font font_ui
2257         grid $w.validate.always_r -columnspan 2 -sticky w
2258         grid columnconfigure $w.validate 1 -weight 1
2259         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2260
2261         set delete_branch_head $current_branch
2262         set delete_branch_checktype head
2263
2264         bind $w <Visibility> "grab $w; focus $w"
2265         bind $w <Key-Escape> "destroy $w"
2266         wm title $w "[appname] ([reponame]): Delete Branch"
2267         tkwait window $w
2268 }
2269
2270 proc switch_branch {new_branch} {
2271         global HEAD commit_type current_branch repo_config
2272
2273         if {![lock_index switch]} return
2274
2275         # -- Our in memory state should match the repository.
2276         #
2277         repository_state curType curHEAD curMERGE_HEAD
2278         if {[string match amend* $commit_type]
2279                 && $curType eq {normal}
2280                 && $curHEAD eq $HEAD} {
2281         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2282                 info_popup {Last scanned state does not match repository state.
2283
2284 Another Git program has modified this repository
2285 since the last scan.  A rescan must be performed
2286 before the current branch can be changed.
2287
2288 The rescan will be automatically started now.
2289 }
2290                 unlock_index
2291                 rescan {set ui_status_value {Ready.}}
2292                 return
2293         }
2294
2295         # -- Don't do a pointless switch.
2296         #
2297         if {$current_branch eq $new_branch} {
2298                 unlock_index
2299                 return
2300         }
2301
2302         if {$repo_config(gui.trustmtime) eq {true}} {
2303                 switch_branch_stage2 {} $new_branch
2304         } else {
2305                 set ui_status_value {Refreshing file status...}
2306                 set cmd [list git update-index]
2307                 lappend cmd -q
2308                 lappend cmd --unmerged
2309                 lappend cmd --ignore-missing
2310                 lappend cmd --refresh
2311                 set fd_rf [open "| $cmd" r]
2312                 fconfigure $fd_rf -blocking 0 -translation binary
2313                 fileevent $fd_rf readable \
2314                         [list switch_branch_stage2 $fd_rf $new_branch]
2315         }
2316 }
2317
2318 proc switch_branch_stage2 {fd_rf new_branch} {
2319         global ui_status_value HEAD
2320
2321         if {$fd_rf ne {}} {
2322                 read $fd_rf
2323                 if {![eof $fd_rf]} return
2324                 close $fd_rf
2325         }
2326
2327         set ui_status_value "Updating working directory to '$new_branch'..."
2328         set cmd [list git read-tree]
2329         lappend cmd -m
2330         lappend cmd -u
2331         lappend cmd --exclude-per-directory=.gitignore
2332         lappend cmd $HEAD
2333         lappend cmd $new_branch
2334         set fd_rt [open "| $cmd" r]
2335         fconfigure $fd_rt -blocking 0 -translation binary
2336         fileevent $fd_rt readable \
2337                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2338 }
2339
2340 proc switch_branch_readtree_wait {fd_rt new_branch} {
2341         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2342         global current_branch
2343         global ui_comm ui_status_value
2344
2345         # -- We never get interesting output on stdout; only stderr.
2346         #
2347         read $fd_rt
2348         fconfigure $fd_rt -blocking 1
2349         if {![eof $fd_rt]} {
2350                 fconfigure $fd_rt -blocking 0
2351                 return
2352         }
2353
2354         # -- The working directory wasn't in sync with the index and
2355         #    we'd have to overwrite something to make the switch. A
2356         #    merge is required.
2357         #
2358         if {[catch {close $fd_rt} err]} {
2359                 regsub {^fatal: } $err {} err
2360                 warn_popup "File level merge required.
2361
2362 $err
2363
2364 Staying on branch '$current_branch'."
2365                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2366                 unlock_index
2367                 return
2368         }
2369
2370         # -- Update the symbolic ref.  Core git doesn't even check for failure
2371         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2372         #    state that is difficult to recover from within git-gui.
2373         #
2374         if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2375                 error_popup "Failed to set current branch.
2376
2377 This working directory is only partially switched.
2378 We successfully updated your files, but failed to
2379 update an internal Git file.
2380
2381 This should not have occurred.  [appname] will now
2382 close and give up.
2383
2384 $err"
2385                 do_quit
2386                 return
2387         }
2388
2389         # -- Update our repository state.  If we were previously in amend mode
2390         #    we need to toss the current buffer and do a full rescan to update
2391         #    our file lists.  If we weren't in amend mode our file lists are
2392         #    accurate and we can avoid the rescan.
2393         #
2394         unlock_index
2395         set selected_commit_type new
2396         if {[string match amend* $commit_type]} {
2397                 $ui_comm delete 0.0 end
2398                 $ui_comm edit reset
2399                 $ui_comm edit modified false
2400                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2401         } else {
2402                 repository_state commit_type HEAD MERGE_HEAD
2403                 set PARENT $HEAD
2404                 set ui_status_value "Checked out branch '$current_branch'."
2405         }
2406 }
2407
2408 ######################################################################
2409 ##
2410 ## remote management
2411
2412 proc load_all_remotes {} {
2413         global repo_config
2414         global all_remotes tracking_branches
2415
2416         set all_remotes [list]
2417         array unset tracking_branches
2418
2419         set rm_dir [gitdir remotes]
2420         if {[file isdirectory $rm_dir]} {
2421                 set all_remotes [glob \
2422                         -types f \
2423                         -tails \
2424                         -nocomplain \
2425                         -directory $rm_dir *]
2426
2427                 foreach name $all_remotes {
2428                         catch {
2429                                 set fd [open [file join $rm_dir $name] r]
2430                                 while {[gets $fd line] >= 0} {
2431                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2432                                                 $line line src dst]} continue
2433                                         if {![regexp ^refs/ $dst]} {
2434                                                 set dst "refs/heads/$dst"
2435                                         }
2436                                         set tracking_branches($dst) [list $name $src]
2437                                 }
2438                                 close $fd
2439                         }
2440                 }
2441         }
2442
2443         foreach line [array names repo_config remote.*.url] {
2444                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2445                 lappend all_remotes $name
2446
2447                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2448                         set fl {}
2449                 }
2450                 foreach line $fl {
2451                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2452                         if {![regexp ^refs/ $dst]} {
2453                                 set dst "refs/heads/$dst"
2454                         }
2455                         set tracking_branches($dst) [list $name $src]
2456                 }
2457         }
2458
2459         set all_remotes [lsort -unique $all_remotes]
2460 }
2461
2462 proc populate_fetch_menu {} {
2463         global all_remotes repo_config
2464
2465         set m .mbar.fetch
2466         foreach r $all_remotes {
2467                 set enable 0
2468                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2469                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2470                                 set enable 1
2471                         }
2472                 } else {
2473                         catch {
2474                                 set fd [open [gitdir remotes $r] r]
2475                                 while {[gets $fd n] >= 0} {
2476                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2477                                                 set enable 1
2478                                                 break
2479                                         }
2480                                 }
2481                                 close $fd
2482                         }
2483                 }
2484
2485                 if {$enable} {
2486                         $m add command \
2487                                 -label "Fetch from $r..." \
2488                                 -command [list fetch_from $r] \
2489                                 -font font_ui
2490                 }
2491         }
2492 }
2493
2494 proc populate_push_menu {} {
2495         global all_remotes repo_config
2496
2497         set m .mbar.push
2498         set fast_count 0
2499         foreach r $all_remotes {
2500                 set enable 0
2501                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2502                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2503                                 set enable 1
2504                         }
2505                 } else {
2506                         catch {
2507                                 set fd [open [gitdir remotes $r] r]
2508                                 while {[gets $fd n] >= 0} {
2509                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2510                                                 set enable 1
2511                                                 break
2512                                         }
2513                                 }
2514                                 close $fd
2515                         }
2516                 }
2517
2518                 if {$enable} {
2519                         if {!$fast_count} {
2520                                 $m add separator
2521                         }
2522                         $m add command \
2523                                 -label "Push to $r..." \
2524                                 -command [list push_to $r] \
2525                                 -font font_ui
2526                         incr fast_count
2527                 }
2528         }
2529 }
2530
2531 proc start_push_anywhere_action {w} {
2532         global push_urltype push_remote push_url push_thin push_tags
2533
2534         set r_url {}
2535         switch -- $push_urltype {
2536         remote {set r_url $push_remote}
2537         url {set r_url $push_url}
2538         }
2539         if {$r_url eq {}} return
2540
2541         set cmd [list git push]
2542         lappend cmd -v
2543         if {$push_thin} {
2544                 lappend cmd --thin
2545         }
2546         if {$push_tags} {
2547                 lappend cmd --tags
2548         }
2549         lappend cmd $r_url
2550         set cnt 0
2551         foreach i [$w.source.l curselection] {
2552                 set b [$w.source.l get $i]
2553                 lappend cmd "refs/heads/$b:refs/heads/$b"
2554                 incr cnt
2555         }
2556         if {$cnt == 0} {
2557                 return
2558         } elseif {$cnt == 1} {
2559                 set unit branch
2560         } else {
2561                 set unit branches
2562         }
2563
2564         set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2565         console_exec $cons $cmd console_done
2566         destroy $w
2567 }
2568
2569 trace add variable push_remote write \
2570         [list radio_selector push_urltype remote]
2571
2572 proc do_push_anywhere {} {
2573         global all_heads all_remotes current_branch
2574         global push_urltype push_remote push_url push_thin push_tags
2575
2576         set w .push_setup
2577         toplevel $w
2578         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2579
2580         label $w.header -text {Push Branches} -font font_uibold
2581         pack $w.header -side top -fill x
2582
2583         frame $w.buttons
2584         button $w.buttons.create -text Push \
2585                 -font font_ui \
2586                 -command [list start_push_anywhere_action $w]
2587         pack $w.buttons.create -side right
2588         button $w.buttons.cancel -text {Cancel} \
2589                 -font font_ui \
2590                 -command [list destroy $w]
2591         pack $w.buttons.cancel -side right -padx 5
2592         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2593
2594         labelframe $w.source \
2595                 -text {Source Branches} \
2596                 -font font_ui
2597         listbox $w.source.l \
2598                 -height 10 \
2599                 -width 70 \
2600                 -selectmode extended \
2601                 -yscrollcommand [list $w.source.sby set] \
2602                 -font font_ui
2603         foreach h $all_heads {
2604                 $w.source.l insert end $h
2605                 if {$h eq $current_branch} {
2606                         $w.source.l select set end
2607                 }
2608         }
2609         scrollbar $w.source.sby -command [list $w.source.l yview]
2610         pack $w.source.sby -side right -fill y
2611         pack $w.source.l -side left -fill both -expand 1
2612         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2613
2614         labelframe $w.dest \
2615                 -text {Destination Repository} \
2616                 -font font_ui
2617         if {$all_remotes ne {}} {
2618                 radiobutton $w.dest.remote_r \
2619                         -text {Remote:} \
2620                         -value remote \
2621                         -variable push_urltype \
2622                         -font font_ui
2623                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2624                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2625                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2626                         set push_remote origin
2627                 } else {
2628                         set push_remote [lindex $all_remotes 0]
2629                 }
2630                 set push_urltype remote
2631         } else {
2632                 set push_urltype url
2633         }
2634         radiobutton $w.dest.url_r \
2635                 -text {Arbitrary URL:} \
2636                 -value url \
2637                 -variable push_urltype \
2638                 -font font_ui
2639         entry $w.dest.url_t \
2640                 -borderwidth 1 \
2641                 -relief sunken \
2642                 -width 50 \
2643                 -textvariable push_url \
2644                 -font font_ui \
2645                 -validate key \
2646                 -validatecommand {
2647                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2648                         if {%d == 1 && [string length %S] > 0} {
2649                                 set push_urltype url
2650                         }
2651                         return 1
2652                 }
2653         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2654         grid columnconfigure $w.dest 1 -weight 1
2655         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2656
2657         labelframe $w.options \
2658                 -text {Transfer Options} \
2659                 -font font_ui
2660         checkbutton $w.options.thin \
2661                 -text {Use thin pack (for slow network connections)} \
2662                 -variable push_thin \
2663                 -font font_ui
2664         grid $w.options.thin -columnspan 2 -sticky w
2665         checkbutton $w.options.tags \
2666                 -text {Include tags} \
2667                 -variable push_tags \
2668                 -font font_ui
2669         grid $w.options.tags -columnspan 2 -sticky w
2670         grid columnconfigure $w.options 1 -weight 1
2671         pack $w.options -anchor nw -fill x -pady 5 -padx 5
2672
2673         set push_url {}
2674         set push_thin 0
2675         set push_tags 0
2676
2677         bind $w <Visibility> "grab $w"
2678         bind $w <Key-Escape> "destroy $w"
2679         wm title $w "[appname] ([reponame]): Push"
2680         tkwait window $w
2681 }
2682
2683 ######################################################################
2684 ##
2685 ## merge
2686
2687 proc can_merge {} {
2688         global HEAD commit_type file_states
2689
2690         if {[string match amend* $commit_type]} {
2691                 info_popup {Cannot merge while amending.
2692
2693 You must finish amending this commit before
2694 starting any type of merge.
2695 }
2696                 return 0
2697         }
2698
2699         if {[committer_ident] eq {}} {return 0}
2700         if {![lock_index merge]} {return 0}
2701
2702         # -- Our in memory state should match the repository.
2703         #
2704         repository_state curType curHEAD curMERGE_HEAD
2705         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2706                 info_popup {Last scanned state does not match repository state.
2707
2708 Another Git program has modified this repository
2709 since the last scan.  A rescan must be performed
2710 before a merge can be performed.
2711
2712 The rescan will be automatically started now.
2713 }
2714                 unlock_index
2715                 rescan {set ui_status_value {Ready.}}
2716                 return 0
2717         }
2718
2719         foreach path [array names file_states] {
2720                 switch -glob -- [lindex $file_states($path) 0] {
2721                 _O {
2722                         continue; # and pray it works!
2723                 }
2724                 U? {
2725                         error_popup "You are in the middle of a conflicted merge.
2726
2727 File [short_path $path] has merge conflicts.
2728
2729 You must resolve them, add the file, and commit to
2730 complete the current merge.  Only then can you
2731 begin another merge.
2732 "
2733                         unlock_index
2734                         return 0
2735                 }
2736                 ?? {
2737                         error_popup "You are in the middle of a change.
2738
2739 File [short_path $path] is modified.
2740
2741 You should complete the current commit before
2742 starting a merge.  Doing so will help you abort
2743 a failed merge, should the need arise.
2744 "
2745                         unlock_index
2746                         return 0
2747                 }
2748                 }
2749         }
2750
2751         return 1
2752 }
2753
2754 proc visualize_local_merge {w} {
2755         set revs {}
2756         foreach i [$w.source.l curselection] {
2757                 lappend revs [$w.source.l get $i]
2758         }
2759         if {$revs eq {}} return
2760         lappend revs --not HEAD
2761         do_gitk $revs
2762 }
2763
2764 proc start_local_merge_action {w} {
2765         global HEAD ui_status_value current_branch
2766
2767         set cmd [list git merge]
2768         set names {}
2769         set revcnt 0
2770         foreach i [$w.source.l curselection] {
2771                 set b [$w.source.l get $i]
2772                 lappend cmd $b
2773                 lappend names $b
2774                 incr revcnt
2775         }
2776
2777         if {$revcnt == 0} {
2778                 return
2779         } elseif {$revcnt == 1} {
2780                 set unit branch
2781         } elseif {$revcnt <= 15} {
2782                 set unit branches
2783         } else {
2784                 tk_messageBox \
2785                         -icon error \
2786                         -type ok \
2787                         -title [wm title $w] \
2788                         -parent $w \
2789                         -message "Too many branches selected.
2790
2791 You have requested to merge $revcnt branches
2792 in an octopus merge.  This exceeds Git's
2793 internal limit of 15 branches per merge.
2794
2795 Please select fewer branches.  To merge more
2796 than 15 branches, merge the branches in batches.
2797 "
2798                 return
2799         }
2800
2801         set msg "Merging $current_branch, [join $names {, }]"
2802         set ui_status_value "$msg..."
2803         set cons [new_console "Merge" $msg]
2804         console_exec $cons $cmd [list finish_merge $revcnt]
2805         bind $w <Destroy> {}
2806         destroy $w
2807 }
2808
2809 proc finish_merge {revcnt w ok} {
2810         console_done $w $ok
2811         if {$ok} {
2812                 set msg {Merge completed successfully.}
2813         } else {
2814                 if {$revcnt != 1} {
2815                         info_popup "Octopus merge failed.
2816
2817 Your merge of $revcnt branches has failed.
2818
2819 There are file-level conflicts between the
2820 branches which must be resolved manually.
2821
2822 The working directory will now be reset.
2823
2824 You can attempt this merge again
2825 by merging only one branch at a time." $w
2826
2827                         set fd [open "| git read-tree --reset -u HEAD" r]
2828                         fconfigure $fd -blocking 0 -translation binary
2829                         fileevent $fd readable [list reset_hard_wait $fd]
2830                         set ui_status_value {Aborting... please wait...}
2831                         return
2832                 }
2833
2834                 set msg {Merge failed.  Conflict resolution is required.}
2835         }
2836         unlock_index
2837         rescan [list set ui_status_value $msg]
2838 }
2839
2840 proc do_local_merge {} {
2841         global current_branch
2842
2843         if {![can_merge]} return
2844
2845         set w .merge_setup
2846         toplevel $w
2847         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2848
2849         label $w.header \
2850                 -text "Merge Into $current_branch" \
2851                 -font font_uibold
2852         pack $w.header -side top -fill x
2853
2854         frame $w.buttons
2855         button $w.buttons.visualize -text Visualize \
2856                 -font font_ui \
2857                 -command [list visualize_local_merge $w]
2858         pack $w.buttons.visualize -side left
2859         button $w.buttons.create -text Merge \
2860                 -font font_ui \
2861                 -command [list start_local_merge_action $w]
2862         pack $w.buttons.create -side right
2863         button $w.buttons.cancel -text {Cancel} \
2864                 -font font_ui \
2865                 -command [list destroy $w]
2866         pack $w.buttons.cancel -side right -padx 5
2867         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2868
2869         labelframe $w.source \
2870                 -text {Source Branches} \
2871                 -font font_ui
2872         listbox $w.source.l \
2873                 -height 10 \
2874                 -width 70 \
2875                 -selectmode extended \
2876                 -yscrollcommand [list $w.source.sby set] \
2877                 -font font_ui
2878         scrollbar $w.source.sby -command [list $w.source.l yview]
2879         pack $w.source.sby -side right -fill y
2880         pack $w.source.l -side left -fill both -expand 1
2881         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2882
2883         set cmd [list git for-each-ref]
2884         lappend cmd {--format=%(objectname) %(refname)}
2885         lappend cmd refs/heads
2886         lappend cmd refs/remotes
2887         set fr_fd [open "| $cmd" r]
2888         fconfigure $fr_fd -translation binary
2889         while {[gets $fr_fd line] > 0} {
2890                 set line [split $line { }]
2891                 set sha1([lindex $line 0]) [lindex $line 1]
2892         }
2893         close $fr_fd
2894
2895         set to_show {}
2896         set fr_fd [open "| git rev-list --all --not HEAD"]
2897         while {[gets $fr_fd line] > 0} {
2898                 if {[catch {set ref $sha1($line)}]} continue
2899                 regsub ^refs/(heads|remotes)/ $ref {} ref
2900                 lappend to_show $ref
2901         }
2902         close $fr_fd
2903
2904         foreach ref [lsort -unique $to_show] {
2905                 $w.source.l insert end $ref
2906         }
2907
2908         bind $w <Visibility> "grab $w"
2909         bind $w <Key-Escape> "unlock_index;destroy $w"
2910         bind $w <Destroy> unlock_index
2911         wm title $w "[appname] ([reponame]): Merge"
2912         tkwait window $w
2913 }
2914
2915 proc do_reset_hard {} {
2916         global HEAD commit_type file_states
2917
2918         if {[string match amend* $commit_type]} {
2919                 info_popup {Cannot abort while amending.
2920
2921 You must finish amending this commit.
2922 }
2923                 return
2924         }
2925
2926         if {![lock_index abort]} return
2927
2928         if {[string match *merge* $commit_type]} {
2929                 set op merge
2930         } else {
2931                 set op commit
2932         }
2933
2934         if {[ask_popup "Abort $op?
2935
2936 Aborting the current $op will cause
2937 *ALL* uncommitted changes to be lost.
2938
2939 Continue with aborting the current $op?"] eq {yes}} {
2940                 set fd [open "| git read-tree --reset -u HEAD" r]
2941                 fconfigure $fd -blocking 0 -translation binary
2942                 fileevent $fd readable [list reset_hard_wait $fd]
2943                 set ui_status_value {Aborting... please wait...}
2944         } else {
2945                 unlock_index
2946         }
2947 }
2948
2949 proc reset_hard_wait {fd} {
2950         global ui_comm
2951
2952         read $fd
2953         if {[eof $fd]} {
2954                 close $fd
2955                 unlock_index
2956
2957                 $ui_comm delete 0.0 end
2958                 $ui_comm edit modified false
2959
2960                 catch {file delete [gitdir MERGE_HEAD]}
2961                 catch {file delete [gitdir rr-cache MERGE_RR]}
2962                 catch {file delete [gitdir SQUASH_MSG]}
2963                 catch {file delete [gitdir MERGE_MSG]}
2964                 catch {file delete [gitdir GITGUI_MSG]}
2965
2966                 rescan {set ui_status_value {Abort completed.  Ready.}}
2967         }
2968 }
2969
2970 ######################################################################
2971 ##
2972 ## browser
2973
2974 set next_browser_id 0
2975
2976 proc new_browser {commit} {
2977         global next_browser_id cursor_ptr M1B
2978         global browser_commit browser_status browser_stack browser_path browser_busy
2979
2980         set w .browser[incr next_browser_id]
2981         set w_list $w.list.l
2982         set browser_commit($w_list) $commit
2983         set browser_status($w_list) {Starting...}
2984         set browser_stack($w_list) {}
2985         set browser_path($w_list) $browser_commit($w_list):
2986         set browser_busy($w_list) 1
2987
2988         toplevel $w
2989         label $w.path -textvariable browser_path($w_list) \
2990                 -anchor w \
2991                 -justify left \
2992                 -borderwidth 1 \
2993                 -relief sunken \
2994                 -font font_uibold
2995         pack $w.path -anchor w -side top -fill x
2996
2997         frame $w.list
2998         text $w_list -background white -borderwidth 0 \
2999                 -cursor $cursor_ptr \
3000                 -state disabled \
3001                 -wrap none \
3002                 -height 20 \
3003                 -width 70 \
3004                 -xscrollcommand [list $w.list.sbx set] \
3005                 -yscrollcommand [list $w.list.sby set] \
3006                 -font font_ui
3007         $w_list tag conf in_sel \
3008                 -background [$w_list cget -foreground] \
3009                 -foreground [$w_list cget -background]
3010         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3011         scrollbar $w.list.sby -orient v -command [list $w_list yview]
3012         pack $w.list.sbx -side bottom -fill x
3013         pack $w.list.sby -side right -fill y
3014         pack $w_list -side left -fill both -expand 1
3015         pack $w.list -side top -fill both -expand 1
3016
3017         label $w.status -textvariable browser_status($w_list) \
3018                 -anchor w \
3019                 -justify left \
3020                 -borderwidth 1 \
3021                 -relief sunken \
3022                 -font font_ui
3023         pack $w.status -anchor w -side bottom -fill x
3024
3025         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3026         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3027         bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3028         bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3029         bind $w_list <Up>              "browser_move -1 $w_list;break"
3030         bind $w_list <Down>            "browser_move 1 $w_list;break"
3031         bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3032         bind $w_list <Return>          "browser_enter $w_list;break"
3033         bind $w_list <Prior>           "browser_page -1 $w_list;break"
3034         bind $w_list <Next>            "browser_page 1 $w_list;break"
3035         bind $w_list <Left>            break
3036         bind $w_list <Right>           break
3037
3038         bind $w <Visibility> "focus $w"
3039         bind $w <Destroy> "
3040                 array unset browser_buffer $w_list
3041                 array unset browser_files $w_list
3042                 array unset browser_status $w_list
3043                 array unset browser_stack $w_list
3044                 array unset browser_path $w_list
3045                 array unset browser_commit $w_list
3046                 array unset browser_busy $w_list
3047         "
3048         wm title $w "[appname] ([reponame]): File Browser"
3049         ls_tree $w_list $browser_commit($w_list) {}
3050 }
3051
3052 proc browser_move {dir w} {
3053         global browser_files browser_busy
3054
3055         if {$browser_busy($w)} return
3056         set lno [lindex [split [$w index in_sel.first] .] 0]
3057         incr lno $dir
3058         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3059                 $w tag remove in_sel 0.0 end
3060                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3061                 $w see $lno.0
3062         }
3063 }
3064
3065 proc browser_page {dir w} {
3066         global browser_files browser_busy
3067
3068         if {$browser_busy($w)} return
3069         $w yview scroll $dir pages
3070         set lno [expr {int(
3071                   [lindex [$w yview] 0]
3072                 * [llength $browser_files($w)]
3073                 + 1)}]
3074         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3075                 $w tag remove in_sel 0.0 end
3076                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3077                 $w see $lno.0
3078         }
3079 }
3080
3081 proc browser_parent {w} {
3082         global browser_files browser_status browser_path
3083         global browser_stack browser_busy
3084
3085         if {$browser_busy($w)} return
3086         set info [lindex $browser_files($w) 0]
3087         if {[lindex $info 0] eq {parent}} {
3088                 set parent [lindex $browser_stack($w) end-1]
3089                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3090                 if {$browser_stack($w) eq {}} {
3091                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3092                 } else {
3093                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3094                 }
3095                 set browser_status($w) "Loading $browser_path($w)..."
3096                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3097         }
3098 }
3099
3100 proc browser_enter {w} {
3101         global browser_files browser_status browser_path
3102         global browser_commit browser_stack browser_busy
3103
3104         if {$browser_busy($w)} return
3105         set lno [lindex [split [$w index in_sel.first] .] 0]
3106         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3107         if {$info ne {}} {
3108                 switch -- [lindex $info 0] {
3109                 parent {
3110                         browser_parent $w
3111                 }
3112                 tree {
3113                         set name [lindex $info 2]
3114                         set escn [escape_path $name]
3115                         set browser_status($w) "Loading $escn..."
3116                         append browser_path($w) $escn
3117                         ls_tree $w [lindex $info 1] $name
3118                 }
3119                 blob {
3120                         set name [lindex $info 2]
3121                         set p {}
3122                         foreach n $browser_stack($w) {
3123                                 append p [lindex $n 1]
3124                         }
3125                         append p $name
3126                         show_blame $browser_commit($w) $p
3127                 }
3128                 }
3129         }
3130 }
3131
3132 proc browser_click {was_double_click w pos} {
3133         global browser_files browser_busy
3134
3135         if {$browser_busy($w)} return
3136         set lno [lindex [split [$w index $pos] .] 0]
3137         focus $w
3138
3139         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3140                 $w tag remove in_sel 0.0 end
3141                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3142                 if {$was_double_click} {
3143                         browser_enter $w
3144                 }
3145         }
3146 }
3147
3148 proc ls_tree {w tree_id name} {
3149         global browser_buffer browser_files browser_stack browser_busy
3150
3151         set browser_buffer($w) {}
3152         set browser_files($w) {}
3153         set browser_busy($w) 1
3154
3155         $w conf -state normal
3156         $w tag remove in_sel 0.0 end
3157         $w delete 0.0 end
3158         if {$browser_stack($w) ne {}} {
3159                 $w image create end \
3160                         -align center -padx 5 -pady 1 \
3161                         -name icon0 \
3162                         -image file_uplevel
3163                 $w insert end {[Up To Parent]}
3164                 lappend browser_files($w) parent
3165         }
3166         lappend browser_stack($w) [list $tree_id $name]
3167         $w conf -state disabled
3168
3169         set cmd [list git ls-tree -z $tree_id]
3170         set fd [open "| $cmd" r]
3171         fconfigure $fd -blocking 0 -translation binary -encoding binary
3172         fileevent $fd readable [list read_ls_tree $fd $w]
3173 }
3174
3175 proc read_ls_tree {fd w} {
3176         global browser_buffer browser_files browser_status browser_busy
3177
3178         if {![winfo exists $w]} {
3179                 catch {close $fd}
3180                 return
3181         }
3182
3183         append browser_buffer($w) [read $fd]
3184         set pck [split $browser_buffer($w) "\0"]
3185         set browser_buffer($w) [lindex $pck end]
3186
3187         set n [llength $browser_files($w)]
3188         $w conf -state normal
3189         foreach p [lrange $pck 0 end-1] {
3190                 set info [split $p "\t"]
3191                 set path [lindex $info 1]
3192                 set info [split [lindex $info 0] { }]
3193                 set type [lindex $info 1]
3194                 set object [lindex $info 2]
3195
3196                 switch -- $type {
3197                 blob {
3198                         set image file_mod
3199                 }
3200                 tree {
3201                         set image file_dir
3202                         append path /
3203                 }
3204                 default {
3205                         set image file_question
3206                 }
3207                 }
3208
3209                 if {$n > 0} {$w insert end "\n"}
3210                 $w image create end \
3211                         -align center -padx 5 -pady 1 \
3212                         -name icon[incr n] \
3213                         -image $image
3214                 $w insert end [escape_path $path]
3215                 lappend browser_files($w) [list $type $object $path]
3216         }
3217         $w conf -state disabled
3218
3219         if {[eof $fd]} {
3220                 close $fd
3221                 set browser_status($w) Ready.
3222                 set browser_busy($w) 0
3223                 array unset browser_buffer $w
3224                 if {$n > 0} {
3225                         $w tag add in_sel 1.0 2.0
3226                         focus -force $w
3227                 }
3228         }
3229 }
3230
3231 proc show_blame {commit path} {
3232         global next_browser_id blame_status blame_data
3233
3234         set w .browser[incr next_browser_id]
3235         set blame_status($w) {Loading current file content...}
3236         set texts [list]
3237
3238         toplevel $w
3239
3240         label $w.path -text "$commit:$path" \
3241                 -anchor w \
3242                 -justify left \
3243                 -borderwidth 1 \
3244                 -relief sunken \
3245                 -font font_uibold
3246         pack $w.path -side top -fill x
3247
3248         set hbg #e2effa
3249         frame $w.out
3250         label $w.out.commit_l -text Commit \
3251                 -relief solid \
3252                 -borderwidth 1 \
3253                 -background $hbg \
3254                 -font font_uibold
3255         text $w.out.commit_t \
3256                 -background white -borderwidth 0 \
3257                 -state disabled \
3258                 -wrap none \
3259                 -height 40 \
3260                 -width 9 \
3261                 -font font_diff
3262         lappend texts $w.out.commit_t
3263
3264         label $w.out.author_l -text Author \
3265                 -relief solid \
3266                 -borderwidth 1 \
3267                 -background $hbg \
3268                 -font font_uibold
3269         text $w.out.author_t \
3270                 -background white -borderwidth 0 \
3271                 -state disabled \
3272                 -wrap none \
3273                 -height 40 \
3274                 -width 20 \
3275                 -font font_diff
3276         lappend texts $w.out.author_t
3277
3278         label $w.out.date_l -text Date \
3279                 -relief solid \
3280                 -borderwidth 1 \
3281                 -background $hbg \
3282                 -font font_uibold
3283         text $w.out.date_t \
3284                 -background white -borderwidth 0 \
3285                 -state disabled \
3286                 -wrap none \
3287                 -height 40 \
3288                 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3289                 -font font_diff
3290         lappend texts $w.out.date_t
3291
3292         label $w.out.filename_l -text Filename \
3293                 -relief solid \
3294                 -borderwidth 1 \
3295                 -background $hbg \
3296                 -font font_uibold
3297         text $w.out.filename_t \
3298                 -background white -borderwidth 0 \
3299                 -state disabled \
3300                 -wrap none \
3301                 -height 40 \
3302                 -width 20 \
3303                 -font font_diff
3304         lappend texts $w.out.filename_t
3305
3306         label $w.out.origlinenumber_l -text {Orig Line} \
3307                 -relief solid \
3308                 -borderwidth 1 \
3309                 -background $hbg \
3310                 -font font_uibold
3311         text $w.out.origlinenumber_t \
3312                 -background white -borderwidth 0 \
3313                 -state disabled \
3314                 -wrap none \
3315                 -height 40 \
3316                 -width 5 \
3317                 -font font_diff
3318         $w.out.origlinenumber_t tag conf linenumber -justify right
3319         lappend texts $w.out.origlinenumber_t
3320
3321         label $w.out.linenumber_l -text {Curr Line} \
3322                 -relief solid \
3323                 -borderwidth 1 \
3324                 -background $hbg \
3325                 -font font_uibold
3326         text $w.out.linenumber_t \
3327                 -background white -borderwidth 0 \
3328                 -state disabled \
3329                 -wrap none \
3330                 -height 40 \
3331                 -width 5 \
3332                 -font font_diff
3333         $w.out.linenumber_t tag conf linenumber -justify right
3334         lappend texts $w.out.linenumber_t
3335
3336         label $w.out.file_l -text {File Content} \
3337                 -relief solid \
3338                 -borderwidth 1 \
3339                 -background $hbg \
3340                 -font font_uibold
3341         text $w.out.file_t \
3342                 -background white -borderwidth 0 \
3343                 -state disabled \
3344                 -wrap none \
3345                 -height 40 \
3346                 -width 80 \
3347                 -xscrollcommand [list $w.out.sbx set] \
3348                 -font font_diff
3349         lappend texts $w.out.file_t
3350
3351         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3352         scrollbar $w.out.sby -orient v \
3353                 -command [list scrollbar2many $texts yview]
3354         set labels [list]
3355         foreach i $texts {
3356                 regsub {_t$} $i _l l
3357                 lappend labels $l
3358         }
3359         set file_col [expr {[llength $texts] - 1}]
3360         eval grid $labels -sticky we
3361         eval grid $texts $w.out.sby -sticky nsew
3362         grid conf $w.out.sbx -column $file_col -sticky we
3363         grid columnconfigure $w.out $file_col -weight 1
3364         grid rowconfigure $w.out 1 -weight 1
3365         pack $w.out -fill both -expand 1
3366
3367         label $w.status -textvariable blame_status($w) \
3368                 -anchor w \
3369                 -justify left \
3370                 -borderwidth 1 \
3371                 -relief sunken \
3372                 -font font_ui
3373         pack $w.status -side bottom -fill x
3374
3375         menu $w.ctxm -tearoff 0
3376         $w.ctxm add command -label "Copy Commit" \
3377                 -font font_ui \
3378                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3379
3380         foreach i $texts {
3381                 $i tag conf in_sel \
3382                         -background [$i cget -foreground] \
3383                         -foreground [$i cget -background]
3384                 $i conf -yscrollcommand \
3385                         [list many2scrollbar $texts yview $w.out.sby]
3386                 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3387                 bind_button3 $i "
3388                         set cursorX %x
3389                         set cursorY %y
3390                         set cursorW %W
3391                         tk_popup $w.ctxm %X %Y
3392                 "
3393         }
3394
3395         set blame_data($w,colors) {}
3396
3397         bind $w <Visibility> "focus $w"
3398         bind $w <Destroy> "
3399                 array unset blame_status $w
3400                 array unset blame_data $w,*
3401         "
3402         wm title $w "[appname] ([reponame]): File Viewer"
3403
3404         set blame_data($w,total_lines) 0
3405         set cmd [list git cat-file blob "$commit:$path"]
3406         set fd [open "| $cmd" r]
3407         fconfigure $fd -blocking 0 -translation lf -encoding binary
3408         fileevent $fd readable [list read_blame_catfile \
3409                 $fd $w $commit $path \
3410                 $texts $w.out.linenumber_t $w.out.file_t]
3411 }
3412
3413 proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3414         global blame_status blame_data
3415
3416         if {![winfo exists $w_file]} {
3417                 catch {close $fd}
3418                 return
3419         }
3420
3421         set n $blame_data($w,total_lines)
3422         foreach i $texts {$i conf -state normal}
3423         while {[gets $fd line] >= 0} {
3424                 regsub "\r\$" $line {} line
3425                 incr n
3426                 $w_lno insert end $n linenumber
3427                 $w_file insert end $line
3428                 foreach i $texts {$i insert end "\n"}
3429         }
3430         foreach i $texts {$i conf -state disabled}
3431         set blame_data($w,total_lines) $n
3432
3433         if {[eof $fd]} {
3434                 close $fd
3435                 set blame_status($w) {Loading annotations...}
3436                 set cmd [list git blame -M -C --incremental]
3437                 lappend cmd $commit -- $path
3438                 set fd [open "| $cmd" r]
3439                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3440                 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3441         }
3442 }
3443
3444 proc read_blame_incremental {fd w
3445         w_commit w_author w_date w_filename w_olno
3446         w_lno w_file} {
3447         global blame_status blame_data
3448
3449         if {![winfo exists $w_commit]} {
3450                 catch {close $fd}
3451                 return
3452         }
3453
3454         set all [list \
3455                 $w_commit \
3456                 $w_author \
3457                 $w_date \
3458                 $w_filename \
3459                 $w_olno \
3460                 $w_lno \
3461                 $w_file]
3462
3463         $w_commit conf -state normal
3464         $w_author conf -state normal
3465         $w_date conf -state normal
3466         $w_filename conf -state normal
3467         $w_olno conf -state normal
3468
3469         while {[gets $fd line] >= 0} {
3470                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3471                         cmit original_line final_line line_count]} {
3472                         set blame_data($w,commit) $cmit
3473                         set blame_data($w,original_line) $original_line
3474                         set blame_data($w,final_line) $final_line
3475                         set blame_data($w,line_count) $line_count
3476
3477                         if {[catch {set g $blame_data($w,$cmit,seen)}]} {
3478                                 if {$blame_data($w,colors) eq {}} {
3479                                         set blame_data($w,colors) {
3480                                                 yellow
3481                                                 red
3482                                                 pink
3483                                                 orange
3484                                                 green
3485                                                 grey
3486                                         }
3487                                 }
3488                                 set c [lindex $blame_data($w,colors) 0]
3489                                 set blame_data($w,colors) \
3490                                         [lrange $blame_data($w,colors) 1 end]
3491                                 foreach t $all {
3492                                         $t tag conf g$cmit -background $c
3493                                 }
3494                         } else {
3495                                 set blame_data($w,$cmit,seen) 1
3496                         }
3497                 } elseif {[string match {filename *} $line]} {
3498                         set n $blame_data($w,line_count)
3499                         set lno $blame_data($w,final_line)
3500                         set ol $blame_data($w,original_line)
3501                         set file [string range $line 9 end]
3502                         set cmit $blame_data($w,commit)
3503                         set abbrev [string range $cmit 0 8]
3504
3505                         if {[catch {set author $blame_data($w,$cmit,author)} err]} {
3506                                 set author {}
3507                         }
3508
3509                         if {[catch {set atime $blame_data($w,$cmit,author-time)}]} {
3510                                 set atime {}
3511                         } else {
3512                                 set atime [clock format $atime -format {%Y-%m-%d %T}]
3513                         }
3514
3515                         while {$n > 0} {
3516                                 if {![catch {set g g$blame_data($w,line$lno,commit)}]} {
3517                                         foreach t $all {
3518                                                 $t tag remove $g $lno.0 "$lno.0 lineend + 1c"
3519                                         }
3520                                 }
3521
3522                                 foreach t [list \
3523                                         $w_commit \
3524                                         $w_author \
3525                                         $w_date \
3526                                         $w_filename \
3527                                         $w_olno] {
3528                                         $t delete $lno.0 "$lno.0 lineend"
3529                                 }
3530
3531                                 $w_commit insert $lno.0 $abbrev
3532                                 $w_author insert $lno.0 $author
3533                                 $w_date insert $lno.0 $atime
3534                                 $w_filename insert $lno.0 $file
3535                                 $w_olno insert $lno.0 $ol linenumber
3536
3537                                 set g g$cmit
3538                                 foreach t $all {
3539                                         $t tag add $g $lno.0 "$lno.0 lineend + 1c"
3540                                 }
3541
3542                                 set blame_data($w,line$lno,commit) $cmit
3543
3544                                 incr n -1
3545                                 incr lno
3546                                 incr ol
3547                         }
3548                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3549                         set blame_data($w,$blame_data($w,commit),$header) $data
3550                 }
3551         }
3552
3553         $w_commit conf -state disabled
3554         $w_author conf -state disabled
3555         $w_date conf -state disabled
3556         $w_filename conf -state disabled
3557         $w_olno conf -state disabled
3558
3559         if {[eof $fd]} {
3560                 close $fd
3561                 set blame_status($w) {Annotation complete.}
3562         }
3563 }
3564
3565 proc blame_highlight {w pos args} {
3566         set lno [lindex [split [$w index $pos] .] 0]
3567         foreach i $args {
3568                 $i tag remove in_sel 0.0 end
3569         }
3570         if {$lno eq {}} return
3571         foreach i $args {
3572                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3573         }
3574 }
3575
3576 proc blame_copycommit {w i pos} {
3577         global blame_data
3578         set lno [lindex [split [$i index $pos] .] 0]
3579         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3580                 clipboard clear
3581                 clipboard append \
3582                         -format STRING \
3583                         -type STRING \
3584                         -- $commit
3585         }
3586 }
3587
3588 ######################################################################
3589 ##
3590 ## icons
3591
3592 set filemask {
3593 #define mask_width 14
3594 #define mask_height 15
3595 static unsigned char mask_bits[] = {
3596    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3597    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3598    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3599 }
3600
3601 image create bitmap file_plain -background white -foreground black -data {
3602 #define plain_width 14
3603 #define plain_height 15
3604 static unsigned char plain_bits[] = {
3605    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3606    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3607    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3608 } -maskdata $filemask
3609
3610 image create bitmap file_mod -background white -foreground blue -data {
3611 #define mod_width 14
3612 #define mod_height 15
3613 static unsigned char mod_bits[] = {
3614    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3615    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3616    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3617 } -maskdata $filemask
3618
3619 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3620 #define file_fulltick_width 14
3621 #define file_fulltick_height 15
3622 static unsigned char file_fulltick_bits[] = {
3623    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3624    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3625    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3626 } -maskdata $filemask
3627
3628 image create bitmap file_parttick -background white -foreground "#005050" -data {
3629 #define parttick_width 14
3630 #define parttick_height 15
3631 static unsigned char parttick_bits[] = {
3632    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3633    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3634    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3635 } -maskdata $filemask
3636
3637 image create bitmap file_question -background white -foreground black -data {
3638 #define file_question_width 14
3639 #define file_question_height 15
3640 static unsigned char file_question_bits[] = {
3641    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3642    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3643    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3644 } -maskdata $filemask
3645
3646 image create bitmap file_removed -background white -foreground red -data {
3647 #define file_removed_width 14
3648 #define file_removed_height 15
3649 static unsigned char file_removed_bits[] = {
3650    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3651    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3652    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3653 } -maskdata $filemask
3654
3655 image create bitmap file_merge -background white -foreground blue -data {
3656 #define file_merge_width 14
3657 #define file_merge_height 15
3658 static unsigned char file_merge_bits[] = {
3659    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3660    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3661    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3662 } -maskdata $filemask
3663
3664 set file_dir_data {
3665 #define file_width 18
3666 #define file_height 18
3667 static unsigned char file_bits[] = {
3668   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3669   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3670   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3671   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3672   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3673 }
3674 image create bitmap file_dir -background white -foreground blue \
3675         -data $file_dir_data -maskdata $file_dir_data
3676 unset file_dir_data
3677
3678 set file_uplevel_data {
3679 #define up_width 15
3680 #define up_height 15
3681 static unsigned char up_bits[] = {
3682   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3683   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3684   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3685 }
3686 image create bitmap file_uplevel -background white -foreground red \
3687         -data $file_uplevel_data -maskdata $file_uplevel_data
3688 unset file_uplevel_data
3689
3690 set ui_index .vpane.files.index.list
3691 set ui_workdir .vpane.files.workdir.list
3692
3693 set all_icons(_$ui_index)   file_plain
3694 set all_icons(A$ui_index)   file_fulltick
3695 set all_icons(M$ui_index)   file_fulltick
3696 set all_icons(D$ui_index)   file_removed
3697 set all_icons(U$ui_index)   file_merge
3698
3699 set all_icons(_$ui_workdir) file_plain
3700 set all_icons(M$ui_workdir) file_mod
3701 set all_icons(D$ui_workdir) file_question
3702 set all_icons(U$ui_workdir) file_merge
3703 set all_icons(O$ui_workdir) file_plain
3704
3705 set max_status_desc 0
3706 foreach i {
3707                 {__ "Unmodified"}
3708
3709                 {_M "Modified, not staged"}
3710                 {M_ "Staged for commit"}
3711                 {MM "Portions staged for commit"}
3712                 {MD "Staged for commit, missing"}
3713
3714                 {_O "Untracked, not staged"}
3715                 {A_ "Staged for commit"}
3716                 {AM "Portions staged for commit"}
3717                 {AD "Staged for commit, missing"}
3718
3719                 {_D "Missing"}
3720                 {D_ "Staged for removal"}
3721                 {DO "Staged for removal, still present"}
3722
3723                 {U_ "Requires merge resolution"}
3724                 {UU "Requires merge resolution"}
3725                 {UM "Requires merge resolution"}
3726                 {UD "Requires merge resolution"}
3727         } {
3728         if {$max_status_desc < [string length [lindex $i 1]]} {
3729                 set max_status_desc [string length [lindex $i 1]]
3730         }
3731         set all_descs([lindex $i 0]) [lindex $i 1]
3732 }
3733 unset i
3734
3735 ######################################################################
3736 ##
3737 ## util
3738
3739 proc bind_button3 {w cmd} {
3740         bind $w <Any-Button-3> $cmd
3741         if {[is_MacOSX]} {
3742                 bind $w <Control-Button-1> $cmd
3743         }
3744 }
3745
3746 proc scrollbar2many {list mode args} {
3747         foreach w $list {eval $w $mode $args}
3748 }
3749
3750 proc many2scrollbar {list mode sb top bottom} {
3751         $sb set $top $bottom
3752         foreach w $list {$w $mode moveto $top}
3753 }
3754
3755 proc incr_font_size {font {amt 1}} {
3756         set sz [font configure $font -size]
3757         incr sz $amt
3758         font configure $font -size $sz
3759         font configure ${font}bold -size $sz
3760 }
3761
3762 proc hook_failed_popup {hook msg} {
3763         set w .hookfail
3764         toplevel $w
3765
3766         frame $w.m
3767         label $w.m.l1 -text "$hook hook failed:" \
3768                 -anchor w \
3769                 -justify left \
3770                 -font font_uibold
3771         text $w.m.t \
3772                 -background white -borderwidth 1 \
3773                 -relief sunken \
3774                 -width 80 -height 10 \
3775                 -font font_diff \
3776                 -yscrollcommand [list $w.m.sby set]
3777         label $w.m.l2 \
3778                 -text {You must correct the above errors before committing.} \
3779                 -anchor w \
3780                 -justify left \
3781                 -font font_uibold
3782         scrollbar $w.m.sby -command [list $w.m.t yview]
3783         pack $w.m.l1 -side top -fill x
3784         pack $w.m.l2 -side bottom -fill x
3785         pack $w.m.sby -side right -fill y
3786         pack $w.m.t -side left -fill both -expand 1
3787         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3788
3789         $w.m.t insert 1.0 $msg
3790         $w.m.t conf -state disabled
3791
3792         button $w.ok -text OK \
3793                 -width 15 \
3794                 -font font_ui \
3795                 -command "destroy $w"
3796         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3797
3798         bind $w <Visibility> "grab $w; focus $w"
3799         bind $w <Key-Return> "destroy $w"
3800         wm title $w "[appname] ([reponame]): error"
3801         tkwait window $w
3802 }
3803
3804 set next_console_id 0
3805
3806 proc new_console {short_title long_title} {
3807         global next_console_id console_data
3808         set w .console[incr next_console_id]
3809         set console_data($w) [list $short_title $long_title]
3810         return [console_init $w]
3811 }
3812
3813 proc console_init {w} {
3814         global console_cr console_data M1B
3815
3816         set console_cr($w) 1.0
3817         toplevel $w
3818         frame $w.m
3819         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3820                 -anchor w \
3821                 -justify left \
3822                 -font font_uibold
3823         text $w.m.t \
3824                 -background white -borderwidth 1 \
3825                 -relief sunken \
3826                 -width 80 -height 10 \
3827                 -font font_diff \
3828                 -state disabled \
3829                 -yscrollcommand [list $w.m.sby set]
3830         label $w.m.s -text {Working... please wait...} \
3831                 -anchor w \
3832                 -justify left \
3833                 -font font_uibold
3834         scrollbar $w.m.sby -command [list $w.m.t yview]
3835         pack $w.m.l1 -side top -fill x
3836         pack $w.m.s -side bottom -fill x
3837         pack $w.m.sby -side right -fill y
3838         pack $w.m.t -side left -fill both -expand 1
3839         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3840
3841         menu $w.ctxm -tearoff 0
3842         $w.ctxm add command -label "Copy" \
3843                 -font font_ui \
3844                 -command "tk_textCopy $w.m.t"
3845         $w.ctxm add command -label "Select All" \
3846                 -font font_ui \
3847                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3848         $w.ctxm add command -label "Copy All" \
3849                 -font font_ui \
3850                 -command "
3851                         $w.m.t tag add sel 0.0 end
3852                         tk_textCopy $w.m.t
3853                         $w.m.t tag remove sel 0.0 end
3854                 "
3855
3856         button $w.ok -text {Close} \
3857                 -font font_ui \
3858                 -state disabled \
3859                 -command "destroy $w"
3860         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3861
3862         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3863         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3864         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3865         bind $w <Visibility> "focus $w"
3866         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3867         return $w
3868 }
3869
3870 proc console_exec {w cmd after} {
3871         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3872         #    But most users need that so we have to relogin. :-(
3873         #
3874         if {[is_Cygwin]} {
3875                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3876         }
3877
3878         # -- Tcl won't let us redirect both stdout and stderr to
3879         #    the same pipe.  So pass it through cat...
3880         #
3881         set cmd [concat | $cmd |& cat]
3882
3883         set fd_f [open $cmd r]
3884         fconfigure $fd_f -blocking 0 -translation binary
3885         fileevent $fd_f readable [list console_read $w $fd_f $after]
3886 }
3887
3888 proc console_read {w fd after} {
3889         global console_cr
3890
3891         set buf [read $fd]
3892         if {$buf ne {}} {
3893                 if {![winfo exists $w]} {console_init $w}
3894                 $w.m.t conf -state normal
3895                 set c 0
3896                 set n [string length $buf]
3897                 while {$c < $n} {
3898                         set cr [string first "\r" $buf $c]
3899                         set lf [string first "\n" $buf $c]
3900                         if {$cr < 0} {set cr [expr {$n + 1}]}
3901                         if {$lf < 0} {set lf [expr {$n + 1}]}
3902
3903                         if {$lf < $cr} {
3904                                 $w.m.t insert end [string range $buf $c $lf]
3905                                 set console_cr($w) [$w.m.t index {end -1c}]
3906                                 set c $lf
3907                                 incr c
3908                         } else {
3909                                 $w.m.t delete $console_cr($w) end
3910                                 $w.m.t insert end "\n"
3911                                 $w.m.t insert end [string range $buf $c $cr]
3912                                 set c $cr
3913                                 incr c
3914                         }
3915                 }
3916                 $w.m.t conf -state disabled
3917                 $w.m.t see end
3918         }
3919
3920         fconfigure $fd -blocking 1
3921         if {[eof $fd]} {
3922                 if {[catch {close $fd}]} {
3923                         set ok 0
3924                 } else {
3925                         set ok 1
3926                 }
3927                 uplevel #0 $after $w $ok
3928                 return
3929         }
3930         fconfigure $fd -blocking 0
3931 }
3932
3933 proc console_chain {cmdlist w {ok 1}} {
3934         if {$ok} {
3935                 if {[llength $cmdlist] == 0} {
3936                         console_done $w $ok
3937                         return
3938                 }
3939
3940                 set cmd [lindex $cmdlist 0]
3941                 set cmdlist [lrange $cmdlist 1 end]
3942
3943                 if {[lindex $cmd 0] eq {console_exec}} {
3944                         console_exec $w \
3945                                 [lindex $cmd 1] \
3946                                 [list console_chain $cmdlist]
3947                 } else {
3948                         uplevel #0 $cmd $cmdlist $w $ok
3949                 }
3950         } else {
3951                 console_done $w $ok
3952         }
3953 }
3954
3955 proc console_done {args} {
3956         global console_cr console_data
3957
3958         switch -- [llength $args] {
3959         2 {
3960                 set w [lindex $args 0]
3961                 set ok [lindex $args 1]
3962         }
3963         3 {
3964                 set w [lindex $args 1]
3965                 set ok [lindex $args 2]
3966         }
3967         default {
3968                 error "wrong number of args: console_done ?ignored? w ok"
3969         }
3970         }
3971
3972         if {$ok} {
3973                 if {[winfo exists $w]} {
3974                         $w.m.s conf -background green -text {Success}
3975                         $w.ok conf -state normal
3976                 }
3977         } else {
3978                 if {![winfo exists $w]} {
3979                         console_init $w
3980                 }
3981                 $w.m.s conf -background red -text {Error: Command Failed}
3982                 $w.ok conf -state normal
3983         }
3984
3985         array unset console_cr $w
3986         array unset console_data $w
3987 }
3988
3989 ######################################################################
3990 ##
3991 ## ui commands
3992
3993 set starting_gitk_msg {Starting gitk... please wait...}
3994
3995 proc do_gitk {revs} {
3996         global env ui_status_value starting_gitk_msg
3997
3998         # -- On Windows gitk is severly broken, and right now it seems like
3999         #    nobody cares about fixing it.  The only known workaround is to
4000         #    always delete ~/.gitk before starting the program.
4001         #
4002         if {[is_Windows]} {
4003                 catch {file delete [file join $env(HOME) .gitk]}
4004         }
4005
4006         # -- Always start gitk through whatever we were loaded with.  This
4007         #    lets us bypass using shell process on Windows systems.
4008         #
4009         set cmd [info nameofexecutable]
4010         lappend cmd [gitexec gitk]
4011         if {$revs ne {}} {
4012                 append cmd { }
4013                 append cmd $revs
4014         }
4015
4016         if {[catch {eval exec $cmd &} err]} {
4017                 error_popup "Failed to start gitk:\n\n$err"
4018         } else {
4019                 set ui_status_value $starting_gitk_msg
4020                 after 10000 {
4021                         if {$ui_status_value eq $starting_gitk_msg} {
4022                                 set ui_status_value {Ready.}
4023                         }
4024                 }
4025         }
4026 }
4027
4028 proc do_stats {} {
4029         set fd [open "| git count-objects -v" r]
4030         while {[gets $fd line] > 0} {
4031                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4032                         set stats($name) $value
4033                 }
4034         }
4035         close $fd
4036
4037         set packed_sz 0
4038         foreach p [glob -directory [gitdir objects pack] \
4039                 -type f \
4040                 -nocomplain -- *] {
4041                 incr packed_sz [file size $p]
4042         }
4043         if {$packed_sz > 0} {
4044                 set stats(size-pack) [expr {$packed_sz / 1024}]
4045         }
4046
4047         set w .stats_view
4048         toplevel $w
4049         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4050
4051         label $w.header -text {Database Statistics} \
4052                 -font font_uibold
4053         pack $w.header -side top -fill x
4054
4055         frame $w.buttons -border 1
4056         button $w.buttons.close -text Close \
4057                 -font font_ui \
4058                 -command [list destroy $w]
4059         button $w.buttons.gc -text {Compress Database} \
4060                 -font font_ui \
4061                 -command "destroy $w;do_gc"
4062         pack $w.buttons.close -side right
4063         pack $w.buttons.gc -side left
4064         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4065
4066         frame $w.stat -borderwidth 1 -relief solid
4067         foreach s {
4068                 {count           {Number of loose objects}}
4069                 {size            {Disk space used by loose objects} { KiB}}
4070                 {in-pack         {Number of packed objects}}
4071                 {packs           {Number of packs}}
4072                 {size-pack       {Disk space used by packed objects} { KiB}}
4073                 {prune-packable  {Packed objects waiting for pruning}}
4074                 {garbage         {Garbage files}}
4075                 } {
4076                 set name [lindex $s 0]
4077                 set label [lindex $s 1]
4078                 if {[catch {set value $stats($name)}]} continue
4079                 if {[llength $s] > 2} {
4080                         set value "$value[lindex $s 2]"
4081                 }
4082
4083                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4084                 label $w.stat.v_$name -text $value -anchor w -font font_ui
4085                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4086         }
4087         pack $w.stat -pady 10 -padx 10
4088
4089         bind $w <Visibility> "grab $w; focus $w"
4090         bind $w <Key-Escape> [list destroy $w]
4091         bind $w <Key-Return> [list destroy $w]
4092         wm title $w "[appname] ([reponame]): Database Statistics"
4093         tkwait window $w
4094 }
4095
4096 proc do_gc {} {
4097         set w [new_console {gc} {Compressing the object database}]
4098         console_chain {
4099                 {console_exec {git pack-refs --prune}}
4100                 {console_exec {git reflog expire --all}}
4101                 {console_exec {git repack -a -d -l}}
4102                 {console_exec {git rerere gc}}
4103         } $w
4104 }
4105
4106 proc do_fsck_objects {} {
4107         set w [new_console {fsck-objects} \
4108                 {Verifying the object database with fsck-objects}]
4109         set cmd [list git fsck-objects]
4110         lappend cmd --full
4111         lappend cmd --cache
4112         lappend cmd --strict
4113         console_exec $w $cmd console_done
4114 }
4115
4116 set is_quitting 0
4117
4118 proc do_quit {} {
4119         global ui_comm is_quitting repo_config commit_type
4120
4121         if {$is_quitting} return
4122         set is_quitting 1
4123
4124         # -- Stash our current commit buffer.
4125         #
4126         set save [gitdir GITGUI_MSG]
4127         set msg [string trim [$ui_comm get 0.0 end]]
4128         regsub -all -line {[ \r\t]+$} $msg {} msg
4129         if {(![string match amend* $commit_type]
4130                 || [$ui_comm edit modified])
4131                 && $msg ne {}} {
4132                 catch {
4133                         set fd [open $save w]
4134                         puts -nonewline $fd $msg
4135                         close $fd
4136                 }
4137         } else {
4138                 catch {file delete $save}
4139         }
4140
4141         # -- Stash our current window geometry into this repository.
4142         #
4143         set cfg_geometry [list]
4144         lappend cfg_geometry [wm geometry .]
4145         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4146         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4147         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4148                 set rc_geometry {}
4149         }
4150         if {$cfg_geometry ne $rc_geometry} {
4151                 catch {exec git repo-config gui.geometry $cfg_geometry}
4152         }
4153
4154         destroy .
4155 }
4156
4157 proc do_rescan {} {
4158         rescan {set ui_status_value {Ready.}}
4159 }
4160
4161 proc unstage_helper {txt paths} {
4162         global file_states current_diff_path
4163
4164         if {![lock_index begin-update]} return
4165
4166         set pathList [list]
4167         set after {}
4168         foreach path $paths {
4169                 switch -glob -- [lindex $file_states($path) 0] {
4170                 A? -
4171                 M? -
4172                 D? {
4173                         lappend pathList $path
4174                         if {$path eq $current_diff_path} {
4175                                 set after {reshow_diff;}
4176                         }
4177                 }
4178                 }
4179         }
4180         if {$pathList eq {}} {
4181                 unlock_index
4182         } else {
4183                 update_indexinfo \
4184                         $txt \
4185                         $pathList \
4186                         [concat $after {set ui_status_value {Ready.}}]
4187         }
4188 }
4189
4190 proc do_unstage_selection {} {
4191         global current_diff_path selected_paths
4192
4193         if {[array size selected_paths] > 0} {
4194                 unstage_helper \
4195                         {Unstaging selected files from commit} \
4196                         [array names selected_paths]
4197         } elseif {$current_diff_path ne {}} {
4198                 unstage_helper \
4199                         "Unstaging [short_path $current_diff_path] from commit" \
4200                         [list $current_diff_path]
4201         }
4202 }
4203
4204 proc add_helper {txt paths} {
4205         global file_states current_diff_path
4206
4207         if {![lock_index begin-update]} return
4208
4209         set pathList [list]
4210         set after {}
4211         foreach path $paths {
4212                 switch -glob -- [lindex $file_states($path) 0] {
4213                 _O -
4214                 ?M -
4215                 ?D -
4216                 U? {
4217                         lappend pathList $path
4218                         if {$path eq $current_diff_path} {
4219                                 set after {reshow_diff;}
4220                         }
4221                 }
4222                 }
4223         }
4224         if {$pathList eq {}} {
4225                 unlock_index
4226         } else {
4227                 update_index \
4228                         $txt \
4229                         $pathList \
4230                         [concat $after {set ui_status_value {Ready to commit.}}]
4231         }
4232 }
4233
4234 proc do_add_selection {} {
4235         global current_diff_path selected_paths
4236
4237         if {[array size selected_paths] > 0} {
4238                 add_helper \
4239                         {Adding selected files} \
4240                         [array names selected_paths]
4241         } elseif {$current_diff_path ne {}} {
4242                 add_helper \
4243                         "Adding [short_path $current_diff_path]" \
4244                         [list $current_diff_path]
4245         }
4246 }
4247
4248 proc do_add_all {} {
4249         global file_states
4250
4251         set paths [list]
4252         foreach path [array names file_states] {
4253                 switch -glob -- [lindex $file_states($path) 0] {
4254                 U? {continue}
4255                 ?M -
4256                 ?D {lappend paths $path}
4257                 }
4258         }
4259         add_helper {Adding all changed files} $paths
4260 }
4261
4262 proc revert_helper {txt paths} {
4263         global file_states current_diff_path
4264
4265         if {![lock_index begin-update]} return
4266
4267         set pathList [list]
4268         set after {}
4269         foreach path $paths {
4270                 switch -glob -- [lindex $file_states($path) 0] {
4271                 U? {continue}
4272                 ?M -
4273                 ?D {
4274                         lappend pathList $path
4275                         if {$path eq $current_diff_path} {
4276                                 set after {reshow_diff;}
4277                         }
4278                 }
4279                 }
4280         }
4281
4282         set n [llength $pathList]
4283         if {$n == 0} {
4284                 unlock_index
4285                 return
4286         } elseif {$n == 1} {
4287                 set s "[short_path [lindex $pathList]]"
4288         } else {
4289                 set s "these $n files"
4290         }
4291
4292         set reply [tk_dialog \
4293                 .confirm_revert \
4294                 "[appname] ([reponame])" \
4295                 "Revert changes in $s?
4296
4297 Any unadded changes will be permanently lost by the revert." \
4298                 question \
4299                 1 \
4300                 {Do Nothing} \
4301                 {Revert Changes} \
4302                 ]
4303         if {$reply == 1} {
4304                 checkout_index \
4305                         $txt \
4306                         $pathList \
4307                         [concat $after {set ui_status_value {Ready.}}]
4308         } else {
4309                 unlock_index
4310         }
4311 }
4312
4313 proc do_revert_selection {} {
4314         global current_diff_path selected_paths
4315
4316         if {[array size selected_paths] > 0} {
4317                 revert_helper \
4318                         {Reverting selected files} \
4319                         [array names selected_paths]
4320         } elseif {$current_diff_path ne {}} {
4321                 revert_helper \
4322                         "Reverting [short_path $current_diff_path]" \
4323                         [list $current_diff_path]
4324         }
4325 }
4326
4327 proc do_signoff {} {
4328         global ui_comm
4329
4330         set me [committer_ident]
4331         if {$me eq {}} return
4332
4333         set sob "Signed-off-by: $me"
4334         set last [$ui_comm get {end -1c linestart} {end -1c}]
4335         if {$last ne $sob} {
4336                 $ui_comm edit separator
4337                 if {$last ne {}
4338                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4339                         $ui_comm insert end "\n"
4340                 }
4341                 $ui_comm insert end "\n$sob"
4342                 $ui_comm edit separator
4343                 $ui_comm see end
4344         }
4345 }
4346
4347 proc do_select_commit_type {} {
4348         global commit_type selected_commit_type
4349
4350         if {$selected_commit_type eq {new}
4351                 && [string match amend* $commit_type]} {
4352                 create_new_commit
4353         } elseif {$selected_commit_type eq {amend}
4354                 && ![string match amend* $commit_type]} {
4355                 load_last_commit
4356
4357                 # The amend request was rejected...
4358                 #
4359                 if {![string match amend* $commit_type]} {
4360                         set selected_commit_type new
4361                 }
4362         }
4363 }
4364
4365 proc do_commit {} {
4366         commit_tree
4367 }
4368
4369 proc do_about {} {
4370         global appvers copyright
4371         global tcl_patchLevel tk_patchLevel
4372
4373         set w .about_dialog
4374         toplevel $w
4375         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4376
4377         label $w.header -text "About [appname]" \
4378                 -font font_uibold
4379         pack $w.header -side top -fill x
4380
4381         frame $w.buttons
4382         button $w.buttons.close -text {Close} \
4383                 -font font_ui \
4384                 -command [list destroy $w]
4385         pack $w.buttons.close -side right
4386         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4387
4388         label $w.desc \
4389                 -text "[appname] - a commit creation tool for Git.
4390 $copyright" \
4391                 -padx 5 -pady 5 \
4392                 -justify left \
4393                 -anchor w \
4394                 -borderwidth 1 \
4395                 -relief solid \
4396                 -font font_ui
4397         pack $w.desc -side top -fill x -padx 5 -pady 5
4398
4399         set v {}
4400         append v "[appname] version $appvers\n"
4401         append v "[exec git version]\n"
4402         append v "\n"
4403         if {$tcl_patchLevel eq $tk_patchLevel} {
4404                 append v "Tcl/Tk version $tcl_patchLevel"
4405         } else {
4406                 append v "Tcl version $tcl_patchLevel"
4407                 append v ", Tk version $tk_patchLevel"
4408         }
4409
4410         label $w.vers \
4411                 -text $v \
4412                 -padx 5 -pady 5 \
4413                 -justify left \
4414                 -anchor w \
4415                 -borderwidth 1 \
4416                 -relief solid \
4417                 -font font_ui
4418         pack $w.vers -side top -fill x -padx 5 -pady 5
4419
4420         menu $w.ctxm -tearoff 0
4421         $w.ctxm add command \
4422                 -label {Copy} \
4423                 -font font_ui \
4424                 -command "
4425                 clipboard clear
4426                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4427         "
4428
4429         bind $w <Visibility> "grab $w; focus $w"
4430         bind $w <Key-Escape> "destroy $w"
4431         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4432         wm title $w "About [appname]"
4433         tkwait window $w
4434 }
4435
4436 proc do_options {} {
4437         global repo_config global_config font_descs
4438         global repo_config_new global_config_new
4439
4440         array unset repo_config_new
4441         array unset global_config_new
4442         foreach name [array names repo_config] {
4443                 set repo_config_new($name) $repo_config($name)
4444         }
4445         load_config 1
4446         foreach name [array names repo_config] {
4447                 switch -- $name {
4448                 gui.diffcontext {continue}
4449                 }
4450                 set repo_config_new($name) $repo_config($name)
4451         }
4452         foreach name [array names global_config] {
4453                 set global_config_new($name) $global_config($name)
4454         }
4455
4456         set w .options_editor
4457         toplevel $w
4458         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4459
4460         label $w.header -text "[appname] Options" \
4461                 -font font_uibold
4462         pack $w.header -side top -fill x
4463
4464         frame $w.buttons
4465         button $w.buttons.restore -text {Restore Defaults} \
4466                 -font font_ui \
4467                 -command do_restore_defaults
4468         pack $w.buttons.restore -side left
4469         button $w.buttons.save -text Save \
4470                 -font font_ui \
4471                 -command [list do_save_config $w]
4472         pack $w.buttons.save -side right
4473         button $w.buttons.cancel -text {Cancel} \
4474                 -font font_ui \
4475                 -command [list destroy $w]
4476         pack $w.buttons.cancel -side right -padx 5
4477         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4478
4479         labelframe $w.repo -text "[reponame] Repository" \
4480                 -font font_ui
4481         labelframe $w.global -text {Global (All Repositories)} \
4482                 -font font_ui
4483         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4484         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4485
4486         set optid 0
4487         foreach option {
4488                 {t user.name {User Name}}
4489                 {t user.email {Email Address}}
4490
4491                 {b merge.summary {Summarize Merge Commits}}
4492                 {i-1..5 merge.verbosity {Merge Verbosity}}
4493
4494                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4495                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4496                 {t gui.newbranchtemplate {New Branch Name Template}}
4497                 } {
4498                 set type [lindex $option 0]
4499                 set name [lindex $option 1]
4500                 set text [lindex $option 2]
4501                 incr optid
4502                 foreach f {repo global} {
4503                         switch -glob -- $type {
4504                         b {
4505                                 checkbutton $w.$f.$optid -text $text \
4506                                         -variable ${f}_config_new($name) \
4507                                         -onvalue true \
4508                                         -offvalue false \
4509                                         -font font_ui
4510                                 pack $w.$f.$optid -side top -anchor w
4511                         }
4512                         i-* {
4513                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4514                                 frame $w.$f.$optid
4515                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4516                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4517                                 spinbox $w.$f.$optid.v \
4518                                         -textvariable ${f}_config_new($name) \
4519                                         -from $min \
4520                                         -to $max \
4521                                         -increment 1 \
4522                                         -width [expr {1 + [string length $max]}] \
4523                                         -font font_ui
4524                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4525                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4526                                 pack $w.$f.$optid -side top -anchor w -fill x
4527                         }
4528                         t {
4529                                 frame $w.$f.$optid
4530                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4531                                 entry $w.$f.$optid.v \
4532                                         -borderwidth 1 \
4533                                         -relief sunken \
4534                                         -width 20 \
4535                                         -textvariable ${f}_config_new($name) \
4536                                         -font font_ui
4537                                 pack $w.$f.$optid.l -side left -anchor w
4538                                 pack $w.$f.$optid.v -side left -anchor w \
4539                                         -fill x -expand 1 \
4540                                         -padx 5
4541                                 pack $w.$f.$optid -side top -anchor w -fill x
4542                         }
4543                         }
4544                 }
4545         }
4546
4547         set all_fonts [lsort [font families]]
4548         foreach option $font_descs {
4549                 set name [lindex $option 0]
4550                 set font [lindex $option 1]
4551                 set text [lindex $option 2]
4552
4553                 set global_config_new(gui.$font^^family) \
4554                         [font configure $font -family]
4555                 set global_config_new(gui.$font^^size) \
4556                         [font configure $font -size]
4557
4558                 frame $w.global.$name
4559                 label $w.global.$name.l -text "$text:" -font font_ui
4560                 pack $w.global.$name.l -side left -anchor w -fill x
4561                 eval tk_optionMenu $w.global.$name.family \
4562                         global_config_new(gui.$font^^family) \
4563                         $all_fonts
4564                 spinbox $w.global.$name.size \
4565                         -textvariable global_config_new(gui.$font^^size) \
4566                         -from 2 -to 80 -increment 1 \
4567                         -width 3 \
4568                         -font font_ui
4569                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4570                 pack $w.global.$name.size -side right -anchor e
4571                 pack $w.global.$name.family -side right -anchor e
4572                 pack $w.global.$name -side top -anchor w -fill x
4573         }
4574
4575         bind $w <Visibility> "grab $w; focus $w"
4576         bind $w <Key-Escape> "destroy $w"
4577         wm title $w "[appname] ([reponame]): Options"
4578         tkwait window $w
4579 }
4580
4581 proc do_restore_defaults {} {
4582         global font_descs default_config repo_config
4583         global repo_config_new global_config_new
4584
4585         foreach name [array names default_config] {
4586                 set repo_config_new($name) $default_config($name)
4587                 set global_config_new($name) $default_config($name)
4588         }
4589
4590         foreach option $font_descs {
4591                 set name [lindex $option 0]
4592                 set repo_config(gui.$name) $default_config(gui.$name)
4593         }
4594         apply_config
4595
4596         foreach option $font_descs {
4597                 set name [lindex $option 0]
4598                 set font [lindex $option 1]
4599                 set global_config_new(gui.$font^^family) \
4600                         [font configure $font -family]
4601                 set global_config_new(gui.$font^^size) \
4602                         [font configure $font -size]
4603         }
4604 }
4605
4606 proc do_save_config {w} {
4607         if {[catch {save_config} err]} {
4608                 error_popup "Failed to completely save options:\n\n$err"
4609         }
4610         reshow_diff
4611         destroy $w
4612 }
4613
4614 proc do_windows_shortcut {} {
4615         global argv0
4616
4617         set fn [tk_getSaveFile \
4618                 -parent . \
4619                 -title "[appname] ([reponame]): Create Desktop Icon" \
4620                 -initialfile "Git [reponame].bat"]
4621         if {$fn != {}} {
4622                 if {[catch {
4623                                 set fd [open $fn w]
4624                                 puts $fd "@ECHO Entering [reponame]"
4625                                 puts $fd "@ECHO Starting git-gui... please wait..."
4626                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4627                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4628                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4629                                 puts $fd " \"[file normalize $argv0]\""
4630                                 close $fd
4631                         } err]} {
4632                         error_popup "Cannot write script:\n\n$err"
4633                 }
4634         }
4635 }
4636
4637 proc do_cygwin_shortcut {} {
4638         global argv0
4639
4640         if {[catch {
4641                 set desktop [exec cygpath \
4642                         --windows \
4643                         --absolute \
4644                         --long-name \
4645                         --desktop]
4646                 }]} {
4647                         set desktop .
4648         }
4649         set fn [tk_getSaveFile \
4650                 -parent . \
4651                 -title "[appname] ([reponame]): Create Desktop Icon" \
4652                 -initialdir $desktop \
4653                 -initialfile "Git [reponame].bat"]
4654         if {$fn != {}} {
4655                 if {[catch {
4656                                 set fd [open $fn w]
4657                                 set sh [exec cygpath \
4658                                         --windows \
4659                                         --absolute \
4660                                         /bin/sh]
4661                                 set me [exec cygpath \
4662                                         --unix \
4663                                         --absolute \
4664                                         $argv0]
4665                                 set gd [exec cygpath \
4666                                         --unix \
4667                                         --absolute \
4668                                         [gitdir]]
4669                                 set gw [exec cygpath \
4670                                         --windows \
4671                                         --absolute \
4672                                         [file dirname [gitdir]]]
4673                                 regsub -all ' $me "'\\''" me
4674                                 regsub -all ' $gd "'\\''" gd
4675                                 puts $fd "@ECHO Entering $gw"
4676                                 puts $fd "@ECHO Starting git-gui... please wait..."
4677                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4678                                 puts -nonewline $fd "GIT_DIR='$gd'"
4679                                 puts -nonewline $fd " '$me'"
4680                                 puts $fd "&\""
4681                                 close $fd
4682                         } err]} {
4683                         error_popup "Cannot write script:\n\n$err"
4684                 }
4685         }
4686 }
4687
4688 proc do_macosx_app {} {
4689         global argv0 env
4690
4691         set fn [tk_getSaveFile \
4692                 -parent . \
4693                 -title "[appname] ([reponame]): Create Desktop Icon" \
4694                 -initialdir [file join $env(HOME) Desktop] \
4695                 -initialfile "Git [reponame].app"]
4696         if {$fn != {}} {
4697                 if {[catch {
4698                                 set Contents [file join $fn Contents]
4699                                 set MacOS [file join $Contents MacOS]
4700                                 set exe [file join $MacOS git-gui]
4701
4702                                 file mkdir $MacOS
4703
4704                                 set fd [open [file join $Contents Info.plist] w]
4705                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4706 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4707 <plist version="1.0">
4708 <dict>
4709         <key>CFBundleDevelopmentRegion</key>
4710         <string>English</string>
4711         <key>CFBundleExecutable</key>
4712         <string>git-gui</string>
4713         <key>CFBundleIdentifier</key>
4714         <string>org.spearce.git-gui</string>
4715         <key>CFBundleInfoDictionaryVersion</key>
4716         <string>6.0</string>
4717         <key>CFBundlePackageType</key>
4718         <string>APPL</string>
4719         <key>CFBundleSignature</key>
4720         <string>????</string>
4721         <key>CFBundleVersion</key>
4722         <string>1.0</string>
4723         <key>NSPrincipalClass</key>
4724         <string>NSApplication</string>
4725 </dict>
4726 </plist>}
4727                                 close $fd
4728
4729                                 set fd [open $exe w]
4730                                 set gd [file normalize [gitdir]]
4731                                 set ep [file normalize [gitexec]]
4732                                 regsub -all ' $gd "'\\''" gd
4733                                 regsub -all ' $ep "'\\''" ep
4734                                 puts $fd "#!/bin/sh"
4735                                 foreach name [array names env] {
4736                                         if {[string match GIT_* $name]} {
4737                                                 regsub -all ' $env($name) "'\\''" v
4738                                                 puts $fd "export $name='$v'"
4739                                         }
4740                                 }
4741                                 puts $fd "export PATH='$ep':\$PATH"
4742                                 puts $fd "export GIT_DIR='$gd'"
4743                                 puts $fd "exec [file normalize $argv0]"
4744                                 close $fd
4745
4746                                 file attributes $exe -permissions u+x,g+x,o+x
4747                         } err]} {
4748                         error_popup "Cannot write icon:\n\n$err"
4749                 }
4750         }
4751 }
4752
4753 proc toggle_or_diff {w x y} {
4754         global file_states file_lists current_diff_path ui_index ui_workdir
4755         global last_clicked selected_paths
4756
4757         set pos [split [$w index @$x,$y] .]
4758         set lno [lindex $pos 0]
4759         set col [lindex $pos 1]
4760         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4761         if {$path eq {}} {
4762                 set last_clicked {}
4763                 return
4764         }
4765
4766         set last_clicked [list $w $lno]
4767         array unset selected_paths
4768         $ui_index tag remove in_sel 0.0 end
4769         $ui_workdir tag remove in_sel 0.0 end
4770
4771         if {$col == 0} {
4772                 if {$current_diff_path eq $path} {
4773                         set after {reshow_diff;}
4774                 } else {
4775                         set after {}
4776                 }
4777                 if {$w eq $ui_index} {
4778                         update_indexinfo \
4779                                 "Unstaging [short_path $path] from commit" \
4780                                 [list $path] \
4781                                 [concat $after {set ui_status_value {Ready.}}]
4782                 } elseif {$w eq $ui_workdir} {
4783                         update_index \
4784                                 "Adding [short_path $path]" \
4785                                 [list $path] \
4786                                 [concat $after {set ui_status_value {Ready.}}]
4787                 }
4788         } else {
4789                 show_diff $path $w $lno
4790         }
4791 }
4792
4793 proc add_one_to_selection {w x y} {
4794         global file_lists last_clicked selected_paths
4795
4796         set lno [lindex [split [$w index @$x,$y] .] 0]
4797         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4798         if {$path eq {}} {
4799                 set last_clicked {}
4800                 return
4801         }
4802
4803         if {$last_clicked ne {}
4804                 && [lindex $last_clicked 0] ne $w} {
4805                 array unset selected_paths
4806                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4807         }
4808
4809         set last_clicked [list $w $lno]
4810         if {[catch {set in_sel $selected_paths($path)}]} {
4811                 set in_sel 0
4812         }
4813         if {$in_sel} {
4814                 unset selected_paths($path)
4815                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4816         } else {
4817                 set selected_paths($path) 1
4818                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4819         }
4820 }
4821
4822 proc add_range_to_selection {w x y} {
4823         global file_lists last_clicked selected_paths
4824
4825         if {[lindex $last_clicked 0] ne $w} {
4826                 toggle_or_diff $w $x $y
4827                 return
4828         }
4829
4830         set lno [lindex [split [$w index @$x,$y] .] 0]
4831         set lc [lindex $last_clicked 1]
4832         if {$lc < $lno} {
4833                 set begin $lc
4834                 set end $lno
4835         } else {
4836                 set begin $lno
4837                 set end $lc
4838         }
4839
4840         foreach path [lrange $file_lists($w) \
4841                 [expr {$begin - 1}] \
4842                 [expr {$end - 1}]] {
4843                 set selected_paths($path) 1
4844         }
4845         $w tag add in_sel $begin.0 [expr {$end + 1}].0
4846 }
4847
4848 ######################################################################
4849 ##
4850 ## config defaults
4851
4852 set cursor_ptr arrow
4853 font create font_diff -family Courier -size 10
4854 font create font_ui
4855 catch {
4856         label .dummy
4857         eval font configure font_ui [font actual [.dummy cget -font]]
4858         destroy .dummy
4859 }
4860
4861 font create font_uibold
4862 font create font_diffbold
4863
4864 if {[is_Windows]} {
4865         set M1B Control
4866         set M1T Ctrl
4867 } elseif {[is_MacOSX]} {
4868         set M1B M1
4869         set M1T Cmd
4870 } else {
4871         set M1B M1
4872         set M1T M1
4873 }
4874
4875 proc apply_config {} {
4876         global repo_config font_descs
4877
4878         foreach option $font_descs {
4879                 set name [lindex $option 0]
4880                 set font [lindex $option 1]
4881                 if {[catch {
4882                         foreach {cn cv} $repo_config(gui.$name) {
4883                                 font configure $font $cn $cv
4884                         }
4885                         } err]} {
4886                         error_popup "Invalid font specified in gui.$name:\n\n$err"
4887                 }
4888                 foreach {cn cv} [font configure $font] {
4889                         font configure ${font}bold $cn $cv
4890                 }
4891                 font configure ${font}bold -weight bold
4892         }
4893 }
4894
4895 set default_config(merge.summary) false
4896 set default_config(merge.verbosity) 2
4897 set default_config(user.name) {}
4898 set default_config(user.email) {}
4899
4900 set default_config(gui.trustmtime) false
4901 set default_config(gui.diffcontext) 5
4902 set default_config(gui.newbranchtemplate) {}
4903 set default_config(gui.fontui) [font configure font_ui]
4904 set default_config(gui.fontdiff) [font configure font_diff]
4905 set font_descs {
4906         {fontui   font_ui   {Main Font}}
4907         {fontdiff font_diff {Diff/Console Font}}
4908 }
4909 load_config 0
4910 apply_config
4911
4912 ######################################################################
4913 ##
4914 ## ui construction
4915
4916 # -- Menu Bar
4917 #
4918 menu .mbar -tearoff 0
4919 .mbar add cascade -label Repository -menu .mbar.repository
4920 .mbar add cascade -label Edit -menu .mbar.edit
4921 if {[is_enabled multicommit]} {
4922         .mbar add cascade -label Branch -menu .mbar.branch
4923 }
4924 .mbar add cascade -label Commit -menu .mbar.commit
4925 if {[is_enabled multicommit]} {
4926         .mbar add cascade -label Merge -menu .mbar.merge
4927         .mbar add cascade -label Fetch -menu .mbar.fetch
4928         .mbar add cascade -label Push -menu .mbar.push
4929 }
4930 . configure -menu .mbar
4931
4932 # -- Repository Menu
4933 #
4934 menu .mbar.repository
4935
4936 .mbar.repository add command \
4937         -label {Browse Current Branch} \
4938         -command {new_browser $current_branch} \
4939         -font font_ui
4940 .mbar.repository add separator
4941
4942 .mbar.repository add command \
4943         -label {Visualize Current Branch} \
4944         -command {do_gitk {}} \
4945         -font font_ui
4946 .mbar.repository add command \
4947         -label {Visualize All Branches} \
4948         -command {do_gitk {--all}} \
4949         -font font_ui
4950 .mbar.repository add separator
4951
4952 if {[is_enabled multicommit]} {
4953         .mbar.repository add command -label {Database Statistics} \
4954                 -command do_stats \
4955                 -font font_ui
4956
4957         .mbar.repository add command -label {Compress Database} \
4958                 -command do_gc \
4959                 -font font_ui
4960
4961         .mbar.repository add command -label {Verify Database} \
4962                 -command do_fsck_objects \
4963                 -font font_ui
4964
4965         .mbar.repository add separator
4966
4967         if {[is_Cygwin]} {
4968                 .mbar.repository add command \
4969                         -label {Create Desktop Icon} \
4970                         -command do_cygwin_shortcut \
4971                         -font font_ui
4972         } elseif {[is_Windows]} {
4973                 .mbar.repository add command \
4974                         -label {Create Desktop Icon} \
4975                         -command do_windows_shortcut \
4976                         -font font_ui
4977         } elseif {[is_MacOSX]} {
4978                 .mbar.repository add command \
4979                         -label {Create Desktop Icon} \
4980                         -command do_macosx_app \
4981                         -font font_ui
4982         }
4983 }
4984
4985 .mbar.repository add command -label Quit \
4986         -command do_quit \
4987         -accelerator $M1T-Q \
4988         -font font_ui
4989
4990 # -- Edit Menu
4991 #
4992 menu .mbar.edit
4993 .mbar.edit add command -label Undo \
4994         -command {catch {[focus] edit undo}} \
4995         -accelerator $M1T-Z \
4996         -font font_ui
4997 .mbar.edit add command -label Redo \
4998         -command {catch {[focus] edit redo}} \
4999         -accelerator $M1T-Y \
5000         -font font_ui
5001 .mbar.edit add separator
5002 .mbar.edit add command -label Cut \
5003         -command {catch {tk_textCut [focus]}} \
5004         -accelerator $M1T-X \
5005         -font font_ui
5006 .mbar.edit add command -label Copy \
5007         -command {catch {tk_textCopy [focus]}} \
5008         -accelerator $M1T-C \
5009         -font font_ui
5010 .mbar.edit add command -label Paste \
5011         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5012         -accelerator $M1T-V \
5013         -font font_ui
5014 .mbar.edit add command -label Delete \
5015         -command {catch {[focus] delete sel.first sel.last}} \
5016         -accelerator Del \
5017         -font font_ui
5018 .mbar.edit add separator
5019 .mbar.edit add command -label {Select All} \
5020         -command {catch {[focus] tag add sel 0.0 end}} \
5021         -accelerator $M1T-A \
5022         -font font_ui
5023
5024 # -- Branch Menu
5025 #
5026 if {[is_enabled multicommit]} {
5027         menu .mbar.branch
5028
5029         .mbar.branch add command -label {Create...} \
5030                 -command do_create_branch \
5031                 -accelerator $M1T-N \
5032                 -font font_ui
5033         lappend disable_on_lock [list .mbar.branch entryconf \
5034                 [.mbar.branch index last] -state]
5035
5036         .mbar.branch add command -label {Delete...} \
5037                 -command do_delete_branch \
5038                 -font font_ui
5039         lappend disable_on_lock [list .mbar.branch entryconf \
5040                 [.mbar.branch index last] -state]
5041 }
5042
5043 # -- Commit Menu
5044 #
5045 menu .mbar.commit
5046
5047 .mbar.commit add radiobutton \
5048         -label {New Commit} \
5049         -command do_select_commit_type \
5050         -variable selected_commit_type \
5051         -value new \
5052         -font font_ui
5053 lappend disable_on_lock \
5054         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5055
5056 .mbar.commit add radiobutton \
5057         -label {Amend Last Commit} \
5058         -command do_select_commit_type \
5059         -variable selected_commit_type \
5060         -value amend \
5061         -font font_ui
5062 lappend disable_on_lock \
5063         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5064
5065 .mbar.commit add separator
5066
5067 .mbar.commit add command -label Rescan \
5068         -command do_rescan \
5069         -accelerator F5 \
5070         -font font_ui
5071 lappend disable_on_lock \
5072         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5073
5074 .mbar.commit add command -label {Add To Commit} \
5075         -command do_add_selection \
5076         -font font_ui
5077 lappend disable_on_lock \
5078         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5079
5080 .mbar.commit add command -label {Add All To Commit} \
5081         -command do_add_all \
5082         -accelerator $M1T-I \
5083         -font font_ui
5084 lappend disable_on_lock \
5085         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5086
5087 .mbar.commit add command -label {Unstage From Commit} \
5088         -command do_unstage_selection \
5089         -font font_ui
5090 lappend disable_on_lock \
5091         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5092
5093 .mbar.commit add command -label {Revert Changes} \
5094         -command do_revert_selection \
5095         -font font_ui
5096 lappend disable_on_lock \
5097         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5098
5099 .mbar.commit add separator
5100
5101 .mbar.commit add command -label {Sign Off} \
5102         -command do_signoff \
5103         -accelerator $M1T-S \
5104         -font font_ui
5105
5106 .mbar.commit add command -label Commit \
5107         -command do_commit \
5108         -accelerator $M1T-Return \
5109         -font font_ui
5110 lappend disable_on_lock \
5111         [list .mbar.commit entryconf [.mbar.commit index last] -state]
5112
5113 if {[is_MacOSX]} {
5114         # -- Apple Menu (Mac OS X only)
5115         #
5116         .mbar add cascade -label Apple -menu .mbar.apple
5117         menu .mbar.apple
5118
5119         .mbar.apple add command -label "About [appname]" \
5120                 -command do_about \
5121                 -font font_ui
5122         .mbar.apple add command -label "[appname] Options..." \
5123                 -command do_options \
5124                 -font font_ui
5125 } else {
5126         # -- Edit Menu
5127         #
5128         .mbar.edit add separator
5129         .mbar.edit add command -label {Options...} \
5130                 -command do_options \
5131                 -font font_ui
5132
5133         # -- Tools Menu
5134         #
5135         if {[file exists /usr/local/miga/lib/gui-miga]
5136                 && [file exists .pvcsrc]} {
5137         proc do_miga {} {
5138                 global ui_status_value
5139                 if {![lock_index update]} return
5140                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5141                 set miga_fd [open "|$cmd" r]
5142                 fconfigure $miga_fd -blocking 0
5143                 fileevent $miga_fd readable [list miga_done $miga_fd]
5144                 set ui_status_value {Running miga...}
5145         }
5146         proc miga_done {fd} {
5147                 read $fd 512
5148                 if {[eof $fd]} {
5149                         close $fd
5150                         unlock_index
5151                         rescan [list set ui_status_value {Ready.}]
5152                 }
5153         }
5154         .mbar add cascade -label Tools -menu .mbar.tools
5155         menu .mbar.tools
5156         .mbar.tools add command -label "Migrate" \
5157                 -command do_miga \
5158                 -font font_ui
5159         lappend disable_on_lock \
5160                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5161         }
5162 }
5163
5164 # -- Help Menu
5165 #
5166 .mbar add cascade -label Help -menu .mbar.help
5167 menu .mbar.help
5168
5169 if {![is_MacOSX]} {
5170         .mbar.help add command -label "About [appname]" \
5171                 -command do_about \
5172                 -font font_ui
5173 }
5174
5175 set browser {}
5176 catch {set browser $repo_config(instaweb.browser)}
5177 set doc_path [file dirname [gitexec]]
5178 set doc_path [file join $doc_path Documentation index.html]
5179
5180 if {[is_Cygwin]} {
5181         set doc_path [exec cygpath --windows $doc_path]
5182 }
5183
5184 if {$browser eq {}} {
5185         if {[is_MacOSX]} {
5186                 set browser open
5187         } elseif {[is_Cygwin]} {
5188                 set program_files [file dirname [exec cygpath --windir]]
5189                 set program_files [file join $program_files {Program Files}]
5190                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5191                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5192                 if {[file exists $firefox]} {
5193                         set browser $firefox
5194                 } elseif {[file exists $ie]} {
5195                         set browser $ie
5196                 }
5197                 unset program_files firefox ie
5198         }
5199 }
5200
5201 if {[file isfile $doc_path]} {
5202         set doc_url "file:$doc_path"
5203 } else {
5204         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5205 }
5206
5207 if {$browser ne {}} {
5208         .mbar.help add command -label {Online Documentation} \
5209                 -command [list exec $browser $doc_url &] \
5210                 -font font_ui
5211 }
5212 unset browser doc_path doc_url
5213
5214 # -- Branch Control
5215 #
5216 frame .branch \
5217         -borderwidth 1 \
5218         -relief sunken
5219 label .branch.l1 \
5220         -text {Current Branch:} \
5221         -anchor w \
5222         -justify left \
5223         -font font_ui
5224 label .branch.cb \
5225         -textvariable current_branch \
5226         -anchor w \
5227         -justify left \
5228         -font font_ui
5229 pack .branch.l1 -side left
5230 pack .branch.cb -side left -fill x
5231 pack .branch -side top -fill x
5232
5233 if {[is_enabled multicommit]} {
5234         menu .mbar.merge
5235         .mbar.merge add command -label {Local Merge...} \
5236                 -command do_local_merge \
5237                 -font font_ui
5238         lappend disable_on_lock \
5239                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5240         .mbar.merge add command -label {Abort Merge...} \
5241                 -command do_reset_hard \
5242                 -font font_ui
5243         lappend disable_on_lock \
5244                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5245
5246
5247         menu .mbar.fetch
5248
5249         menu .mbar.push
5250         .mbar.push add command -label {Push...} \
5251                 -command do_push_anywhere \
5252                 -font font_ui
5253 }
5254
5255 # -- Main Window Layout
5256 #
5257 panedwindow .vpane -orient vertical
5258 panedwindow .vpane.files -orient horizontal
5259 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5260 pack .vpane -anchor n -side top -fill both -expand 1
5261
5262 # -- Index File List
5263 #
5264 frame .vpane.files.index -height 100 -width 200
5265 label .vpane.files.index.title -text {Changes To Be Committed} \
5266         -background green \
5267         -font font_ui
5268 text $ui_index -background white -borderwidth 0 \
5269         -width 20 -height 10 \
5270         -wrap none \
5271         -font font_ui \
5272         -cursor $cursor_ptr \
5273         -xscrollcommand {.vpane.files.index.sx set} \
5274         -yscrollcommand {.vpane.files.index.sy set} \
5275         -state disabled
5276 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5277 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5278 pack .vpane.files.index.title -side top -fill x
5279 pack .vpane.files.index.sx -side bottom -fill x
5280 pack .vpane.files.index.sy -side right -fill y
5281 pack $ui_index -side left -fill both -expand 1
5282 .vpane.files add .vpane.files.index -sticky nsew
5283
5284 # -- Working Directory File List
5285 #
5286 frame .vpane.files.workdir -height 100 -width 200
5287 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5288         -background red \
5289         -font font_ui
5290 text $ui_workdir -background white -borderwidth 0 \
5291         -width 20 -height 10 \
5292         -wrap none \
5293         -font font_ui \
5294         -cursor $cursor_ptr \
5295         -xscrollcommand {.vpane.files.workdir.sx set} \
5296         -yscrollcommand {.vpane.files.workdir.sy set} \
5297         -state disabled
5298 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5299 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5300 pack .vpane.files.workdir.title -side top -fill x
5301 pack .vpane.files.workdir.sx -side bottom -fill x
5302 pack .vpane.files.workdir.sy -side right -fill y
5303 pack $ui_workdir -side left -fill both -expand 1
5304 .vpane.files add .vpane.files.workdir -sticky nsew
5305
5306 foreach i [list $ui_index $ui_workdir] {
5307         $i tag conf in_diff -font font_uibold
5308         $i tag conf in_sel \
5309                 -background [$i cget -foreground] \
5310                 -foreground [$i cget -background]
5311 }
5312 unset i
5313
5314 # -- Diff and Commit Area
5315 #
5316 frame .vpane.lower -height 300 -width 400
5317 frame .vpane.lower.commarea
5318 frame .vpane.lower.diff -relief sunken -borderwidth 1
5319 pack .vpane.lower.commarea -side top -fill x
5320 pack .vpane.lower.diff -side bottom -fill both -expand 1
5321 .vpane add .vpane.lower -sticky nsew
5322
5323 # -- Commit Area Buttons
5324 #
5325 frame .vpane.lower.commarea.buttons
5326 label .vpane.lower.commarea.buttons.l -text {} \
5327         -anchor w \
5328         -justify left \
5329         -font font_ui
5330 pack .vpane.lower.commarea.buttons.l -side top -fill x
5331 pack .vpane.lower.commarea.buttons -side left -fill y
5332
5333 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5334         -command do_rescan \
5335         -font font_ui
5336 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5337 lappend disable_on_lock \
5338         {.vpane.lower.commarea.buttons.rescan conf -state}
5339
5340 button .vpane.lower.commarea.buttons.incall -text {Add All} \
5341         -command do_add_all \
5342         -font font_ui
5343 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5344 lappend disable_on_lock \
5345         {.vpane.lower.commarea.buttons.incall conf -state}
5346
5347 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5348         -command do_signoff \
5349         -font font_ui
5350 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5351
5352 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5353         -command do_commit \
5354         -font font_ui
5355 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5356 lappend disable_on_lock \
5357         {.vpane.lower.commarea.buttons.commit conf -state}
5358
5359 # -- Commit Message Buffer
5360 #
5361 frame .vpane.lower.commarea.buffer
5362 frame .vpane.lower.commarea.buffer.header
5363 set ui_comm .vpane.lower.commarea.buffer.t
5364 set ui_coml .vpane.lower.commarea.buffer.header.l
5365 radiobutton .vpane.lower.commarea.buffer.header.new \
5366         -text {New Commit} \
5367         -command do_select_commit_type \
5368         -variable selected_commit_type \
5369         -value new \
5370         -font font_ui
5371 lappend disable_on_lock \
5372         [list .vpane.lower.commarea.buffer.header.new conf -state]
5373 radiobutton .vpane.lower.commarea.buffer.header.amend \
5374         -text {Amend Last Commit} \
5375         -command do_select_commit_type \
5376         -variable selected_commit_type \
5377         -value amend \
5378         -font font_ui
5379 lappend disable_on_lock \
5380         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5381 label $ui_coml \
5382         -anchor w \
5383         -justify left \
5384         -font font_ui
5385 proc trace_commit_type {varname args} {
5386         global ui_coml commit_type
5387         switch -glob -- $commit_type {
5388         initial       {set txt {Initial Commit Message:}}
5389         amend         {set txt {Amended Commit Message:}}
5390         amend-initial {set txt {Amended Initial Commit Message:}}
5391         amend-merge   {set txt {Amended Merge Commit Message:}}
5392         merge         {set txt {Merge Commit Message:}}
5393         *             {set txt {Commit Message:}}
5394         }
5395         $ui_coml conf -text $txt
5396 }
5397 trace add variable commit_type write trace_commit_type
5398 pack $ui_coml -side left -fill x
5399 pack .vpane.lower.commarea.buffer.header.amend -side right
5400 pack .vpane.lower.commarea.buffer.header.new -side right
5401
5402 text $ui_comm -background white -borderwidth 1 \
5403         -undo true \
5404         -maxundo 20 \
5405         -autoseparators true \
5406         -relief sunken \
5407         -width 75 -height 9 -wrap none \
5408         -font font_diff \
5409         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5410 scrollbar .vpane.lower.commarea.buffer.sby \
5411         -command [list $ui_comm yview]
5412 pack .vpane.lower.commarea.buffer.header -side top -fill x
5413 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5414 pack $ui_comm -side left -fill y
5415 pack .vpane.lower.commarea.buffer -side left -fill y
5416
5417 # -- Commit Message Buffer Context Menu
5418 #
5419 set ctxm .vpane.lower.commarea.buffer.ctxm
5420 menu $ctxm -tearoff 0
5421 $ctxm add command \
5422         -label {Cut} \
5423         -font font_ui \
5424         -command {tk_textCut $ui_comm}
5425 $ctxm add command \
5426         -label {Copy} \
5427         -font font_ui \
5428         -command {tk_textCopy $ui_comm}
5429 $ctxm add command \
5430         -label {Paste} \
5431         -font font_ui \
5432         -command {tk_textPaste $ui_comm}
5433 $ctxm add command \
5434         -label {Delete} \
5435         -font font_ui \
5436         -command {$ui_comm delete sel.first sel.last}
5437 $ctxm add separator
5438 $ctxm add command \
5439         -label {Select All} \
5440         -font font_ui \
5441         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5442 $ctxm add command \
5443         -label {Copy All} \
5444         -font font_ui \
5445         -command {
5446                 $ui_comm tag add sel 0.0 end
5447                 tk_textCopy $ui_comm
5448                 $ui_comm tag remove sel 0.0 end
5449         }
5450 $ctxm add separator
5451 $ctxm add command \
5452         -label {Sign Off} \
5453         -font font_ui \
5454         -command do_signoff
5455 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5456
5457 # -- Diff Header
5458 #
5459 set current_diff_path {}
5460 set current_diff_side {}
5461 set diff_actions [list]
5462 proc trace_current_diff_path {varname args} {
5463         global current_diff_path diff_actions file_states
5464         if {$current_diff_path eq {}} {
5465                 set s {}
5466                 set f {}
5467                 set p {}
5468                 set o disabled
5469         } else {
5470                 set p $current_diff_path
5471                 set s [mapdesc [lindex $file_states($p) 0] $p]
5472                 set f {File:}
5473                 set p [escape_path $p]
5474                 set o normal
5475         }
5476
5477         .vpane.lower.diff.header.status configure -text $s
5478         .vpane.lower.diff.header.file configure -text $f
5479         .vpane.lower.diff.header.path configure -text $p
5480         foreach w $diff_actions {
5481                 uplevel #0 $w $o
5482         }
5483 }
5484 trace add variable current_diff_path write trace_current_diff_path
5485
5486 frame .vpane.lower.diff.header -background orange
5487 label .vpane.lower.diff.header.status \
5488         -background orange \
5489         -width $max_status_desc \
5490         -anchor w \
5491         -justify left \
5492         -font font_ui
5493 label .vpane.lower.diff.header.file \
5494         -background orange \
5495         -anchor w \
5496         -justify left \
5497         -font font_ui
5498 label .vpane.lower.diff.header.path \
5499         -background orange \
5500         -anchor w \
5501         -justify left \
5502         -font font_ui
5503 pack .vpane.lower.diff.header.status -side left
5504 pack .vpane.lower.diff.header.file -side left
5505 pack .vpane.lower.diff.header.path -fill x
5506 set ctxm .vpane.lower.diff.header.ctxm
5507 menu $ctxm -tearoff 0
5508 $ctxm add command \
5509         -label {Copy} \
5510         -font font_ui \
5511         -command {
5512                 clipboard clear
5513                 clipboard append \
5514                         -format STRING \
5515                         -type STRING \
5516                         -- $current_diff_path
5517         }
5518 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5519 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5520
5521 # -- Diff Body
5522 #
5523 frame .vpane.lower.diff.body
5524 set ui_diff .vpane.lower.diff.body.t
5525 text $ui_diff -background white -borderwidth 0 \
5526         -width 80 -height 15 -wrap none \
5527         -font font_diff \
5528         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5529         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5530         -state disabled
5531 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5532         -command [list $ui_diff xview]
5533 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5534         -command [list $ui_diff yview]
5535 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5536 pack .vpane.lower.diff.body.sby -side right -fill y
5537 pack $ui_diff -side left -fill both -expand 1
5538 pack .vpane.lower.diff.header -side top -fill x
5539 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5540
5541 $ui_diff tag conf d_cr -elide true
5542 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5543 $ui_diff tag conf d_+ -foreground {#00a000}
5544 $ui_diff tag conf d_- -foreground red
5545
5546 $ui_diff tag conf d_++ -foreground {#00a000}
5547 $ui_diff tag conf d_-- -foreground red
5548 $ui_diff tag conf d_+s \
5549         -foreground {#00a000} \
5550         -background {#e2effa}
5551 $ui_diff tag conf d_-s \
5552         -foreground red \
5553         -background {#e2effa}
5554 $ui_diff tag conf d_s+ \
5555         -foreground {#00a000} \
5556         -background ivory1
5557 $ui_diff tag conf d_s- \
5558         -foreground red \
5559         -background ivory1
5560
5561 $ui_diff tag conf d<<<<<<< \
5562         -foreground orange \
5563         -font font_diffbold
5564 $ui_diff tag conf d======= \
5565         -foreground orange \
5566         -font font_diffbold
5567 $ui_diff tag conf d>>>>>>> \
5568         -foreground orange \
5569         -font font_diffbold
5570
5571 $ui_diff tag raise sel
5572
5573 # -- Diff Body Context Menu
5574 #
5575 set ctxm .vpane.lower.diff.body.ctxm
5576 menu $ctxm -tearoff 0
5577 $ctxm add command \
5578         -label {Refresh} \
5579         -font font_ui \
5580         -command reshow_diff
5581 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5582 $ctxm add command \
5583         -label {Copy} \
5584         -font font_ui \
5585         -command {tk_textCopy $ui_diff}
5586 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5587 $ctxm add command \
5588         -label {Select All} \
5589         -font font_ui \
5590         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5591 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5592 $ctxm add command \
5593         -label {Copy All} \
5594         -font font_ui \
5595         -command {
5596                 $ui_diff tag add sel 0.0 end
5597                 tk_textCopy $ui_diff
5598                 $ui_diff tag remove sel 0.0 end
5599         }
5600 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5601 $ctxm add separator
5602 $ctxm add command \
5603         -label {Apply/Reverse Hunk} \
5604         -font font_ui \
5605         -command {apply_hunk $cursorX $cursorY}
5606 set ui_diff_applyhunk [$ctxm index last]
5607 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5608 $ctxm add separator
5609 $ctxm add command \
5610         -label {Decrease Font Size} \
5611         -font font_ui \
5612         -command {incr_font_size font_diff -1}
5613 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5614 $ctxm add command \
5615         -label {Increase Font Size} \
5616         -font font_ui \
5617         -command {incr_font_size font_diff 1}
5618 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5619 $ctxm add separator
5620 $ctxm add command \
5621         -label {Show Less Context} \
5622         -font font_ui \
5623         -command {if {$repo_config(gui.diffcontext) >= 2} {
5624                 incr repo_config(gui.diffcontext) -1
5625                 reshow_diff
5626         }}
5627 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5628 $ctxm add command \
5629         -label {Show More Context} \
5630         -font font_ui \
5631         -command {
5632                 incr repo_config(gui.diffcontext)
5633                 reshow_diff
5634         }
5635 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5636 $ctxm add separator
5637 $ctxm add command -label {Options...} \
5638         -font font_ui \
5639         -command do_options
5640 bind_button3 $ui_diff "
5641         set cursorX %x
5642         set cursorY %y
5643         if {\$ui_index eq \$current_diff_side} {
5644                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5645         } else {
5646                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5647         }
5648         tk_popup $ctxm %X %Y
5649 "
5650 unset ui_diff_applyhunk
5651
5652 # -- Status Bar
5653 #
5654 set ui_status_value {Initializing...}
5655 label .status -textvariable ui_status_value \
5656         -anchor w \
5657         -justify left \
5658         -borderwidth 1 \
5659         -relief sunken \
5660         -font font_ui
5661 pack .status -anchor w -side bottom -fill x
5662
5663 # -- Load geometry
5664 #
5665 catch {
5666 set gm $repo_config(gui.geometry)
5667 wm geometry . [lindex $gm 0]
5668 .vpane sash place 0 \
5669         [lindex [.vpane sash coord 0] 0] \
5670         [lindex $gm 1]
5671 .vpane.files sash place 0 \
5672         [lindex $gm 2] \
5673         [lindex [.vpane.files sash coord 0] 1]
5674 unset gm
5675 }
5676
5677 # -- Key Bindings
5678 #
5679 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5680 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5681 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5682 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5683 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5684 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5685 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5686 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5687 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5688 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5689 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5690
5691 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5692 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5693 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5694 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5695 bind $ui_diff <$M1B-Key-v> {break}
5696 bind $ui_diff <$M1B-Key-V> {break}
5697 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5698 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5699 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5700 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5701 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5702 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5703 bind $ui_diff <Button-1>   {focus %W}
5704
5705 if {[is_enabled multicommit]} {
5706         bind . <$M1B-Key-n> do_create_branch
5707         bind . <$M1B-Key-N> do_create_branch
5708 }
5709
5710 bind .   <Destroy> do_quit
5711 bind all <Key-F5> do_rescan
5712 bind all <$M1B-Key-r> do_rescan
5713 bind all <$M1B-Key-R> do_rescan
5714 bind .   <$M1B-Key-s> do_signoff
5715 bind .   <$M1B-Key-S> do_signoff
5716 bind .   <$M1B-Key-i> do_add_all
5717 bind .   <$M1B-Key-I> do_add_all
5718 bind .   <$M1B-Key-Return> do_commit
5719 bind all <$M1B-Key-q> do_quit
5720 bind all <$M1B-Key-Q> do_quit
5721 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5722 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5723 foreach i [list $ui_index $ui_workdir] {
5724         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5725         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5726         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5727 }
5728 unset i
5729
5730 set file_lists($ui_index) [list]
5731 set file_lists($ui_workdir) [list]
5732
5733 set HEAD {}
5734 set PARENT {}
5735 set MERGE_HEAD [list]
5736 set commit_type {}
5737 set empty_tree {}
5738 set current_branch {}
5739 set current_diff_path {}
5740 set selected_commit_type new
5741
5742 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5743 focus -force $ui_comm
5744
5745 # -- Warn the user about environmental problems.  Cygwin's Tcl
5746 #    does *not* pass its env array onto any processes it spawns.
5747 #    This means that git processes get none of our environment.
5748 #
5749 if {[is_Cygwin]} {
5750         set ignored_env 0
5751         set suggest_user {}
5752         set msg "Possible environment issues exist.
5753
5754 The following environment variables are probably
5755 going to be ignored by any Git subprocess run
5756 by [appname]:
5757
5758 "
5759         foreach name [array names env] {
5760                 switch -regexp -- $name {
5761                 {^GIT_INDEX_FILE$} -
5762                 {^GIT_OBJECT_DIRECTORY$} -
5763                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5764                 {^GIT_DIFF_OPTS$} -
5765                 {^GIT_EXTERNAL_DIFF$} -
5766                 {^GIT_PAGER$} -
5767                 {^GIT_TRACE$} -
5768                 {^GIT_CONFIG$} -
5769                 {^GIT_CONFIG_LOCAL$} -
5770                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5771                         append msg " - $name\n"
5772                         incr ignored_env
5773                 }
5774                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5775                         append msg " - $name\n"
5776                         incr ignored_env
5777                         set suggest_user $name
5778                 }
5779                 }
5780         }
5781         if {$ignored_env > 0} {
5782                 append msg "
5783 This is due to a known issue with the
5784 Tcl binary distributed by Cygwin."
5785
5786                 if {$suggest_user ne {}} {
5787                         append msg "
5788
5789 A good replacement for $suggest_user
5790 is placing values for the user.name and
5791 user.email settings into your personal
5792 ~/.gitconfig file.
5793 "
5794                 }
5795                 warn_popup $msg
5796         }
5797         unset ignored_env msg suggest_user name
5798 }
5799
5800 # -- Only initialize complex UI if we are going to stay running.
5801 #
5802 if {[is_enabled multicommit]} {
5803         load_all_remotes
5804         load_all_heads
5805
5806         populate_branch_menu
5807         populate_fetch_menu
5808         populate_push_menu
5809 }
5810
5811 # -- Only suggest a gc run if we are going to stay running.
5812 #
5813 if {[is_enabled multicommit]} {
5814         set object_limit 2000
5815         if {[is_Windows]} {set object_limit 200}
5816         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5817         if {$objects_current >= $object_limit} {
5818                 if {[ask_popup \
5819                         "This repository currently has $objects_current loose objects.
5820
5821 To maintain optimal performance it is strongly
5822 recommended that you compress the database
5823 when more than $object_limit loose objects exist.
5824
5825 Compress the database now?"] eq yes} {
5826                         do_gc
5827                 }
5828         }
5829         unset object_limit _junk objects_current
5830 }
5831
5832 lock_index begin-read
5833 after 1 do_rescan