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