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