git-gui.sh

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