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