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