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