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