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