git-gui.sh

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