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