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) %(refname)}
2920         lappend cmd refs/heads
2921         lappend cmd refs/remotes
2922         set fr_fd [open "| $cmd" r]
2923         fconfigure $fr_fd -translation binary
2924         while {[gets $fr_fd line] > 0} {
2925                 set line [split $line { }]
2926                 set sha1([lindex $line 0]) [lindex $line 1]
2927         }
2928         close $fr_fd
2929
2930         set to_show {}
2931         set fr_fd [open "| git rev-list --all --not HEAD"]
2932         while {[gets $fr_fd line] > 0} {
2933                 if {[catch {set ref $sha1($line)}]} continue
2934                 regsub ^refs/(heads|remotes)/ $ref {} ref
2935                 lappend to_show $ref
2936         }
2937         close $fr_fd
2938
2939         foreach ref [lsort -unique $to_show] {
2940                 $w.source.l insert end $ref
2941         }
2942
2943         bind $w <Visibility> "grab $w"
2944         bind $w <Key-Escape> "unlock_index;destroy $w"
2945         bind $w <Destroy> unlock_index
2946         wm title $w "[appname] ([reponame]): Merge"
2947         tkwait window $w
2948 }
2949
2950 proc do_reset_hard {} {
2951         global HEAD commit_type file_states
2952
2953         if {[string match amend* $commit_type]} {
2954                 info_popup {Cannot abort while amending.
2955
2956 You must finish amending this commit.
2957 }
2958                 return
2959         }
2960
2961         if {![lock_index abort]} return
2962
2963         if {[string match *merge* $commit_type]} {
2964                 set op merge
2965         } else {
2966                 set op commit
2967         }
2968
2969         if {[ask_popup "Abort $op?
2970
2971 Aborting the current $op will cause
2972 *ALL* uncommitted changes to be lost.
2973
2974 Continue with aborting the current $op?"] eq {yes}} {
2975                 set fd [open "| git read-tree --reset -u HEAD" r]
2976                 fconfigure $fd -blocking 0 -translation binary
2977                 fileevent $fd readable [list reset_hard_wait $fd]
2978                 set ui_status_value {Aborting... please wait...}
2979         } else {
2980                 unlock_index
2981         }
2982 }
2983
2984 proc reset_hard_wait {fd} {
2985         global ui_comm
2986
2987         read $fd
2988         if {[eof $fd]} {
2989                 close $fd
2990                 unlock_index
2991
2992                 $ui_comm delete 0.0 end
2993                 $ui_comm edit modified false
2994
2995                 catch {file delete [gitdir MERGE_HEAD]}
2996                 catch {file delete [gitdir rr-cache MERGE_RR]}
2997                 catch {file delete [gitdir SQUASH_MSG]}
2998                 catch {file delete [gitdir MERGE_MSG]}
2999                 catch {file delete [gitdir GITGUI_MSG]}
3000
3001                 rescan {set ui_status_value {Abort completed.  Ready.}}
3002         }
3003 }
3004
3005 ######################################################################
3006 ##
3007 ## browser
3008
3009 set next_browser_id 0
3010
3011 proc new_browser {commit} {
3012         global next_browser_id cursor_ptr M1B
3013         global browser_commit browser_status browser_stack browser_path browser_busy
3014
3015         set w .browser[incr next_browser_id]
3016         set w_list $w.list.l
3017         set browser_commit($w_list) $commit
3018         set browser_status($w_list) {Starting...}
3019         set browser_stack($w_list) {}
3020         set browser_path($w_list) $browser_commit($w_list):
3021         set browser_busy($w_list) 1
3022
3023         toplevel $w
3024         label $w.path -textvariable browser_path($w_list) \
3025                 -anchor w \
3026                 -justify left \
3027                 -borderwidth 1 \
3028                 -relief sunken \
3029                 -font font_uibold
3030         pack $w.path -anchor w -side top -fill x
3031
3032         frame $w.list
3033         text $w_list -background white -borderwidth 0 \
3034                 -cursor $cursor_ptr \
3035                 -state disabled \
3036                 -wrap none \
3037                 -height 20 \
3038                 -width 70 \
3039                 -xscrollcommand [list $w.list.sbx set] \
3040                 -yscrollcommand [list $w.list.sby set] \
3041                 -font font_ui
3042         $w_list tag conf in_sel \
3043                 -background [$w_list cget -foreground] \
3044                 -foreground [$w_list cget -background]
3045         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3046         scrollbar $w.list.sby -orient v -command [list $w_list yview]
3047         pack $w.list.sbx -side bottom -fill x
3048         pack $w.list.sby -side right -fill y
3049         pack $w_list -side left -fill both -expand 1
3050         pack $w.list -side top -fill both -expand 1
3051
3052         label $w.status -textvariable browser_status($w_list) \
3053                 -anchor w \
3054                 -justify left \
3055                 -borderwidth 1 \
3056                 -relief sunken \
3057                 -font font_ui
3058         pack $w.status -anchor w -side bottom -fill x
3059
3060         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3061         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3062         bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3063         bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3064         bind $w_list <Up>              "browser_move -1 $w_list;break"
3065         bind $w_list <Down>            "browser_move 1 $w_list;break"
3066         bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3067         bind $w_list <Return>          "browser_enter $w_list;break"
3068         bind $w_list <Prior>           "browser_page -1 $w_list;break"
3069         bind $w_list <Next>            "browser_page 1 $w_list;break"
3070         bind $w_list <Left>            break
3071         bind $w_list <Right>           break
3072
3073         bind $w <Visibility> "focus $w"
3074         bind $w <Destroy> "
3075                 array unset browser_buffer $w_list
3076                 array unset browser_files $w_list
3077                 array unset browser_status $w_list
3078                 array unset browser_stack $w_list
3079                 array unset browser_path $w_list
3080                 array unset browser_commit $w_list
3081                 array unset browser_busy $w_list
3082         "
3083         wm title $w "[appname] ([reponame]): File Browser"
3084         ls_tree $w_list $browser_commit($w_list) {}
3085 }
3086
3087 proc browser_move {dir w} {
3088         global browser_files browser_busy
3089
3090         if {$browser_busy($w)} return
3091         set lno [lindex [split [$w index in_sel.first] .] 0]
3092         incr lno $dir
3093         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3094                 $w tag remove in_sel 0.0 end
3095                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3096                 $w see $lno.0
3097         }
3098 }
3099
3100 proc browser_page {dir w} {
3101         global browser_files browser_busy
3102
3103         if {$browser_busy($w)} return
3104         $w yview scroll $dir pages
3105         set lno [expr {int(
3106                   [lindex [$w yview] 0]
3107                 * [llength $browser_files($w)]
3108                 + 1)}]
3109         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3110                 $w tag remove in_sel 0.0 end
3111                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3112                 $w see $lno.0
3113         }
3114 }
3115
3116 proc browser_parent {w} {
3117         global browser_files browser_status browser_path
3118         global browser_stack browser_busy
3119
3120         if {$browser_busy($w)} return
3121         set info [lindex $browser_files($w) 0]
3122         if {[lindex $info 0] eq {parent}} {
3123                 set parent [lindex $browser_stack($w) end-1]
3124                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3125                 if {$browser_stack($w) eq {}} {
3126                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3127                 } else {
3128                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3129                 }
3130                 set browser_status($w) "Loading $browser_path($w)..."
3131                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3132         }
3133 }
3134
3135 proc browser_enter {w} {
3136         global browser_files browser_status browser_path
3137         global browser_commit browser_stack browser_busy
3138
3139         if {$browser_busy($w)} return
3140         set lno [lindex [split [$w index in_sel.first] .] 0]
3141         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3142         if {$info ne {}} {
3143                 switch -- [lindex $info 0] {
3144                 parent {
3145                         browser_parent $w
3146                 }
3147                 tree {
3148                         set name [lindex $info 2]
3149                         set escn [escape_path $name]
3150                         set browser_status($w) "Loading $escn..."
3151                         append browser_path($w) $escn
3152                         ls_tree $w [lindex $info 1] $name
3153                 }
3154                 blob {
3155                         set name [lindex $info 2]
3156                         set p {}
3157                         foreach n $browser_stack($w) {
3158                                 append p [lindex $n 1]
3159                         }
3160                         append p $name
3161                         show_blame $browser_commit($w) $p
3162                 }
3163                 }
3164         }
3165 }
3166
3167 proc browser_click {was_double_click w pos} {
3168         global browser_files browser_busy
3169
3170         if {$browser_busy($w)} return
3171         set lno [lindex [split [$w index $pos] .] 0]
3172         focus $w
3173
3174         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3175                 $w tag remove in_sel 0.0 end
3176                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3177                 if {$was_double_click} {
3178                         browser_enter $w
3179                 }
3180         }
3181 }
3182
3183 proc ls_tree {w tree_id name} {
3184         global browser_buffer browser_files browser_stack browser_busy
3185
3186         set browser_buffer($w) {}
3187         set browser_files($w) {}
3188         set browser_busy($w) 1
3189
3190         $w conf -state normal
3191         $w tag remove in_sel 0.0 end
3192         $w delete 0.0 end
3193         if {$browser_stack($w) ne {}} {
3194                 $w image create end \
3195                         -align center -padx 5 -pady 1 \
3196                         -name icon0 \
3197                         -image file_uplevel
3198                 $w insert end {[Up To Parent]}
3199                 lappend browser_files($w) parent
3200         }
3201         lappend browser_stack($w) [list $tree_id $name]
3202         $w conf -state disabled
3203
3204         set cmd [list git ls-tree -z $tree_id]
3205         set fd [open "| $cmd" r]
3206         fconfigure $fd -blocking 0 -translation binary -encoding binary
3207         fileevent $fd readable [list read_ls_tree $fd $w]
3208 }
3209
3210 proc read_ls_tree {fd w} {
3211         global browser_buffer browser_files browser_status browser_busy
3212
3213         if {![winfo exists $w]} {
3214                 catch {close $fd}
3215                 return
3216         }
3217
3218         append browser_buffer($w) [read $fd]
3219         set pck [split $browser_buffer($w) "\0"]
3220         set browser_buffer($w) [lindex $pck end]
3221
3222         set n [llength $browser_files($w)]
3223         $w conf -state normal
3224         foreach p [lrange $pck 0 end-1] {
3225                 set info [split $p "\t"]
3226                 set path [lindex $info 1]
3227                 set info [split [lindex $info 0] { }]
3228                 set type [lindex $info 1]
3229                 set object [lindex $info 2]
3230
3231                 switch -- $type {
3232                 blob {
3233                         set image file_mod
3234                 }
3235                 tree {
3236                         set image file_dir
3237                         append path /
3238                 }
3239                 default {
3240                         set image file_question
3241                 }
3242                 }
3243
3244                 if {$n > 0} {$w insert end "\n"}
3245                 $w image create end \
3246                         -align center -padx 5 -pady 1 \
3247                         -name icon[incr n] \
3248                         -image $image
3249                 $w insert end [escape_path $path]
3250                 lappend browser_files($w) [list $type $object $path]
3251         }
3252         $w conf -state disabled
3253
3254         if {[eof $fd]} {
3255                 close $fd
3256                 set browser_status($w) Ready.
3257                 set browser_busy($w) 0
3258                 array unset browser_buffer $w
3259                 if {$n > 0} {
3260                         $w tag add in_sel 1.0 2.0
3261                         focus -force $w
3262                 }
3263         }
3264 }
3265
3266 proc show_blame {commit path} {
3267         global next_browser_id blame_status blame_data
3268
3269         if {[winfo ismapped .]} {
3270                 set w .browser[incr next_browser_id]
3271                 set tl $w
3272                 toplevel $w
3273         } else {
3274                 set w {}
3275                 set tl .
3276         }
3277         set blame_status($w) {Loading current file content...}
3278
3279         label $w.path -text "$commit:$path" \
3280                 -anchor w \
3281                 -justify left \
3282                 -borderwidth 1 \
3283                 -relief sunken \
3284                 -font font_uibold
3285         pack $w.path -side top -fill x
3286
3287         frame $w.out
3288         text $w.out.loaded_t \
3289                 -background white -borderwidth 0 \
3290                 -state disabled \
3291                 -wrap none \
3292                 -height 40 \
3293                 -width 1 \
3294                 -font font_diff
3295         $w.out.loaded_t tag conf annotated -background grey
3296
3297         text $w.out.linenumber_t \
3298                 -background white -borderwidth 0 \
3299                 -state disabled \
3300                 -wrap none \
3301                 -height 40 \
3302                 -width 5 \
3303                 -font font_diff
3304         $w.out.linenumber_t tag conf linenumber -justify right
3305
3306         text $w.out.file_t \
3307                 -background white -borderwidth 0 \
3308                 -state disabled \
3309                 -wrap none \
3310                 -height 40 \
3311                 -width 80 \
3312                 -xscrollcommand [list $w.out.sbx set] \
3313                 -font font_diff
3314
3315         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3316         scrollbar $w.out.sby -orient v \
3317                 -command [list scrollbar2many [list \
3318                 $w.out.loaded_t \
3319                 $w.out.linenumber_t \
3320                 $w.out.file_t \
3321                 ] yview]
3322         grid \
3323                 $w.out.linenumber_t \
3324                 $w.out.loaded_t \
3325                 $w.out.file_t \
3326                 $w.out.sby \
3327                 -sticky nsew
3328         grid conf $w.out.sbx -column 2 -sticky we
3329         grid columnconfigure $w.out 2 -weight 1
3330         grid rowconfigure $w.out 0 -weight 1
3331         pack $w.out -fill both -expand 1
3332
3333         label $w.status -textvariable blame_status($w) \
3334                 -anchor w \
3335                 -justify left \
3336                 -borderwidth 1 \
3337                 -relief sunken \
3338                 -font font_ui
3339         pack $w.status -side bottom -fill x
3340
3341         frame $w.cm
3342         text $w.cm.t \
3343                 -background white -borderwidth 0 \
3344                 -state disabled \
3345                 -wrap none \
3346                 -height 10 \
3347                 -width 80 \
3348                 -xscrollcommand [list $w.cm.sbx set] \
3349                 -yscrollcommand [list $w.cm.sby set] \
3350                 -font font_diff
3351         scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3352         scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3353         pack $w.cm.sby -side right -fill y
3354         pack $w.cm.sbx -side bottom -fill x
3355         pack $w.cm.t -expand 1 -fill both
3356         pack $w.cm -side bottom -fill x
3357
3358         menu $w.ctxm -tearoff 0
3359         $w.ctxm add command -label "Copy Commit" \
3360                 -font font_ui \
3361                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3362
3363         foreach i [list \
3364                 $w.out.loaded_t \
3365                 $w.out.linenumber_t \
3366                 $w.out.file_t] {
3367                 $i tag conf in_sel \
3368                         -background [$i cget -foreground] \
3369                         -foreground [$i cget -background]
3370                 $i conf -yscrollcommand \
3371                         [list many2scrollbar [list \
3372                         $w.out.loaded_t \
3373                         $w.out.linenumber_t \
3374                         $w.out.file_t \
3375                         ] yview $w.out.sby]
3376                 bind $i <Button-1> "
3377                         blame_click {$w} \\
3378                                 $w.cm.t \\
3379                                 $w.out.linenumber_t \\
3380                                 $w.out.file_t \\
3381                                 $i @%x,%y
3382                         focus $i
3383                 "
3384                 bind_button3 $i "
3385                         set cursorX %x
3386                         set cursorY %y
3387                         set cursorW %W
3388                         tk_popup $w.ctxm %X %Y
3389                 "
3390         }
3391
3392         bind $w.cm.t <Button-1> "focus $w.cm.t"
3393         bind $tl <Visibility> "focus $tl"
3394         bind $tl <Destroy> "
3395                 array unset blame_status {$w}
3396                 array unset blame_data $w,*
3397         "
3398         wm title $tl "[appname] ([reponame]): File Viewer"
3399
3400         set blame_data($w,commit_count) 0
3401         set blame_data($w,commit_list) {}
3402         set blame_data($w,total_lines) 0
3403         set blame_data($w,blame_lines) 0
3404         set blame_data($w,highlight_commit) {}
3405         set blame_data($w,highlight_line) -1
3406
3407         set cmd [list git cat-file blob "$commit:$path"]
3408         set fd [open "| $cmd" r]
3409         fconfigure $fd -blocking 0 -translation lf -encoding binary
3410         fileevent $fd readable [list read_blame_catfile \
3411                 $fd $w $commit $path \
3412                 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3413 }
3414
3415 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3416         global blame_status blame_data
3417
3418         if {![winfo exists $w_file]} {
3419                 catch {close $fd}
3420                 return
3421         }
3422
3423         set n $blame_data($w,total_lines)
3424         $w_load conf -state normal
3425         $w_line conf -state normal
3426         $w_file conf -state normal
3427         while {[gets $fd line] >= 0} {
3428                 regsub "\r\$" $line {} line
3429                 incr n
3430                 $w_load insert end "\n"
3431                 $w_line insert end "$n\n" linenumber
3432                 $w_file insert end "$line\n"
3433         }
3434         $w_load conf -state disabled
3435         $w_line conf -state disabled
3436         $w_file conf -state disabled
3437         set blame_data($w,total_lines) $n
3438
3439         if {[eof $fd]} {
3440                 close $fd
3441                 blame_incremental_status $w
3442                 set cmd [list git blame -M -C --incremental]
3443                 lappend cmd $commit -- $path
3444                 set fd [open "| $cmd" r]
3445                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3446                 fileevent $fd readable [list read_blame_incremental $fd $w \
3447                         $w_load $w_cmit $w_line $w_file]
3448         }
3449 }
3450
3451 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3452         global blame_status blame_data
3453
3454         if {![winfo exists $w_file]} {
3455                 catch {close $fd}
3456                 return
3457         }
3458
3459         while {[gets $fd line] >= 0} {
3460                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3461                         cmit original_line final_line line_count]} {
3462                         set blame_data($w,commit) $cmit
3463                         set blame_data($w,original_line) $original_line
3464                         set blame_data($w,final_line) $final_line
3465                         set blame_data($w,line_count) $line_count
3466
3467                         if {[catch {set g $blame_data($w,$cmit,order)}]} {
3468                                 $w_line tag conf g$cmit
3469                                 $w_file tag conf g$cmit
3470                                 $w_line tag raise in_sel
3471                                 $w_file tag raise in_sel
3472                                 $w_file tag raise sel
3473                                 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3474                                 incr blame_data($w,commit_count)
3475                                 lappend blame_data($w,commit_list) $cmit
3476                         }
3477                 } elseif {[string match {filename *} $line]} {
3478                         set file [string range $line 9 end]
3479                         set n $blame_data($w,line_count)
3480                         set lno $blame_data($w,final_line)
3481                         set cmit $blame_data($w,commit)
3482
3483                         while {$n > 0} {
3484                                 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3485                                         $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3486                                 } else {
3487                                         $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3488                                         $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3489                                 }
3490
3491                                 set blame_data($w,line$lno,commit) $cmit
3492                                 set blame_data($w,line$lno,file) $file
3493                                 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3494                                 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3495
3496                                 if {$blame_data($w,highlight_line) == -1} {
3497                                         if {[lindex [$w_file yview] 0] == 0} {
3498                                                 $w_file see $lno.0
3499                                                 blame_showcommit $w $w_cmit $w_line $w_file $lno
3500                                         }
3501                                 } elseif {$blame_data($w,highlight_line) == $lno} {
3502                                         blame_showcommit $w $w_cmit $w_line $w_file $lno
3503                                 }
3504
3505                                 incr n -1
3506                                 incr lno
3507                                 incr blame_data($w,blame_lines)
3508                         }
3509
3510                         set hc $blame_data($w,highlight_commit)
3511                         if {$hc ne {}
3512                                 && [expr {$blame_data($w,$hc,order) + 1}]
3513                                         == $blame_data($w,$cmit,order)} {
3514                                 blame_showcommit $w $w_cmit $w_line $w_file \
3515                                         $blame_data($w,highlight_line)
3516                         }
3517                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3518                         set blame_data($w,$blame_data($w,commit),$header) $data
3519                 }
3520         }
3521
3522         if {[eof $fd]} {
3523                 close $fd
3524                 set blame_status($w) {Annotation complete.}
3525         } else {
3526                 blame_incremental_status $w
3527         }
3528 }
3529
3530 proc blame_incremental_status {w} {
3531         global blame_status blame_data
3532
3533         set blame_status($w) [format \
3534                 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3535                 $blame_data($w,blame_lines) \
3536                 $blame_data($w,total_lines) \
3537                 [expr {100 * $blame_data($w,blame_lines)
3538                         / $blame_data($w,total_lines)}]]
3539 }
3540
3541 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3542         set lno [lindex [split [$cur_w index $pos] .] 0]
3543         if {$lno eq {}} return
3544
3545         $w_line tag remove in_sel 0.0 end
3546         $w_file tag remove in_sel 0.0 end
3547         $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3548         $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3549
3550         blame_showcommit $w $w_cmit $w_line $w_file $lno
3551 }
3552
3553 set blame_colors {
3554         #ff4040
3555         #ff40ff
3556         #4040ff
3557 }
3558
3559 proc blame_showcommit {w w_cmit w_line w_file lno} {
3560         global blame_colors blame_data repo_config
3561
3562         set cmit $blame_data($w,highlight_commit)
3563         if {$cmit ne {}} {
3564                 set idx $blame_data($w,$cmit,order)
3565                 set i 0
3566                 foreach c $blame_colors {
3567                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3568                         $w_line tag conf g$h -background white
3569                         $w_file tag conf g$h -background white
3570                         incr i
3571                 }
3572         }
3573
3574         $w_cmit conf -state normal
3575         $w_cmit delete 0.0 end
3576         if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3577                 set cmit {}
3578                 $w_cmit insert end "Loading annotation..."
3579         } else {
3580                 set idx $blame_data($w,$cmit,order)
3581                 set i 0
3582                 foreach c $blame_colors {
3583                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3584                         $w_line tag conf g$h -background $c
3585                         $w_file tag conf g$h -background $c
3586                         incr i
3587                 }
3588
3589                 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3590                         set msg {}
3591                         catch {
3592                                 set fd [open "| git cat-file commit $cmit" r]
3593                                 fconfigure $fd -encoding binary -translation lf
3594                                 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3595                                         set enc utf-8
3596                                 }
3597                                 while {[gets $fd line] > 0} {
3598                                         if {[string match {encoding *} $line]} {
3599                                                 set enc [string tolower [string range $line 9 end]]
3600                                         }
3601                                 }
3602                                 fconfigure $fd -encoding $enc
3603                                 set msg [string trim [read $fd]]
3604                                 close $fd
3605                         }
3606                         set blame_data($w,$cmit,message) $msg
3607                 }
3608
3609                 set author_name {}
3610                 set author_email {}
3611                 set author_time {}
3612                 catch {set author_name $blame_data($w,$cmit,author)}
3613                 catch {set author_email $blame_data($w,$cmit,author-mail)}
3614                 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3615
3616                 set committer_name {}
3617                 set committer_email {}
3618                 set committer_time {}
3619                 catch {set committer_name $blame_data($w,$cmit,committer)}
3620                 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3621                 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3622
3623                 $w_cmit insert end "commit $cmit\n"
3624                 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3625                 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3626                 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3627                 $w_cmit insert end "\n"
3628                 $w_cmit insert end $msg
3629         }
3630         $w_cmit conf -state disabled
3631
3632         set blame_data($w,highlight_line) $lno
3633         set blame_data($w,highlight_commit) $cmit
3634 }
3635
3636 proc blame_copycommit {w i pos} {
3637         global blame_data
3638         set lno [lindex [split [$i index $pos] .] 0]
3639         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3640                 clipboard clear
3641                 clipboard append \
3642                         -format STRING \
3643                         -type STRING \
3644                         -- $commit
3645         }
3646 }
3647
3648 ######################################################################
3649 ##
3650 ## icons
3651
3652 set filemask {
3653 #define mask_width 14
3654 #define mask_height 15
3655 static unsigned char mask_bits[] = {
3656    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3657    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3658    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3659 }
3660
3661 image create bitmap file_plain -background white -foreground black -data {
3662 #define plain_width 14
3663 #define plain_height 15
3664 static unsigned char plain_bits[] = {
3665    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3666    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3667    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3668 } -maskdata $filemask
3669
3670 image create bitmap file_mod -background white -foreground blue -data {
3671 #define mod_width 14
3672 #define mod_height 15
3673 static unsigned char mod_bits[] = {
3674    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3675    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3676    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3677 } -maskdata $filemask
3678
3679 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3680 #define file_fulltick_width 14
3681 #define file_fulltick_height 15
3682 static unsigned char file_fulltick_bits[] = {
3683    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3684    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3685    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3686 } -maskdata $filemask
3687
3688 image create bitmap file_parttick -background white -foreground "#005050" -data {
3689 #define parttick_width 14
3690 #define parttick_height 15
3691 static unsigned char parttick_bits[] = {
3692    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3693    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3694    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3695 } -maskdata $filemask
3696
3697 image create bitmap file_question -background white -foreground black -data {
3698 #define file_question_width 14
3699 #define file_question_height 15
3700 static unsigned char file_question_bits[] = {
3701    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3702    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3703    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3704 } -maskdata $filemask
3705
3706 image create bitmap file_removed -background white -foreground red -data {
3707 #define file_removed_width 14
3708 #define file_removed_height 15
3709 static unsigned char file_removed_bits[] = {
3710    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3711    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3712    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3713 } -maskdata $filemask
3714
3715 image create bitmap file_merge -background white -foreground blue -data {
3716 #define file_merge_width 14
3717 #define file_merge_height 15
3718 static unsigned char file_merge_bits[] = {
3719    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3720    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3721    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3722 } -maskdata $filemask
3723
3724 set file_dir_data {
3725 #define file_width 18
3726 #define file_height 18
3727 static unsigned char file_bits[] = {
3728   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3729   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3730   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3731   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3732   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3733 }
3734 image create bitmap file_dir -background white -foreground blue \
3735         -data $file_dir_data -maskdata $file_dir_data
3736 unset file_dir_data
3737
3738 set file_uplevel_data {
3739 #define up_width 15
3740 #define up_height 15
3741 static unsigned char up_bits[] = {
3742   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3743   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3744   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3745 }
3746 image create bitmap file_uplevel -background white -foreground red \
3747         -data $file_uplevel_data -maskdata $file_uplevel_data
3748 unset file_uplevel_data
3749
3750 set ui_index .vpane.files.index.list
3751 set ui_workdir .vpane.files.workdir.list
3752
3753 set all_icons(_$ui_index)   file_plain
3754 set all_icons(A$ui_index)   file_fulltick
3755 set all_icons(M$ui_index)   file_fulltick
3756 set all_icons(D$ui_index)   file_removed
3757 set all_icons(U$ui_index)   file_merge
3758
3759 set all_icons(_$ui_workdir) file_plain
3760 set all_icons(M$ui_workdir) file_mod
3761 set all_icons(D$ui_workdir) file_question
3762 set all_icons(U$ui_workdir) file_merge
3763 set all_icons(O$ui_workdir) file_plain
3764
3765 set max_status_desc 0
3766 foreach i {
3767                 {__ "Unmodified"}
3768
3769                 {_M "Modified, not staged"}
3770                 {M_ "Staged for commit"}
3771                 {MM "Portions staged for commit"}
3772                 {MD "Staged for commit, missing"}
3773
3774                 {_O "Untracked, not staged"}
3775                 {A_ "Staged for commit"}
3776                 {AM "Portions staged for commit"}
3777                 {AD "Staged for commit, missing"}
3778
3779                 {_D "Missing"}
3780                 {D_ "Staged for removal"}
3781                 {DO "Staged for removal, still present"}
3782
3783                 {U_ "Requires merge resolution"}
3784                 {UU "Requires merge resolution"}
3785                 {UM "Requires merge resolution"}
3786                 {UD "Requires merge resolution"}
3787         } {
3788         if {$max_status_desc < [string length [lindex $i 1]]} {
3789                 set max_status_desc [string length [lindex $i 1]]
3790         }
3791         set all_descs([lindex $i 0]) [lindex $i 1]
3792 }
3793 unset i
3794
3795 ######################################################################
3796 ##
3797 ## util
3798
3799 proc bind_button3 {w cmd} {
3800         bind $w <Any-Button-3> $cmd
3801         if {[is_MacOSX]} {
3802                 bind $w <Control-Button-1> $cmd
3803         }
3804 }
3805
3806 proc scrollbar2many {list mode args} {
3807         foreach w $list {eval $w $mode $args}
3808 }
3809
3810 proc many2scrollbar {list mode sb top bottom} {
3811         $sb set $top $bottom
3812         foreach w $list {$w $mode moveto $top}
3813 }
3814
3815 proc incr_font_size {font {amt 1}} {
3816         set sz [font configure $font -size]
3817         incr sz $amt
3818         font configure $font -size $sz
3819         font configure ${font}bold -size $sz
3820 }
3821
3822 proc hook_failed_popup {hook msg} {
3823         set w .hookfail
3824         toplevel $w
3825
3826         frame $w.m
3827         label $w.m.l1 -text "$hook hook failed:" \
3828                 -anchor w \
3829                 -justify left \
3830                 -font font_uibold
3831         text $w.m.t \
3832                 -background white -borderwidth 1 \
3833                 -relief sunken \
3834                 -width 80 -height 10 \
3835                 -font font_diff \
3836                 -yscrollcommand [list $w.m.sby set]
3837         label $w.m.l2 \
3838                 -text {You must correct the above errors before committing.} \
3839                 -anchor w \
3840                 -justify left \
3841                 -font font_uibold
3842         scrollbar $w.m.sby -command [list $w.m.t yview]
3843         pack $w.m.l1 -side top -fill x
3844         pack $w.m.l2 -side bottom -fill x
3845         pack $w.m.sby -side right -fill y
3846         pack $w.m.t -side left -fill both -expand 1
3847         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3848
3849         $w.m.t insert 1.0 $msg
3850         $w.m.t conf -state disabled
3851
3852         button $w.ok -text OK \
3853                 -width 15 \
3854                 -font font_ui \
3855                 -command "destroy $w"
3856         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3857
3858         bind $w <Visibility> "grab $w; focus $w"
3859         bind $w <Key-Return> "destroy $w"
3860         wm title $w "[appname] ([reponame]): error"
3861         tkwait window $w
3862 }
3863
3864 set next_console_id 0
3865
3866 proc new_console {short_title long_title} {
3867         global next_console_id console_data
3868         set w .console[incr next_console_id]
3869         set console_data($w) [list $short_title $long_title]
3870         return [console_init $w]
3871 }
3872
3873 proc console_init {w} {
3874         global console_cr console_data M1B
3875
3876         set console_cr($w) 1.0
3877         toplevel $w
3878         frame $w.m
3879         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3880                 -anchor w \
3881                 -justify left \
3882                 -font font_uibold
3883         text $w.m.t \
3884                 -background white -borderwidth 1 \
3885                 -relief sunken \
3886                 -width 80 -height 10 \
3887                 -font font_diff \
3888                 -state disabled \
3889                 -yscrollcommand [list $w.m.sby set]
3890         label $w.m.s -text {Working... please wait...} \
3891                 -anchor w \
3892                 -justify left \
3893                 -font font_uibold
3894         scrollbar $w.m.sby -command [list $w.m.t yview]
3895         pack $w.m.l1 -side top -fill x
3896         pack $w.m.s -side bottom -fill x
3897         pack $w.m.sby -side right -fill y
3898         pack $w.m.t -side left -fill both -expand 1
3899         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3900
3901         menu $w.ctxm -tearoff 0
3902         $w.ctxm add command -label "Copy" \
3903                 -font font_ui \
3904                 -command "tk_textCopy $w.m.t"
3905         $w.ctxm add command -label "Select All" \
3906                 -font font_ui \
3907                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3908         $w.ctxm add command -label "Copy All" \
3909                 -font font_ui \
3910                 -command "
3911                         $w.m.t tag add sel 0.0 end
3912                         tk_textCopy $w.m.t
3913                         $w.m.t tag remove sel 0.0 end
3914                 "
3915
3916         button $w.ok -text {Close} \
3917                 -font font_ui \
3918                 -state disabled \
3919                 -command "destroy $w"
3920         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3921
3922         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3923         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3924         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3925         bind $w <Visibility> "focus $w"
3926         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3927         return $w
3928 }
3929
3930 proc console_exec {w cmd after} {
3931         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3932         #    But most users need that so we have to relogin. :-(
3933         #
3934         if {[is_Cygwin]} {
3935                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3936         }
3937
3938         # -- Tcl won't let us redirect both stdout and stderr to
3939         #    the same pipe.  So pass it through cat...
3940         #
3941         set cmd [concat | $cmd |& cat]
3942
3943         set fd_f [open $cmd r]
3944         fconfigure $fd_f -blocking 0 -translation binary
3945         fileevent $fd_f readable [list console_read $w $fd_f $after]
3946 }
3947
3948 proc console_read {w fd after} {
3949         global console_cr
3950
3951         set buf [read $fd]
3952         if {$buf ne {}} {
3953                 if {![winfo exists $w]} {console_init $w}
3954                 $w.m.t conf -state normal
3955                 set c 0
3956                 set n [string length $buf]
3957                 while {$c < $n} {
3958                         set cr [string first "\r" $buf $c]
3959                         set lf [string first "\n" $buf $c]
3960                         if {$cr < 0} {set cr [expr {$n + 1}]}
3961                         if {$lf < 0} {set lf [expr {$n + 1}]}
3962
3963                         if {$lf < $cr} {
3964                                 $w.m.t insert end [string range $buf $c $lf]
3965                                 set console_cr($w) [$w.m.t index {end -1c}]
3966                                 set c $lf
3967                                 incr c
3968                         } else {
3969                                 $w.m.t delete $console_cr($w) end
3970                                 $w.m.t insert end "\n"
3971                                 $w.m.t insert end [string range $buf $c $cr]
3972                                 set c $cr
3973                                 incr c
3974                         }
3975                 }
3976                 $w.m.t conf -state disabled
3977                 $w.m.t see end
3978         }
3979
3980         fconfigure $fd -blocking 1
3981         if {[eof $fd]} {
3982                 if {[catch {close $fd}]} {
3983                         set ok 0
3984                 } else {
3985                         set ok 1
3986                 }
3987                 uplevel #0 $after $w $ok
3988                 return
3989         }
3990         fconfigure $fd -blocking 0
3991 }
3992
3993 proc console_chain {cmdlist w {ok 1}} {
3994         if {$ok} {
3995                 if {[llength $cmdlist] == 0} {
3996                         console_done $w $ok
3997                         return
3998                 }
3999
4000                 set cmd [lindex $cmdlist 0]
4001                 set cmdlist [lrange $cmdlist 1 end]
4002
4003                 if {[lindex $cmd 0] eq {console_exec}} {
4004                         console_exec $w \
4005                                 [lindex $cmd 1] \
4006                                 [list console_chain $cmdlist]
4007                 } else {
4008                         uplevel #0 $cmd $cmdlist $w $ok
4009                 }
4010         } else {
4011                 console_done $w $ok
4012         }
4013 }
4014
4015 proc console_done {args} {
4016         global console_cr console_data
4017
4018         switch -- [llength $args] {
4019         2 {
4020                 set w [lindex $args 0]
4021                 set ok [lindex $args 1]
4022         }
4023         3 {
4024                 set w [lindex $args 1]
4025                 set ok [lindex $args 2]
4026         }
4027         default {
4028                 error "wrong number of args: console_done ?ignored? w ok"
4029         }
4030         }
4031
4032         if {$ok} {
4033                 if {[winfo exists $w]} {
4034                         $w.m.s conf -background green -text {Success}
4035                         $w.ok conf -state normal
4036                 }
4037         } else {
4038                 if {![winfo exists $w]} {
4039                         console_init $w
4040                 }
4041                 $w.m.s conf -background red -text {Error: Command Failed}
4042                 $w.ok conf -state normal
4043         }
4044
4045         array unset console_cr $w
4046         array unset console_data $w
4047 }
4048
4049 ######################################################################
4050 ##
4051 ## ui commands
4052
4053 set starting_gitk_msg {Starting gitk... please wait...}
4054
4055 proc do_gitk {revs} {
4056         global env ui_status_value starting_gitk_msg
4057
4058         # -- Always start gitk through whatever we were loaded with.  This
4059         #    lets us bypass using shell process on Windows systems.
4060         #
4061         set cmd [info nameofexecutable]
4062         lappend cmd [gitexec gitk]
4063         if {$revs ne {}} {
4064                 append cmd { }
4065                 append cmd $revs
4066         }
4067
4068         if {[catch {eval exec $cmd &} err]} {
4069                 error_popup "Failed to start gitk:\n\n$err"
4070         } else {
4071                 set ui_status_value $starting_gitk_msg
4072                 after 10000 {
4073                         if {$ui_status_value eq $starting_gitk_msg} {
4074                                 set ui_status_value {Ready.}
4075                         }
4076                 }
4077         }
4078 }
4079
4080 proc do_stats {} {
4081         set fd [open "| git count-objects -v" r]
4082         while {[gets $fd line] > 0} {
4083                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4084                         set stats($name) $value
4085                 }
4086         }
4087         close $fd
4088
4089         set packed_sz 0
4090         foreach p [glob -directory [gitdir objects pack] \
4091                 -type f \
4092                 -nocomplain -- *] {
4093                 incr packed_sz [file size $p]
4094         }
4095         if {$packed_sz > 0} {
4096                 set stats(size-pack) [expr {$packed_sz / 1024}]
4097         }
4098
4099         set w .stats_view
4100         toplevel $w
4101         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4102
4103         label $w.header -text {Database Statistics} \
4104                 -font font_uibold
4105         pack $w.header -side top -fill x
4106
4107         frame $w.buttons -border 1
4108         button $w.buttons.close -text Close \
4109                 -font font_ui \
4110                 -command [list destroy $w]
4111         button $w.buttons.gc -text {Compress Database} \
4112                 -font font_ui \
4113                 -command "destroy $w;do_gc"
4114         pack $w.buttons.close -side right
4115         pack $w.buttons.gc -side left
4116         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4117
4118         frame $w.stat -borderwidth 1 -relief solid
4119         foreach s {
4120                 {count           {Number of loose objects}}
4121                 {size            {Disk space used by loose objects} { KiB}}
4122                 {in-pack         {Number of packed objects}}
4123                 {packs           {Number of packs}}
4124                 {size-pack       {Disk space used by packed objects} { KiB}}
4125                 {prune-packable  {Packed objects waiting for pruning}}
4126                 {garbage         {Garbage files}}
4127                 } {
4128                 set name [lindex $s 0]
4129                 set label [lindex $s 1]
4130                 if {[catch {set value $stats($name)}]} continue
4131                 if {[llength $s] > 2} {
4132                         set value "$value[lindex $s 2]"
4133                 }
4134
4135                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4136                 label $w.stat.v_$name -text $value -anchor w -font font_ui
4137                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4138         }
4139         pack $w.stat -pady 10 -padx 10
4140
4141         bind $w <Visibility> "grab $w; focus $w"
4142         bind $w <Key-Escape> [list destroy $w]
4143         bind $w <Key-Return> [list destroy $w]
4144         wm title $w "[appname] ([reponame]): Database Statistics"
4145         tkwait window $w
4146 }
4147
4148 proc do_gc {} {
4149         set w [new_console {gc} {Compressing the object database}]
4150         console_chain {
4151                 {console_exec {git pack-refs --prune}}
4152                 {console_exec {git reflog expire --all}}
4153                 {console_exec {git repack -a -d -l}}
4154                 {console_exec {git rerere gc}}
4155         } $w
4156 }
4157
4158 proc do_fsck_objects {} {
4159         set w [new_console {fsck-objects} \
4160                 {Verifying the object database with fsck-objects}]
4161         set cmd [list git fsck-objects]
4162         lappend cmd --full
4163         lappend cmd --cache
4164         lappend cmd --strict
4165         console_exec $w $cmd console_done
4166 }
4167
4168 set is_quitting 0
4169
4170 proc do_quit {} {
4171         global ui_comm is_quitting repo_config commit_type
4172
4173         if {$is_quitting} return
4174         set is_quitting 1
4175
4176         if {[winfo exists $ui_comm]} {
4177                 # -- Stash our current commit buffer.
4178                 #
4179                 set save [gitdir GITGUI_MSG]
4180                 set msg [string trim [$ui_comm get 0.0 end]]
4181                 regsub -all -line {[ \r\t]+$} $msg {} msg
4182                 if {(![string match amend* $commit_type]
4183                         || [$ui_comm edit modified])
4184                         && $msg ne {}} {
4185                         catch {
4186                                 set fd [open $save w]
4187                                 puts -nonewline $fd $msg
4188                                 close $fd
4189                         }
4190                 } else {
4191                         catch {file delete $save}
4192                 }
4193
4194                 # -- Stash our current window geometry into this repository.
4195                 #
4196                 set cfg_geometry [list]
4197                 lappend cfg_geometry [wm geometry .]
4198                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4199                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4200                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4201                         set rc_geometry {}
4202                 }
4203                 if {$cfg_geometry ne $rc_geometry} {
4204                         catch {git config gui.geometry $cfg_geometry}
4205                 }
4206         }
4207
4208         destroy .
4209 }
4210
4211 proc do_rescan {} {
4212         rescan {set ui_status_value {Ready.}}
4213 }
4214
4215 proc unstage_helper {txt paths} {
4216         global file_states current_diff_path
4217
4218         if {![lock_index begin-update]} return
4219
4220         set pathList [list]
4221         set after {}
4222         foreach path $paths {
4223                 switch -glob -- [lindex $file_states($path) 0] {
4224                 A? -
4225                 M? -
4226                 D? {
4227                         lappend pathList $path
4228                         if {$path eq $current_diff_path} {
4229                                 set after {reshow_diff;}
4230                         }
4231                 }
4232                 }
4233         }
4234         if {$pathList eq {}} {
4235                 unlock_index
4236         } else {
4237                 update_indexinfo \
4238                         $txt \
4239                         $pathList \
4240                         [concat $after {set ui_status_value {Ready.}}]
4241         }
4242 }
4243
4244 proc do_unstage_selection {} {
4245         global current_diff_path selected_paths
4246
4247         if {[array size selected_paths] > 0} {
4248                 unstage_helper \
4249                         {Unstaging selected files from commit} \
4250                         [array names selected_paths]
4251         } elseif {$current_diff_path ne {}} {
4252                 unstage_helper \
4253                         "Unstaging [short_path $current_diff_path] from commit" \
4254                         [list $current_diff_path]
4255         }
4256 }
4257
4258 proc add_helper {txt paths} {
4259         global file_states current_diff_path
4260
4261         if {![lock_index begin-update]} return
4262
4263         set pathList [list]
4264         set after {}
4265         foreach path $paths {
4266                 switch -glob -- [lindex $file_states($path) 0] {
4267                 _O -
4268                 ?M -
4269                 ?D -
4270                 U? {
4271                         lappend pathList $path
4272                         if {$path eq $current_diff_path} {
4273                                 set after {reshow_diff;}
4274                         }
4275                 }
4276                 }
4277         }
4278         if {$pathList eq {}} {
4279                 unlock_index
4280         } else {
4281                 update_index \
4282                         $txt \
4283                         $pathList \
4284                         [concat $after {set ui_status_value {Ready to commit.}}]
4285         }
4286 }
4287
4288 proc do_add_selection {} {
4289         global current_diff_path selected_paths
4290
4291         if {[array size selected_paths] > 0} {
4292                 add_helper \
4293                         {Adding selected files} \
4294                         [array names selected_paths]
4295         } elseif {$current_diff_path ne {}} {
4296                 add_helper \
4297                         "Adding [short_path $current_diff_path]" \
4298                         [list $current_diff_path]
4299         }
4300 }
4301
4302 proc do_add_all {} {
4303         global file_states
4304
4305         set paths [list]
4306         foreach path [array names file_states] {
4307                 switch -glob -- [lindex $file_states($path) 0] {
4308                 U? {continue}
4309                 ?M -
4310                 ?D {lappend paths $path}
4311                 }
4312         }
4313         add_helper {Adding all changed files} $paths
4314 }
4315
4316 proc revert_helper {txt paths} {
4317         global file_states current_diff_path
4318
4319         if {![lock_index begin-update]} return
4320
4321         set pathList [list]
4322         set after {}
4323         foreach path $paths {
4324                 switch -glob -- [lindex $file_states($path) 0] {
4325                 U? {continue}
4326                 ?M -
4327                 ?D {
4328                         lappend pathList $path
4329                         if {$path eq $current_diff_path} {
4330                                 set after {reshow_diff;}
4331                         }
4332                 }
4333                 }
4334         }
4335
4336         set n [llength $pathList]
4337         if {$n == 0} {
4338                 unlock_index
4339                 return
4340         } elseif {$n == 1} {
4341                 set s "[short_path [lindex $pathList]]"
4342         } else {
4343                 set s "these $n files"
4344         }
4345
4346         set reply [tk_dialog \
4347                 .confirm_revert \
4348                 "[appname] ([reponame])" \
4349                 "Revert changes in $s?
4350
4351 Any unadded changes will be permanently lost by the revert." \
4352                 question \
4353                 1 \
4354                 {Do Nothing} \
4355                 {Revert Changes} \
4356                 ]
4357         if {$reply == 1} {
4358                 checkout_index \
4359                         $txt \
4360                         $pathList \
4361                         [concat $after {set ui_status_value {Ready.}}]
4362         } else {
4363                 unlock_index
4364         }
4365 }
4366
4367 proc do_revert_selection {} {
4368         global current_diff_path selected_paths
4369
4370         if {[array size selected_paths] > 0} {
4371                 revert_helper \
4372                         {Reverting selected files} \
4373                         [array names selected_paths]
4374         } elseif {$current_diff_path ne {}} {
4375                 revert_helper \
4376                         "Reverting [short_path $current_diff_path]" \
4377                         [list $current_diff_path]
4378         }
4379 }
4380
4381 proc do_signoff {} {
4382         global ui_comm
4383
4384         set me [committer_ident]
4385         if {$me eq {}} return
4386
4387         set sob "Signed-off-by: $me"
4388         set last [$ui_comm get {end -1c linestart} {end -1c}]
4389         if {$last ne $sob} {
4390                 $ui_comm edit separator
4391                 if {$last ne {}
4392                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4393                         $ui_comm insert end "\n"
4394                 }
4395                 $ui_comm insert end "\n$sob"
4396                 $ui_comm edit separator
4397                 $ui_comm see end
4398         }
4399 }
4400
4401 proc do_select_commit_type {} {
4402         global commit_type selected_commit_type
4403
4404         if {$selected_commit_type eq {new}
4405                 && [string match amend* $commit_type]} {
4406                 create_new_commit
4407         } elseif {$selected_commit_type eq {amend}
4408                 && ![string match amend* $commit_type]} {
4409                 load_last_commit
4410
4411                 # The amend request was rejected...
4412                 #
4413                 if {![string match amend* $commit_type]} {
4414                         set selected_commit_type new
4415                 }
4416         }
4417 }
4418
4419 proc do_commit {} {
4420         commit_tree
4421 }
4422
4423 proc do_about {} {
4424         global appvers copyright
4425         global tcl_patchLevel tk_patchLevel
4426
4427         set w .about_dialog
4428         toplevel $w
4429         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4430
4431         label $w.header -text "About [appname]" \
4432                 -font font_uibold
4433         pack $w.header -side top -fill x
4434
4435         frame $w.buttons
4436         button $w.buttons.close -text {Close} \
4437                 -font font_ui \
4438                 -command [list destroy $w]
4439         pack $w.buttons.close -side right
4440         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4441
4442         label $w.desc \
4443                 -text "[appname] - a commit creation tool for Git.
4444 $copyright" \
4445                 -padx 5 -pady 5 \
4446                 -justify left \
4447                 -anchor w \
4448                 -borderwidth 1 \
4449                 -relief solid \
4450                 -font font_ui
4451         pack $w.desc -side top -fill x -padx 5 -pady 5
4452
4453         set v {}
4454         append v "[appname] version $appvers\n"
4455         append v "[git version]\n"
4456         append v "\n"
4457         if {$tcl_patchLevel eq $tk_patchLevel} {
4458                 append v "Tcl/Tk version $tcl_patchLevel"
4459         } else {
4460                 append v "Tcl version $tcl_patchLevel"
4461                 append v ", Tk version $tk_patchLevel"
4462         }
4463
4464         label $w.vers \
4465                 -text $v \
4466                 -padx 5 -pady 5 \
4467                 -justify left \
4468                 -anchor w \
4469                 -borderwidth 1 \
4470                 -relief solid \
4471                 -font font_ui
4472         pack $w.vers -side top -fill x -padx 5 -pady 5
4473
4474         menu $w.ctxm -tearoff 0
4475         $w.ctxm add command \
4476                 -label {Copy} \
4477                 -font font_ui \
4478                 -command "
4479                 clipboard clear
4480                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4481         "
4482
4483         bind $w <Visibility> "grab $w; focus $w"
4484         bind $w <Key-Escape> "destroy $w"
4485         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4486         wm title $w "About [appname]"
4487         tkwait window $w
4488 }
4489
4490 proc do_options {} {
4491         global repo_config global_config font_descs
4492         global repo_config_new global_config_new
4493
4494         array unset repo_config_new
4495         array unset global_config_new
4496         foreach name [array names repo_config] {
4497                 set repo_config_new($name) $repo_config($name)
4498         }
4499         load_config 1
4500         foreach name [array names repo_config] {
4501                 switch -- $name {
4502                 gui.diffcontext {continue}
4503                 }
4504                 set repo_config_new($name) $repo_config($name)
4505         }
4506         foreach name [array names global_config] {
4507                 set global_config_new($name) $global_config($name)
4508         }
4509
4510         set w .options_editor
4511         toplevel $w
4512         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4513
4514         label $w.header -text "[appname] Options" \
4515                 -font font_uibold
4516         pack $w.header -side top -fill x
4517
4518         frame $w.buttons
4519         button $w.buttons.restore -text {Restore Defaults} \
4520                 -font font_ui \
4521                 -command do_restore_defaults
4522         pack $w.buttons.restore -side left
4523         button $w.buttons.save -text Save \
4524                 -font font_ui \
4525                 -command [list do_save_config $w]
4526         pack $w.buttons.save -side right
4527         button $w.buttons.cancel -text {Cancel} \
4528                 -font font_ui \
4529                 -command [list destroy $w]
4530         pack $w.buttons.cancel -side right -padx 5
4531         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4532
4533         labelframe $w.repo -text "[reponame] Repository" \
4534                 -font font_ui
4535         labelframe $w.global -text {Global (All Repositories)} \
4536                 -font font_ui
4537         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4538         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4539
4540         set optid 0
4541         foreach option {
4542                 {t user.name {User Name}}
4543                 {t user.email {Email Address}}
4544
4545                 {b merge.summary {Summarize Merge Commits}}
4546                 {i-1..5 merge.verbosity {Merge Verbosity}}
4547
4548                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4549                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4550                 {t gui.newbranchtemplate {New Branch Name Template}}
4551                 } {
4552                 set type [lindex $option 0]
4553                 set name [lindex $option 1]
4554                 set text [lindex $option 2]
4555                 incr optid
4556                 foreach f {repo global} {
4557                         switch -glob -- $type {
4558                         b {
4559                                 checkbutton $w.$f.$optid -text $text \
4560                                         -variable ${f}_config_new($name) \
4561                                         -onvalue true \
4562                                         -offvalue false \
4563                                         -font font_ui
4564                                 pack $w.$f.$optid -side top -anchor w
4565                         }
4566                         i-* {
4567                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4568                                 frame $w.$f.$optid
4569                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4570                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4571                                 spinbox $w.$f.$optid.v \
4572                                         -textvariable ${f}_config_new($name) \
4573                                         -from $min \
4574                                         -to $max \
4575                                         -increment 1 \
4576                                         -width [expr {1 + [string length $max]}] \
4577                                         -font font_ui
4578                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4579                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4580                                 pack $w.$f.$optid -side top -anchor w -fill x
4581                         }
4582                         t {
4583                                 frame $w.$f.$optid
4584                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4585                                 entry $w.$f.$optid.v \
4586                                         -borderwidth 1 \
4587                                         -relief sunken \
4588                                         -width 20 \
4589                                         -textvariable ${f}_config_new($name) \
4590                                         -font font_ui
4591                                 pack $w.$f.$optid.l -side left -anchor w
4592                                 pack $w.$f.$optid.v -side left -anchor w \
4593                                         -fill x -expand 1 \
4594                                         -padx 5
4595                                 pack $w.$f.$optid -side top -anchor w -fill x
4596                         }
4597                         }
4598                 }
4599         }
4600
4601         set all_fonts [lsort [font families]]
4602         foreach option $font_descs {
4603                 set name [lindex $option 0]
4604                 set font [lindex $option 1]
4605                 set text [lindex $option 2]
4606
4607                 set global_config_new(gui.$font^^family) \
4608                         [font configure $font -family]
4609                 set global_config_new(gui.$font^^size) \
4610                         [font configure $font -size]
4611
4612                 frame $w.global.$name
4613                 label $w.global.$name.l -text "$text:" -font font_ui
4614                 pack $w.global.$name.l -side left -anchor w -fill x
4615                 eval tk_optionMenu $w.global.$name.family \
4616                         global_config_new(gui.$font^^family) \
4617                         $all_fonts
4618                 spinbox $w.global.$name.size \
4619                         -textvariable global_config_new(gui.$font^^size) \
4620                         -from 2 -to 80 -increment 1 \
4621                         -width 3 \
4622                         -font font_ui
4623                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4624                 pack $w.global.$name.size -side right -anchor e
4625                 pack $w.global.$name.family -side right -anchor e
4626                 pack $w.global.$name -side top -anchor w -fill x
4627         }
4628
4629         bind $w <Visibility> "grab $w; focus $w"
4630         bind $w <Key-Escape> "destroy $w"
4631         wm title $w "[appname] ([reponame]): Options"
4632         tkwait window $w
4633 }
4634
4635 proc do_restore_defaults {} {
4636         global font_descs default_config repo_config
4637         global repo_config_new global_config_new
4638
4639         foreach name [array names default_config] {
4640                 set repo_config_new($name) $default_config($name)
4641                 set global_config_new($name) $default_config($name)
4642         }
4643
4644         foreach option $font_descs {
4645                 set name [lindex $option 0]
4646                 set repo_config(gui.$name) $default_config(gui.$name)
4647         }
4648         apply_config
4649
4650         foreach option $font_descs {
4651                 set name [lindex $option 0]
4652                 set font [lindex $option 1]
4653                 set global_config_new(gui.$font^^family) \
4654                         [font configure $font -family]
4655                 set global_config_new(gui.$font^^size) \
4656                         [font configure $font -size]
4657         }
4658 }
4659
4660 proc do_save_config {w} {
4661         if {[catch {save_config} err]} {
4662                 error_popup "Failed to completely save options:\n\n$err"
4663         }
4664         reshow_diff
4665         destroy $w
4666 }
4667
4668 proc do_windows_shortcut {} {
4669         global argv0
4670
4671         set fn [tk_getSaveFile \
4672                 -parent . \
4673                 -title "[appname] ([reponame]): Create Desktop Icon" \
4674                 -initialfile "Git [reponame].bat"]
4675         if {$fn != {}} {
4676                 if {[catch {
4677                                 set fd [open $fn w]
4678                                 puts $fd "@ECHO Entering [reponame]"
4679                                 puts $fd "@ECHO Starting git-gui... please wait..."
4680                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4681                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4682                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4683                                 puts $fd " \"[file normalize $argv0]\""
4684                                 close $fd
4685                         } err]} {
4686                         error_popup "Cannot write script:\n\n$err"
4687                 }
4688         }
4689 }
4690
4691 proc do_cygwin_shortcut {} {
4692         global argv0
4693
4694         if {[catch {
4695                 set desktop [exec cygpath \
4696                         --windows \
4697                         --absolute \
4698                         --long-name \
4699                         --desktop]
4700                 }]} {
4701                         set desktop .
4702         }
4703         set fn [tk_getSaveFile \
4704                 -parent . \
4705                 -title "[appname] ([reponame]): Create Desktop Icon" \
4706                 -initialdir $desktop \
4707                 -initialfile "Git [reponame].bat"]
4708         if {$fn != {}} {
4709                 if {[catch {
4710                                 set fd [open $fn w]
4711                                 set sh [exec cygpath \
4712                                         --windows \
4713                                         --absolute \
4714                                         /bin/sh]
4715                                 set me [exec cygpath \
4716                                         --unix \
4717                                         --absolute \
4718                                         $argv0]
4719                                 set gd [exec cygpath \
4720                                         --unix \
4721                                         --absolute \
4722                                         [gitdir]]
4723                                 set gw [exec cygpath \
4724                                         --windows \
4725                                         --absolute \
4726                                         [file dirname [gitdir]]]
4727                                 regsub -all ' $me "'\\''" me
4728                                 regsub -all ' $gd "'\\''" gd
4729                                 puts $fd "@ECHO Entering $gw"
4730                                 puts $fd "@ECHO Starting git-gui... please wait..."
4731                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4732                                 puts -nonewline $fd "GIT_DIR='$gd'"
4733                                 puts -nonewline $fd " '$me'"
4734                                 puts $fd "&\""
4735                                 close $fd
4736                         } err]} {
4737                         error_popup "Cannot write script:\n\n$err"
4738                 }
4739         }
4740 }
4741
4742 proc do_macosx_app {} {
4743         global argv0 env
4744
4745         set fn [tk_getSaveFile \
4746                 -parent . \
4747                 -title "[appname] ([reponame]): Create Desktop Icon" \
4748                 -initialdir [file join $env(HOME) Desktop] \
4749                 -initialfile "Git [reponame].app"]
4750         if {$fn != {}} {
4751                 if {[catch {
4752                                 set Contents [file join $fn Contents]
4753                                 set MacOS [file join $Contents MacOS]
4754                                 set exe [file join $MacOS git-gui]
4755
4756                                 file mkdir $MacOS
4757
4758                                 set fd [open [file join $Contents Info.plist] w]
4759                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4760 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4761 <plist version="1.0">
4762 <dict>
4763         <key>CFBundleDevelopmentRegion</key>
4764         <string>English</string>
4765         <key>CFBundleExecutable</key>
4766         <string>git-gui</string>
4767         <key>CFBundleIdentifier</key>
4768         <string>org.spearce.git-gui</string>
4769         <key>CFBundleInfoDictionaryVersion</key>
4770         <string>6.0</string>
4771         <key>CFBundlePackageType</key>
4772         <string>APPL</string>
4773         <key>CFBundleSignature</key>
4774         <string>????</string>
4775         <key>CFBundleVersion</key>
4776         <string>1.0</string>
4777         <key>NSPrincipalClass</key>
4778         <string>NSApplication</string>
4779 </dict>
4780 </plist>}
4781                                 close $fd
4782
4783                                 set fd [open $exe w]
4784                                 set gd [file normalize [gitdir]]
4785                                 set ep [file normalize [gitexec]]
4786                                 regsub -all ' $gd "'\\''" gd
4787                                 regsub -all ' $ep "'\\''" ep
4788                                 puts $fd "#!/bin/sh"
4789                                 foreach name [array names env] {
4790                                         if {[string match GIT_* $name]} {
4791                                                 regsub -all ' $env($name) "'\\''" v
4792                                                 puts $fd "export $name='$v'"
4793                                         }
4794                                 }
4795                                 puts $fd "export PATH='$ep':\$PATH"
4796                                 puts $fd "export GIT_DIR='$gd'"
4797                                 puts $fd "exec [file normalize $argv0]"
4798                                 close $fd
4799
4800                                 file attributes $exe -permissions u+x,g+x,o+x
4801                         } err]} {
4802                         error_popup "Cannot write icon:\n\n$err"
4803                 }
4804         }
4805 }
4806
4807 proc toggle_or_diff {w x y} {
4808         global file_states file_lists current_diff_path ui_index ui_workdir
4809         global last_clicked selected_paths
4810
4811         set pos [split [$w index @$x,$y] .]
4812         set lno [lindex $pos 0]
4813         set col [lindex $pos 1]
4814         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4815         if {$path eq {}} {
4816                 set last_clicked {}
4817                 return
4818         }
4819
4820         set last_clicked [list $w $lno]
4821         array unset selected_paths
4822         $ui_index tag remove in_sel 0.0 end
4823         $ui_workdir tag remove in_sel 0.0 end
4824
4825         if {$col == 0} {
4826                 if {$current_diff_path eq $path} {
4827                         set after {reshow_diff;}
4828                 } else {
4829                         set after {}
4830                 }
4831                 if {$w eq $ui_index} {
4832                         update_indexinfo \
4833                                 "Unstaging [short_path $path] from commit" \
4834                                 [list $path] \
4835                                 [concat $after {set ui_status_value {Ready.}}]
4836                 } elseif {$w eq $ui_workdir} {
4837                         update_index \
4838                                 "Adding [short_path $path]" \
4839                                 [list $path] \
4840                                 [concat $after {set ui_status_value {Ready.}}]
4841                 }
4842         } else {
4843                 show_diff $path $w $lno
4844         }
4845 }
4846
4847 proc add_one_to_selection {w x y} {
4848         global file_lists last_clicked selected_paths
4849
4850         set lno [lindex [split [$w index @$x,$y] .] 0]
4851         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4852         if {$path eq {}} {
4853                 set last_clicked {}
4854                 return
4855         }
4856
4857         if {$last_clicked ne {}
4858                 && [lindex $last_clicked 0] ne $w} {
4859                 array unset selected_paths
4860                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4861         }
4862
4863         set last_clicked [list $w $lno]
4864         if {[catch {set in_sel $selected_paths($path)}]} {
4865                 set in_sel 0
4866         }
4867         if {$in_sel} {
4868                 unset selected_paths($path)
4869                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4870         } else {
4871                 set selected_paths($path) 1
4872                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4873         }
4874 }
4875
4876 proc add_range_to_selection {w x y} {
4877         global file_lists last_clicked selected_paths
4878
4879         if {[lindex $last_clicked 0] ne $w} {
4880                 toggle_or_diff $w $x $y
4881                 return
4882         }
4883
4884         set lno [lindex [split [$w index @$x,$y] .] 0]
4885         set lc [lindex $last_clicked 1]
4886         if {$lc < $lno} {
4887                 set begin $lc
4888                 set end $lno
4889         } else {
4890                 set begin $lno
4891                 set end $lc
4892         }
4893
4894         foreach path [lrange $file_lists($w) \
4895                 [expr {$begin - 1}] \
4896                 [expr {$end - 1}]] {
4897                 set selected_paths($path) 1
4898         }
4899         $w tag add in_sel $begin.0 [expr {$end + 1}].0
4900 }
4901
4902 ######################################################################
4903 ##
4904 ## config defaults
4905
4906 set cursor_ptr arrow
4907 font create font_diff -family Courier -size 10
4908 font create font_ui
4909 catch {
4910         label .dummy
4911         eval font configure font_ui [font actual [.dummy cget -font]]
4912         destroy .dummy
4913 }
4914
4915 font create font_uibold
4916 font create font_diffbold
4917
4918 if {[is_Windows]} {
4919         set M1B Control
4920         set M1T Ctrl
4921 } elseif {[is_MacOSX]} {
4922         set M1B M1
4923         set M1T Cmd
4924 } else {
4925         set M1B M1
4926         set M1T M1
4927 }
4928
4929 proc apply_config {} {
4930         global repo_config font_descs
4931
4932         foreach option $font_descs {
4933                 set name [lindex $option 0]
4934                 set font [lindex $option 1]
4935                 if {[catch {
4936                         foreach {cn cv} $repo_config(gui.$name) {
4937                                 font configure $font $cn $cv
4938                         }
4939                         } err]} {
4940                         error_popup "Invalid font specified in gui.$name:\n\n$err"
4941                 }
4942                 foreach {cn cv} [font configure $font] {
4943                         font configure ${font}bold $cn $cv
4944                 }
4945                 font configure ${font}bold -weight bold
4946         }
4947 }
4948
4949 set default_config(merge.summary) false
4950 set default_config(merge.verbosity) 2
4951 set default_config(user.name) {}
4952 set default_config(user.email) {}
4953
4954 set default_config(gui.trustmtime) false
4955 set default_config(gui.diffcontext) 5
4956 set default_config(gui.newbranchtemplate) {}
4957 set default_config(gui.fontui) [font configure font_ui]
4958 set default_config(gui.fontdiff) [font configure font_diff]
4959 set font_descs {
4960         {fontui   font_ui   {Main Font}}
4961         {fontdiff font_diff {Diff/Console Font}}
4962 }
4963 load_config 0
4964 apply_config
4965
4966 ######################################################################
4967 ##
4968 ## feature option selection
4969
4970 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
4971         unset _junk
4972 } else {
4973         set subcommand gui
4974 }
4975 if {$subcommand eq {gui.sh}} {
4976         set subcommand gui
4977 }
4978 if {$subcommand eq {gui} && [llength $argv] > 0} {
4979         set subcommand [lindex $argv 0]
4980         set argv [lrange $argv 1 end]
4981 }
4982
4983 enable_option multicommit
4984 enable_option branch
4985 enable_option transport
4986
4987 switch -- $subcommand {
4988 blame {
4989         disable_option multicommit
4990         disable_option branch
4991         disable_option transport
4992 }
4993 citool {
4994         enable_option singlecommit
4995
4996         disable_option multicommit
4997         disable_option branch
4998         disable_option transport
4999 }
5000 }
5001
5002 ######################################################################
5003 ##
5004 ## ui construction
5005
5006 set ui_comm {}
5007
5008 # -- Menu Bar
5009 #
5010 menu .mbar -tearoff 0
5011 .mbar add cascade -label Repository -menu .mbar.repository
5012 .mbar add cascade -label Edit -menu .mbar.edit
5013 if {[is_enabled branch]} {
5014         .mbar add cascade -label Branch -menu .mbar.branch
5015 }
5016 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5017         .mbar add cascade -label Commit -menu .mbar.commit
5018 }
5019 if {[is_enabled transport]} {
5020         .mbar add cascade -label Merge -menu .mbar.merge
5021         .mbar add cascade -label Fetch -menu .mbar.fetch
5022         .mbar add cascade -label Push -menu .mbar.push
5023 }
5024 . configure -menu .mbar
5025
5026 # -- Repository Menu
5027 #
5028 menu .mbar.repository
5029
5030 .mbar.repository add command \
5031         -label {Browse Current Branch} \
5032         -command {new_browser $current_branch} \
5033         -font font_ui
5034 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5035 .mbar.repository add separator
5036
5037 .mbar.repository add command \
5038         -label {Visualize Current Branch} \
5039         -command {do_gitk $current_branch} \
5040         -font font_ui
5041 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5042 .mbar.repository add command \
5043         -label {Visualize All Branches} \
5044         -command {do_gitk --all} \
5045         -font font_ui
5046 .mbar.repository add separator
5047
5048 if {[is_enabled multicommit]} {
5049         .mbar.repository add command -label {Database Statistics} \
5050                 -command do_stats \
5051                 -font font_ui
5052
5053         .mbar.repository add command -label {Compress Database} \
5054                 -command do_gc \
5055                 -font font_ui
5056
5057         .mbar.repository add command -label {Verify Database} \
5058                 -command do_fsck_objects \
5059                 -font font_ui
5060
5061         .mbar.repository add separator
5062
5063         if {[is_Cygwin]} {
5064                 .mbar.repository add command \
5065                         -label {Create Desktop Icon} \
5066                         -command do_cygwin_shortcut \
5067                         -font font_ui
5068         } elseif {[is_Windows]} {
5069                 .mbar.repository add command \
5070                         -label {Create Desktop Icon} \
5071                         -command do_windows_shortcut \
5072                         -font font_ui
5073         } elseif {[is_MacOSX]} {
5074                 .mbar.repository add command \
5075                         -label {Create Desktop Icon} \
5076                         -command do_macosx_app \
5077                         -font font_ui
5078         }
5079 }
5080
5081 .mbar.repository add command -label Quit \
5082         -command do_quit \
5083         -accelerator $M1T-Q \
5084         -font font_ui
5085
5086 # -- Edit Menu
5087 #
5088 menu .mbar.edit
5089 .mbar.edit add command -label Undo \
5090         -command {catch {[focus] edit undo}} \
5091         -accelerator $M1T-Z \
5092         -font font_ui
5093 .mbar.edit add command -label Redo \
5094         -command {catch {[focus] edit redo}} \
5095         -accelerator $M1T-Y \
5096         -font font_ui
5097 .mbar.edit add separator
5098 .mbar.edit add command -label Cut \
5099         -command {catch {tk_textCut [focus]}} \
5100         -accelerator $M1T-X \
5101         -font font_ui
5102 .mbar.edit add command -label Copy \
5103         -command {catch {tk_textCopy [focus]}} \
5104         -accelerator $M1T-C \
5105         -font font_ui
5106 .mbar.edit add command -label Paste \
5107         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5108         -accelerator $M1T-V \
5109         -font font_ui
5110 .mbar.edit add command -label Delete \
5111         -command {catch {[focus] delete sel.first sel.last}} \
5112         -accelerator Del \
5113         -font font_ui
5114 .mbar.edit add separator
5115 .mbar.edit add command -label {Select All} \
5116         -command {catch {[focus] tag add sel 0.0 end}} \
5117         -accelerator $M1T-A \
5118         -font font_ui
5119
5120 # -- Branch Menu
5121 #
5122 if {[is_enabled branch]} {
5123         menu .mbar.branch
5124
5125         .mbar.branch add command -label {Create...} \
5126                 -command do_create_branch \
5127                 -accelerator $M1T-N \
5128                 -font font_ui
5129         lappend disable_on_lock [list .mbar.branch entryconf \
5130                 [.mbar.branch index last] -state]
5131
5132         .mbar.branch add command -label {Delete...} \
5133                 -command do_delete_branch \
5134                 -font font_ui
5135         lappend disable_on_lock [list .mbar.branch entryconf \
5136                 [.mbar.branch index last] -state]
5137 }
5138
5139 # -- Commit Menu
5140 #
5141 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5142         menu .mbar.commit
5143
5144         .mbar.commit add radiobutton \
5145                 -label {New Commit} \
5146                 -command do_select_commit_type \
5147                 -variable selected_commit_type \
5148                 -value new \
5149                 -font font_ui
5150         lappend disable_on_lock \
5151                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5152
5153         .mbar.commit add radiobutton \
5154                 -label {Amend Last Commit} \
5155                 -command do_select_commit_type \
5156                 -variable selected_commit_type \
5157                 -value amend \
5158                 -font font_ui
5159         lappend disable_on_lock \
5160                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5161
5162         .mbar.commit add separator
5163
5164         .mbar.commit add command -label Rescan \
5165                 -command do_rescan \
5166                 -accelerator F5 \
5167                 -font font_ui
5168         lappend disable_on_lock \
5169                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5170
5171         .mbar.commit add command -label {Add To Commit} \
5172                 -command do_add_selection \
5173                 -font font_ui
5174         lappend disable_on_lock \
5175                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5176
5177         .mbar.commit add command -label {Add Existing To Commit} \
5178                 -command do_add_all \
5179                 -accelerator $M1T-I \
5180                 -font font_ui
5181         lappend disable_on_lock \
5182                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5183
5184         .mbar.commit add command -label {Unstage From Commit} \
5185                 -command do_unstage_selection \
5186                 -font font_ui
5187         lappend disable_on_lock \
5188                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5189
5190         .mbar.commit add command -label {Revert Changes} \
5191                 -command do_revert_selection \
5192                 -font font_ui
5193         lappend disable_on_lock \
5194                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5195
5196         .mbar.commit add separator
5197
5198         .mbar.commit add command -label {Sign Off} \
5199                 -command do_signoff \
5200                 -accelerator $M1T-S \
5201                 -font font_ui
5202
5203         .mbar.commit add command -label Commit \
5204                 -command do_commit \
5205                 -accelerator $M1T-Return \
5206                 -font font_ui
5207         lappend disable_on_lock \
5208                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5209 }
5210
5211 if {[is_MacOSX]} {
5212         # -- Apple Menu (Mac OS X only)
5213         #
5214         .mbar add cascade -label Apple -menu .mbar.apple
5215         menu .mbar.apple
5216
5217         .mbar.apple add command -label "About [appname]" \
5218                 -command do_about \
5219                 -font font_ui
5220         .mbar.apple add command -label "[appname] Options..." \
5221                 -command do_options \
5222                 -font font_ui
5223 } else {
5224         # -- Edit Menu
5225         #
5226         .mbar.edit add separator
5227         .mbar.edit add command -label {Options...} \
5228                 -command do_options \
5229                 -font font_ui
5230
5231         # -- Tools Menu
5232         #
5233         if {[file exists /usr/local/miga/lib/gui-miga]
5234                 && [file exists .pvcsrc]} {
5235         proc do_miga {} {
5236                 global ui_status_value
5237                 if {![lock_index update]} return
5238                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5239                 set miga_fd [open "|$cmd" r]
5240                 fconfigure $miga_fd -blocking 0
5241                 fileevent $miga_fd readable [list miga_done $miga_fd]
5242                 set ui_status_value {Running miga...}
5243         }
5244         proc miga_done {fd} {
5245                 read $fd 512
5246                 if {[eof $fd]} {
5247                         close $fd
5248                         unlock_index
5249                         rescan [list set ui_status_value {Ready.}]
5250                 }
5251         }
5252         .mbar add cascade -label Tools -menu .mbar.tools
5253         menu .mbar.tools
5254         .mbar.tools add command -label "Migrate" \
5255                 -command do_miga \
5256                 -font font_ui
5257         lappend disable_on_lock \
5258                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5259         }
5260 }
5261
5262 # -- Help Menu
5263 #
5264 .mbar add cascade -label Help -menu .mbar.help
5265 menu .mbar.help
5266
5267 if {![is_MacOSX]} {
5268         .mbar.help add command -label "About [appname]" \
5269                 -command do_about \
5270                 -font font_ui
5271 }
5272
5273 set browser {}
5274 catch {set browser $repo_config(instaweb.browser)}
5275 set doc_path [file dirname [gitexec]]
5276 set doc_path [file join $doc_path Documentation index.html]
5277
5278 if {[is_Cygwin]} {
5279         set doc_path [exec cygpath --windows $doc_path]
5280 }
5281
5282 if {$browser eq {}} {
5283         if {[is_MacOSX]} {
5284                 set browser open
5285         } elseif {[is_Cygwin]} {
5286                 set program_files [file dirname [exec cygpath --windir]]
5287                 set program_files [file join $program_files {Program Files}]
5288                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5289                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5290                 if {[file exists $firefox]} {
5291                         set browser $firefox
5292                 } elseif {[file exists $ie]} {
5293                         set browser $ie
5294                 }
5295                 unset program_files firefox ie
5296         }
5297 }
5298
5299 if {[file isfile $doc_path]} {
5300         set doc_url "file:$doc_path"
5301 } else {
5302         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5303 }
5304
5305 if {$browser ne {}} {
5306         .mbar.help add command -label {Online Documentation} \
5307                 -command [list exec $browser $doc_url &] \
5308                 -font font_ui
5309 }
5310 unset browser doc_path doc_url
5311
5312 # -- Standard bindings
5313 #
5314 bind .   <Destroy> do_quit
5315 bind all <$M1B-Key-q> do_quit
5316 bind all <$M1B-Key-Q> do_quit
5317 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5318 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5319
5320 # -- Not a normal commit type invocation?  Do that instead!
5321 #
5322 switch -- $subcommand {
5323 blame {
5324         if {[llength $argv] != 2} {
5325                 puts stderr "usage: $argv0 blame commit path"
5326                 exit 1
5327         }
5328         set current_branch [lindex $argv 0]
5329         show_blame $current_branch [lindex $argv 1]
5330         return
5331 }
5332 citool -
5333 gui {
5334         if {[llength $argv] != 0} {
5335                 puts -nonewline stderr "usage: $argv0"
5336                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5337                         puts -nonewline stderr " $subcommand"
5338                 }
5339                 puts stderr {}
5340                 exit 1
5341         }
5342         # fall through to setup UI for commits
5343 }
5344 default {
5345         puts stderr "usage: $argv0 \[{blame|citool}\]"
5346         exit 1
5347 }
5348 }
5349
5350 # -- Branch Control
5351 #
5352 frame .branch \
5353         -borderwidth 1 \
5354         -relief sunken
5355 label .branch.l1 \
5356         -text {Current Branch:} \
5357         -anchor w \
5358         -justify left \
5359         -font font_ui
5360 label .branch.cb \
5361         -textvariable current_branch \
5362         -anchor w \
5363         -justify left \
5364         -font font_ui
5365 pack .branch.l1 -side left
5366 pack .branch.cb -side left -fill x
5367 pack .branch -side top -fill x
5368
5369 if {[is_enabled branch]} {
5370         menu .mbar.merge
5371         .mbar.merge add command -label {Local Merge...} \
5372                 -command do_local_merge \
5373                 -font font_ui
5374         lappend disable_on_lock \
5375                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5376         .mbar.merge add command -label {Abort Merge...} \
5377                 -command do_reset_hard \
5378                 -font font_ui
5379         lappend disable_on_lock \
5380                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5381
5382
5383         menu .mbar.fetch
5384
5385         menu .mbar.push
5386         .mbar.push add command -label {Push...} \
5387                 -command do_push_anywhere \
5388                 -font font_ui
5389 }
5390
5391 # -- Main Window Layout
5392 #
5393 panedwindow .vpane -orient vertical
5394 panedwindow .vpane.files -orient horizontal
5395 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5396 pack .vpane -anchor n -side top -fill both -expand 1
5397
5398 # -- Index File List
5399 #
5400 frame .vpane.files.index -height 100 -width 200
5401 label .vpane.files.index.title -text {Changes To Be Committed} \
5402         -background green \
5403         -font font_ui
5404 text $ui_index -background white -borderwidth 0 \
5405         -width 20 -height 10 \
5406         -wrap none \
5407         -font font_ui \
5408         -cursor $cursor_ptr \
5409         -xscrollcommand {.vpane.files.index.sx set} \
5410         -yscrollcommand {.vpane.files.index.sy set} \
5411         -state disabled
5412 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5413 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5414 pack .vpane.files.index.title -side top -fill x
5415 pack .vpane.files.index.sx -side bottom -fill x
5416 pack .vpane.files.index.sy -side right -fill y
5417 pack $ui_index -side left -fill both -expand 1
5418 .vpane.files add .vpane.files.index -sticky nsew
5419
5420 # -- Working Directory File List
5421 #
5422 frame .vpane.files.workdir -height 100 -width 200
5423 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5424         -background red \
5425         -font font_ui
5426 text $ui_workdir -background white -borderwidth 0 \
5427         -width 20 -height 10 \
5428         -wrap none \
5429         -font font_ui \
5430         -cursor $cursor_ptr \
5431         -xscrollcommand {.vpane.files.workdir.sx set} \
5432         -yscrollcommand {.vpane.files.workdir.sy set} \
5433         -state disabled
5434 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5435 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5436 pack .vpane.files.workdir.title -side top -fill x
5437 pack .vpane.files.workdir.sx -side bottom -fill x
5438 pack .vpane.files.workdir.sy -side right -fill y
5439 pack $ui_workdir -side left -fill both -expand 1
5440 .vpane.files add .vpane.files.workdir -sticky nsew
5441
5442 foreach i [list $ui_index $ui_workdir] {
5443         $i tag conf in_diff -font font_uibold
5444         $i tag conf in_sel \
5445                 -background [$i cget -foreground] \
5446                 -foreground [$i cget -background]
5447 }
5448 unset i
5449
5450 # -- Diff and Commit Area
5451 #
5452 frame .vpane.lower -height 300 -width 400
5453 frame .vpane.lower.commarea
5454 frame .vpane.lower.diff -relief sunken -borderwidth 1
5455 pack .vpane.lower.commarea -side top -fill x
5456 pack .vpane.lower.diff -side bottom -fill both -expand 1
5457 .vpane add .vpane.lower -sticky nsew
5458
5459 # -- Commit Area Buttons
5460 #
5461 frame .vpane.lower.commarea.buttons
5462 label .vpane.lower.commarea.buttons.l -text {} \
5463         -anchor w \
5464         -justify left \
5465         -font font_ui
5466 pack .vpane.lower.commarea.buttons.l -side top -fill x
5467 pack .vpane.lower.commarea.buttons -side left -fill y
5468
5469 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5470         -command do_rescan \
5471         -font font_ui
5472 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5473 lappend disable_on_lock \
5474         {.vpane.lower.commarea.buttons.rescan conf -state}
5475
5476 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5477         -command do_add_all \
5478         -font font_ui
5479 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5480 lappend disable_on_lock \
5481         {.vpane.lower.commarea.buttons.incall conf -state}
5482
5483 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5484         -command do_signoff \
5485         -font font_ui
5486 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5487
5488 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5489         -command do_commit \
5490         -font font_ui
5491 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5492 lappend disable_on_lock \
5493         {.vpane.lower.commarea.buttons.commit conf -state}
5494
5495 # -- Commit Message Buffer
5496 #
5497 frame .vpane.lower.commarea.buffer
5498 frame .vpane.lower.commarea.buffer.header
5499 set ui_comm .vpane.lower.commarea.buffer.t
5500 set ui_coml .vpane.lower.commarea.buffer.header.l
5501 radiobutton .vpane.lower.commarea.buffer.header.new \
5502         -text {New Commit} \
5503         -command do_select_commit_type \
5504         -variable selected_commit_type \
5505         -value new \
5506         -font font_ui
5507 lappend disable_on_lock \
5508         [list .vpane.lower.commarea.buffer.header.new conf -state]
5509 radiobutton .vpane.lower.commarea.buffer.header.amend \
5510         -text {Amend Last Commit} \
5511         -command do_select_commit_type \
5512         -variable selected_commit_type \
5513         -value amend \
5514         -font font_ui
5515 lappend disable_on_lock \
5516         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5517 label $ui_coml \
5518         -anchor w \
5519         -justify left \
5520         -font font_ui
5521 proc trace_commit_type {varname args} {
5522         global ui_coml commit_type
5523         switch -glob -- $commit_type {
5524         initial       {set txt {Initial Commit Message:}}
5525         amend         {set txt {Amended Commit Message:}}
5526         amend-initial {set txt {Amended Initial Commit Message:}}
5527         amend-merge   {set txt {Amended Merge Commit Message:}}
5528         merge         {set txt {Merge Commit Message:}}
5529         *             {set txt {Commit Message:}}
5530         }
5531         $ui_coml conf -text $txt
5532 }
5533 trace add variable commit_type write trace_commit_type
5534 pack $ui_coml -side left -fill x
5535 pack .vpane.lower.commarea.buffer.header.amend -side right
5536 pack .vpane.lower.commarea.buffer.header.new -side right
5537
5538 text $ui_comm -background white -borderwidth 1 \
5539         -undo true \
5540         -maxundo 20 \
5541         -autoseparators true \
5542         -relief sunken \
5543         -width 75 -height 9 -wrap none \
5544         -font font_diff \
5545         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5546 scrollbar .vpane.lower.commarea.buffer.sby \
5547         -command [list $ui_comm yview]
5548 pack .vpane.lower.commarea.buffer.header -side top -fill x
5549 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5550 pack $ui_comm -side left -fill y
5551 pack .vpane.lower.commarea.buffer -side left -fill y
5552
5553 # -- Commit Message Buffer Context Menu
5554 #
5555 set ctxm .vpane.lower.commarea.buffer.ctxm
5556 menu $ctxm -tearoff 0
5557 $ctxm add command \
5558         -label {Cut} \
5559         -font font_ui \
5560         -command {tk_textCut $ui_comm}
5561 $ctxm add command \
5562         -label {Copy} \
5563         -font font_ui \
5564         -command {tk_textCopy $ui_comm}
5565 $ctxm add command \
5566         -label {Paste} \
5567         -font font_ui \
5568         -command {tk_textPaste $ui_comm}
5569 $ctxm add command \
5570         -label {Delete} \
5571         -font font_ui \
5572         -command {$ui_comm delete sel.first sel.last}
5573 $ctxm add separator
5574 $ctxm add command \
5575         -label {Select All} \
5576         -font font_ui \
5577         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5578 $ctxm add command \
5579         -label {Copy All} \
5580         -font font_ui \
5581         -command {
5582                 $ui_comm tag add sel 0.0 end
5583                 tk_textCopy $ui_comm
5584                 $ui_comm tag remove sel 0.0 end
5585         }
5586 $ctxm add separator
5587 $ctxm add command \
5588         -label {Sign Off} \
5589         -font font_ui \
5590         -command do_signoff
5591 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5592
5593 # -- Diff Header
5594 #
5595 set current_diff_path {}
5596 set current_diff_side {}
5597 set diff_actions [list]
5598 proc trace_current_diff_path {varname args} {
5599         global current_diff_path diff_actions file_states
5600         if {$current_diff_path eq {}} {
5601                 set s {}
5602                 set f {}
5603                 set p {}
5604                 set o disabled
5605         } else {
5606                 set p $current_diff_path
5607                 set s [mapdesc [lindex $file_states($p) 0] $p]
5608                 set f {File:}
5609                 set p [escape_path $p]
5610                 set o normal
5611         }
5612
5613         .vpane.lower.diff.header.status configure -text $s
5614         .vpane.lower.diff.header.file configure -text $f
5615         .vpane.lower.diff.header.path configure -text $p
5616         foreach w $diff_actions {
5617                 uplevel #0 $w $o
5618         }
5619 }
5620 trace add variable current_diff_path write trace_current_diff_path
5621
5622 frame .vpane.lower.diff.header -background orange
5623 label .vpane.lower.diff.header.status \
5624         -background orange \
5625         -width $max_status_desc \
5626         -anchor w \
5627         -justify left \
5628         -font font_ui
5629 label .vpane.lower.diff.header.file \
5630         -background orange \
5631         -anchor w \
5632         -justify left \
5633         -font font_ui
5634 label .vpane.lower.diff.header.path \
5635         -background orange \
5636         -anchor w \
5637         -justify left \
5638         -font font_ui
5639 pack .vpane.lower.diff.header.status -side left
5640 pack .vpane.lower.diff.header.file -side left
5641 pack .vpane.lower.diff.header.path -fill x
5642 set ctxm .vpane.lower.diff.header.ctxm
5643 menu $ctxm -tearoff 0
5644 $ctxm add command \
5645         -label {Copy} \
5646         -font font_ui \
5647         -command {
5648                 clipboard clear
5649                 clipboard append \
5650                         -format STRING \
5651                         -type STRING \
5652                         -- $current_diff_path
5653         }
5654 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5655 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5656
5657 # -- Diff Body
5658 #
5659 frame .vpane.lower.diff.body
5660 set ui_diff .vpane.lower.diff.body.t
5661 text $ui_diff -background white -borderwidth 0 \
5662         -width 80 -height 15 -wrap none \
5663         -font font_diff \
5664         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5665         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5666         -state disabled
5667 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5668         -command [list $ui_diff xview]
5669 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5670         -command [list $ui_diff yview]
5671 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5672 pack .vpane.lower.diff.body.sby -side right -fill y
5673 pack $ui_diff -side left -fill both -expand 1
5674 pack .vpane.lower.diff.header -side top -fill x
5675 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5676
5677 $ui_diff tag conf d_cr -elide true
5678 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5679 $ui_diff tag conf d_+ -foreground {#00a000}
5680 $ui_diff tag conf d_- -foreground red
5681
5682 $ui_diff tag conf d_++ -foreground {#00a000}
5683 $ui_diff tag conf d_-- -foreground red
5684 $ui_diff tag conf d_+s \
5685         -foreground {#00a000} \
5686         -background {#e2effa}
5687 $ui_diff tag conf d_-s \
5688         -foreground red \
5689         -background {#e2effa}
5690 $ui_diff tag conf d_s+ \
5691         -foreground {#00a000} \
5692         -background ivory1
5693 $ui_diff tag conf d_s- \
5694         -foreground red \
5695         -background ivory1
5696
5697 $ui_diff tag conf d<<<<<<< \
5698         -foreground orange \
5699         -font font_diffbold
5700 $ui_diff tag conf d======= \
5701         -foreground orange \
5702         -font font_diffbold
5703 $ui_diff tag conf d>>>>>>> \
5704         -foreground orange \
5705         -font font_diffbold
5706
5707 $ui_diff tag raise sel
5708
5709 # -- Diff Body Context Menu
5710 #
5711 set ctxm .vpane.lower.diff.body.ctxm
5712 menu $ctxm -tearoff 0
5713 $ctxm add command \
5714         -label {Refresh} \
5715         -font font_ui \
5716         -command reshow_diff
5717 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5718 $ctxm add command \
5719         -label {Copy} \
5720         -font font_ui \
5721         -command {tk_textCopy $ui_diff}
5722 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5723 $ctxm add command \
5724         -label {Select All} \
5725         -font font_ui \
5726         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5727 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5728 $ctxm add command \
5729         -label {Copy All} \
5730         -font font_ui \
5731         -command {
5732                 $ui_diff tag add sel 0.0 end
5733                 tk_textCopy $ui_diff
5734                 $ui_diff tag remove sel 0.0 end
5735         }
5736 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5737 $ctxm add separator
5738 $ctxm add command \
5739         -label {Apply/Reverse Hunk} \
5740         -font font_ui \
5741         -command {apply_hunk $cursorX $cursorY}
5742 set ui_diff_applyhunk [$ctxm index last]
5743 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5744 $ctxm add separator
5745 $ctxm add command \
5746         -label {Decrease Font Size} \
5747         -font font_ui \
5748         -command {incr_font_size font_diff -1}
5749 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5750 $ctxm add command \
5751         -label {Increase Font Size} \
5752         -font font_ui \
5753         -command {incr_font_size font_diff 1}
5754 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5755 $ctxm add separator
5756 $ctxm add command \
5757         -label {Show Less Context} \
5758         -font font_ui \
5759         -command {if {$repo_config(gui.diffcontext) >= 2} {
5760                 incr repo_config(gui.diffcontext) -1
5761                 reshow_diff
5762         }}
5763 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5764 $ctxm add command \
5765         -label {Show More Context} \
5766         -font font_ui \
5767         -command {
5768                 incr repo_config(gui.diffcontext)
5769                 reshow_diff
5770         }
5771 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5772 $ctxm add separator
5773 $ctxm add command -label {Options...} \
5774         -font font_ui \
5775         -command do_options
5776 bind_button3 $ui_diff "
5777         set cursorX %x
5778         set cursorY %y
5779         if {\$ui_index eq \$current_diff_side} {
5780                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5781         } else {
5782                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5783         }
5784         tk_popup $ctxm %X %Y
5785 "
5786 unset ui_diff_applyhunk
5787
5788 # -- Status Bar
5789 #
5790 set ui_status_value {Initializing...}
5791 label .status -textvariable ui_status_value \
5792         -anchor w \
5793         -justify left \
5794         -borderwidth 1 \
5795         -relief sunken \
5796         -font font_ui
5797 pack .status -anchor w -side bottom -fill x
5798
5799 # -- Load geometry
5800 #
5801 catch {
5802 set gm $repo_config(gui.geometry)
5803 wm geometry . [lindex $gm 0]
5804 .vpane sash place 0 \
5805         [lindex [.vpane sash coord 0] 0] \
5806         [lindex $gm 1]
5807 .vpane.files sash place 0 \
5808         [lindex $gm 2] \
5809         [lindex [.vpane.files sash coord 0] 1]
5810 unset gm
5811 }
5812
5813 # -- Key Bindings
5814 #
5815 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5816 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5817 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5818 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5819 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5820 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5821 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5822 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5823 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5824 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5825 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5826
5827 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5828 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5829 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5830 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5831 bind $ui_diff <$M1B-Key-v> {break}
5832 bind $ui_diff <$M1B-Key-V> {break}
5833 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5834 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5835 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5836 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5837 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5838 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5839 bind $ui_diff <Button-1>   {focus %W}
5840
5841 if {[is_enabled branch]} {
5842         bind . <$M1B-Key-n> do_create_branch
5843         bind . <$M1B-Key-N> do_create_branch
5844 }
5845
5846 bind all <Key-F5> do_rescan
5847 bind all <$M1B-Key-r> do_rescan
5848 bind all <$M1B-Key-R> do_rescan
5849 bind .   <$M1B-Key-s> do_signoff
5850 bind .   <$M1B-Key-S> do_signoff
5851 bind .   <$M1B-Key-i> do_add_all
5852 bind .   <$M1B-Key-I> do_add_all
5853 bind .   <$M1B-Key-Return> do_commit
5854 foreach i [list $ui_index $ui_workdir] {
5855         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5856         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5857         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5858 }
5859 unset i
5860
5861 set file_lists($ui_index) [list]
5862 set file_lists($ui_workdir) [list]
5863
5864 set HEAD {}
5865 set PARENT {}
5866 set MERGE_HEAD [list]
5867 set commit_type {}
5868 set empty_tree {}
5869 set current_branch {}
5870 set current_diff_path {}
5871 set selected_commit_type new
5872
5873 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5874 focus -force $ui_comm
5875
5876 # -- Warn the user about environmental problems.  Cygwin's Tcl
5877 #    does *not* pass its env array onto any processes it spawns.
5878 #    This means that git processes get none of our environment.
5879 #
5880 if {[is_Cygwin]} {
5881         set ignored_env 0
5882         set suggest_user {}
5883         set msg "Possible environment issues exist.
5884
5885 The following environment variables are probably
5886 going to be ignored by any Git subprocess run
5887 by [appname]:
5888
5889 "
5890         foreach name [array names env] {
5891                 switch -regexp -- $name {
5892                 {^GIT_INDEX_FILE$} -
5893                 {^GIT_OBJECT_DIRECTORY$} -
5894                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5895                 {^GIT_DIFF_OPTS$} -
5896                 {^GIT_EXTERNAL_DIFF$} -
5897                 {^GIT_PAGER$} -
5898                 {^GIT_TRACE$} -
5899                 {^GIT_CONFIG$} -
5900                 {^GIT_CONFIG_LOCAL$} -
5901                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5902                         append msg " - $name\n"
5903                         incr ignored_env
5904                 }
5905                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5906                         append msg " - $name\n"
5907                         incr ignored_env
5908                         set suggest_user $name
5909                 }
5910                 }
5911         }
5912         if {$ignored_env > 0} {
5913                 append msg "
5914 This is due to a known issue with the
5915 Tcl binary distributed by Cygwin."
5916
5917                 if {$suggest_user ne {}} {
5918                         append msg "
5919
5920 A good replacement for $suggest_user
5921 is placing values for the user.name and
5922 user.email settings into your personal
5923 ~/.gitconfig file.
5924 "
5925                 }
5926                 warn_popup $msg
5927         }
5928         unset ignored_env msg suggest_user name
5929 }
5930
5931 # -- Only initialize complex UI if we are going to stay running.
5932 #
5933 if {[is_enabled transport]} {
5934         load_all_remotes
5935         load_all_heads
5936
5937         populate_branch_menu
5938         populate_fetch_menu
5939         populate_push_menu
5940 }
5941
5942 # -- Only suggest a gc run if we are going to stay running.
5943 #
5944 if {[is_enabled multicommit]} {
5945         set object_limit 2000
5946         if {[is_Windows]} {set object_limit 200}
5947         regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
5948         if {$objects_current >= $object_limit} {
5949                 if {[ask_popup \
5950                         "This repository currently has $objects_current loose objects.
5951
5952 To maintain optimal performance it is strongly
5953 recommended that you compress the database
5954 when more than $object_limit loose objects exist.
5955
5956 Compress the database now?"] eq yes} {
5957                         do_gc
5958                 }
5959         }
5960         unset object_limit _junk objects_current
5961 }
5962
5963 lock_index begin-read
5964 after 1 do_rescan