87fdce593d6b48c36f4c7b5ba5ee9b4728314e76
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5set appvers {@@GIT_VERSION@@}
   6set copyright {
   7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9This program is free software; you can redistribute it and/or modify
  10it under the terms of the GNU General Public License as published by
  11the Free Software Foundation; either version 2 of the License, or
  12(at your option) any later version.
  13
  14This program is distributed in the hope that it will be useful,
  15but WITHOUT ANY WARRANTY; without even the implied warranty of
  16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17GNU General Public License for more details.
  18
  19You should have received a copy of the GNU General Public License
  20along with this program; if not, write to the Free Software
  21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23######################################################################
  24##
  25## read only globals
  26
  27set _appname [lindex [file split $argv0] end]
  28set _gitdir {}
  29set _reponame {}
  30
  31proc appname {} {
  32        global _appname
  33        return $_appname
  34}
  35
  36proc gitdir {args} {
  37        global _gitdir
  38        if {$args eq {}} {
  39                return $_gitdir
  40        }
  41        return [eval [concat [list file join $_gitdir] $args]]
  42}
  43
  44proc reponame {} {
  45        global _reponame
  46        return $_reponame
  47}
  48
  49######################################################################
  50##
  51## config
  52
  53proc is_many_config {name} {
  54        switch -glob -- $name {
  55        remote.*.fetch -
  56        remote.*.push
  57                {return 1}
  58        *
  59                {return 0}
  60        }
  61}
  62
  63proc load_config {include_global} {
  64        global repo_config global_config default_config
  65
  66        array unset global_config
  67        if {$include_global} {
  68                catch {
  69                        set fd_rc [open "| git repo-config --global --list" r]
  70                        while {[gets $fd_rc line] >= 0} {
  71                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  72                                        if {[is_many_config $name]} {
  73                                                lappend global_config($name) $value
  74                                        } else {
  75                                                set global_config($name) $value
  76                                        }
  77                                }
  78                        }
  79                        close $fd_rc
  80                }
  81        }
  82
  83        array unset repo_config
  84        catch {
  85                set fd_rc [open "| git repo-config --list" r]
  86                while {[gets $fd_rc line] >= 0} {
  87                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  88                                if {[is_many_config $name]} {
  89                                        lappend repo_config($name) $value
  90                                } else {
  91                                        set repo_config($name) $value
  92                                }
  93                        }
  94                }
  95                close $fd_rc
  96        }
  97
  98        foreach name [array names default_config] {
  99                if {[catch {set v $global_config($name)}]} {
 100                        set global_config($name) $default_config($name)
 101                }
 102                if {[catch {set v $repo_config($name)}]} {
 103                        set repo_config($name) $default_config($name)
 104                }
 105        }
 106}
 107
 108proc save_config {} {
 109        global default_config font_descs
 110        global repo_config global_config
 111        global repo_config_new global_config_new
 112
 113        foreach option $font_descs {
 114                set name [lindex $option 0]
 115                set font [lindex $option 1]
 116                font configure $font \
 117                        -family $global_config_new(gui.$font^^family) \
 118                        -size $global_config_new(gui.$font^^size)
 119                font configure ${font}bold \
 120                        -family $global_config_new(gui.$font^^family) \
 121                        -size $global_config_new(gui.$font^^size)
 122                set global_config_new(gui.$name) [font configure $font]
 123                unset global_config_new(gui.$font^^family)
 124                unset global_config_new(gui.$font^^size)
 125        }
 126
 127        foreach name [array names default_config] {
 128                set value $global_config_new($name)
 129                if {$value ne $global_config($name)} {
 130                        if {$value eq $default_config($name)} {
 131                                catch {exec git repo-config --global --unset $name}
 132                        } else {
 133                                regsub -all "\[{}\]" $value {"} value
 134                                exec git repo-config --global $name $value
 135                        }
 136                        set global_config($name) $value
 137                        if {$value eq $repo_config($name)} {
 138                                catch {exec git repo-config --unset $name}
 139                                set repo_config($name) $value
 140                        }
 141                }
 142        }
 143
 144        foreach name [array names default_config] {
 145                set value $repo_config_new($name)
 146                if {$value ne $repo_config($name)} {
 147                        if {$value eq $global_config($name)} {
 148                                catch {exec git repo-config --unset $name}
 149                        } else {
 150                                regsub -all "\[{}\]" $value {"} value
 151                                exec git repo-config $name $value
 152                        }
 153                        set repo_config($name) $value
 154                }
 155        }
 156}
 157
 158proc error_popup {msg} {
 159        set title [appname]
 160        if {[reponame] ne {}} {
 161                append title " ([reponame])"
 162        }
 163        set cmd [list tk_messageBox \
 164                -icon error \
 165                -type ok \
 166                -title "$title: error" \
 167                -message $msg]
 168        if {[winfo ismapped .]} {
 169                lappend cmd -parent .
 170        }
 171        eval $cmd
 172}
 173
 174proc warn_popup {msg} {
 175        set title [appname]
 176        if {[reponame] ne {}} {
 177                append title " ([reponame])"
 178        }
 179        set cmd [list tk_messageBox \
 180                -icon warning \
 181                -type ok \
 182                -title "$title: warning" \
 183                -message $msg]
 184        if {[winfo ismapped .]} {
 185                lappend cmd -parent .
 186        }
 187        eval $cmd
 188}
 189
 190proc info_popup {msg} {
 191        set title [appname]
 192        if {[reponame] ne {}} {
 193                append title " ([reponame])"
 194        }
 195        tk_messageBox \
 196                -parent . \
 197                -icon info \
 198                -type ok \
 199                -title $title \
 200                -message $msg
 201}
 202
 203proc ask_popup {msg} {
 204        set title [appname]
 205        if {[reponame] ne {}} {
 206                append title " ([reponame])"
 207        }
 208        return [tk_messageBox \
 209                -parent . \
 210                -icon question \
 211                -type yesno \
 212                -title $title \
 213                -message $msg]
 214}
 215
 216######################################################################
 217##
 218## repository setup
 219
 220if {   [catch {set _gitdir $env(GIT_DIR)}]
 221        && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 222        catch {wm withdraw .}
 223        error_popup "Cannot find the git directory:\n\n$err"
 224        exit 1
 225}
 226if {![file isdirectory $_gitdir]} {
 227        catch {wm withdraw .}
 228        error_popup "Git directory not found:\n\n$_gitdir"
 229        exit 1
 230}
 231if {[lindex [file split $_gitdir] end] ne {.git}} {
 232        catch {wm withdraw .}
 233        error_popup "Cannot use funny .git directory:\n\n$gitdir"
 234        exit 1
 235}
 236if {[catch {cd [file dirname $_gitdir]} err]} {
 237        catch {wm withdraw .}
 238        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 239        exit 1
 240}
 241set _reponame [lindex [file split \
 242        [file normalize [file dirname $_gitdir]]] \
 243        end]
 244
 245set single_commit 0
 246if {[appname] eq {git-citool}} {
 247        set single_commit 1
 248}
 249
 250######################################################################
 251##
 252## task management
 253
 254set rescan_active 0
 255set diff_active 0
 256set last_clicked {}
 257
 258set disable_on_lock [list]
 259set index_lock_type none
 260
 261proc lock_index {type} {
 262        global index_lock_type disable_on_lock
 263
 264        if {$index_lock_type eq {none}} {
 265                set index_lock_type $type
 266                foreach w $disable_on_lock {
 267                        uplevel #0 $w disabled
 268                }
 269                return 1
 270        } elseif {$index_lock_type eq "begin-$type"} {
 271                set index_lock_type $type
 272                return 1
 273        }
 274        return 0
 275}
 276
 277proc unlock_index {} {
 278        global index_lock_type disable_on_lock
 279
 280        set index_lock_type none
 281        foreach w $disable_on_lock {
 282                uplevel #0 $w normal
 283        }
 284}
 285
 286######################################################################
 287##
 288## status
 289
 290proc repository_state {ctvar hdvar mhvar} {
 291        global current_branch
 292        upvar $ctvar ct $hdvar hd $mhvar mh
 293
 294        set mh [list]
 295
 296        if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 297                set current_branch {}
 298        } else {
 299                regsub ^refs/((heads|tags|remotes)/)? \
 300                        $current_branch \
 301                        {} \
 302                        current_branch
 303        }
 304
 305        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 306                set hd {}
 307                set ct initial
 308                return
 309        }
 310
 311        set merge_head [gitdir MERGE_HEAD]
 312        if {[file exists $merge_head]} {
 313                set ct merge
 314                set fd_mh [open $merge_head r]
 315                while {[gets $fd_mh line] >= 0} {
 316                        lappend mh $line
 317                }
 318                close $fd_mh
 319                return
 320        }
 321
 322        set ct normal
 323}
 324
 325proc PARENT {} {
 326        global PARENT empty_tree
 327
 328        set p [lindex $PARENT 0]
 329        if {$p ne {}} {
 330                return $p
 331        }
 332        if {$empty_tree eq {}} {
 333                set empty_tree [exec git mktree << {}]
 334        }
 335        return $empty_tree
 336}
 337
 338proc rescan {after} {
 339        global HEAD PARENT MERGE_HEAD commit_type
 340        global ui_index ui_workdir ui_status_value ui_comm
 341        global rescan_active file_states
 342        global repo_config
 343
 344        if {$rescan_active > 0 || ![lock_index read]} return
 345
 346        repository_state newType newHEAD newMERGE_HEAD
 347        if {[string match amend* $commit_type]
 348                && $newType eq {normal}
 349                && $newHEAD eq $HEAD} {
 350        } else {
 351                set HEAD $newHEAD
 352                set PARENT $newHEAD
 353                set MERGE_HEAD $newMERGE_HEAD
 354                set commit_type $newType
 355        }
 356
 357        array unset file_states
 358
 359        if {![$ui_comm edit modified]
 360                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 361                if {[load_message GITGUI_MSG]} {
 362                } elseif {[load_message MERGE_MSG]} {
 363                } elseif {[load_message SQUASH_MSG]} {
 364                }
 365                $ui_comm edit reset
 366                $ui_comm edit modified false
 367        }
 368
 369        if {$repo_config(gui.trustmtime) eq {true}} {
 370                rescan_stage2 {} $after
 371        } else {
 372                set rescan_active 1
 373                set ui_status_value {Refreshing file status...}
 374                set cmd [list git update-index]
 375                lappend cmd -q
 376                lappend cmd --unmerged
 377                lappend cmd --ignore-missing
 378                lappend cmd --refresh
 379                set fd_rf [open "| $cmd" r]
 380                fconfigure $fd_rf -blocking 0 -translation binary
 381                fileevent $fd_rf readable \
 382                        [list rescan_stage2 $fd_rf $after]
 383        }
 384}
 385
 386proc rescan_stage2 {fd after} {
 387        global ui_status_value
 388        global rescan_active buf_rdi buf_rdf buf_rlo
 389
 390        if {$fd ne {}} {
 391                read $fd
 392                if {![eof $fd]} return
 393                close $fd
 394        }
 395
 396        set ls_others [list | git ls-files --others -z \
 397                --exclude-per-directory=.gitignore]
 398        set info_exclude [gitdir info exclude]
 399        if {[file readable $info_exclude]} {
 400                lappend ls_others "--exclude-from=$info_exclude"
 401        }
 402
 403        set buf_rdi {}
 404        set buf_rdf {}
 405        set buf_rlo {}
 406
 407        set rescan_active 3
 408        set ui_status_value {Scanning for modified files ...}
 409        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 410        set fd_df [open "| git diff-files -z" r]
 411        set fd_lo [open $ls_others r]
 412
 413        fconfigure $fd_di -blocking 0 -translation binary
 414        fconfigure $fd_df -blocking 0 -translation binary
 415        fconfigure $fd_lo -blocking 0 -translation binary
 416        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 417        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 418        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 419}
 420
 421proc load_message {file} {
 422        global ui_comm
 423
 424        set f [gitdir $file]
 425        if {[file isfile $f]} {
 426                if {[catch {set fd [open $f r]}]} {
 427                        return 0
 428                }
 429                set content [string trim [read $fd]]
 430                close $fd
 431                $ui_comm delete 0.0 end
 432                $ui_comm insert end $content
 433                return 1
 434        }
 435        return 0
 436}
 437
 438proc read_diff_index {fd after} {
 439        global buf_rdi
 440
 441        append buf_rdi [read $fd]
 442        set c 0
 443        set n [string length $buf_rdi]
 444        while {$c < $n} {
 445                set z1 [string first "\0" $buf_rdi $c]
 446                if {$z1 == -1} break
 447                incr z1
 448                set z2 [string first "\0" $buf_rdi $z1]
 449                if {$z2 == -1} break
 450
 451                incr c
 452                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 453                merge_state \
 454                        [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 455                        [lindex $i 4]? \
 456                        [list [lindex $i 0] [lindex $i 2]] \
 457                        [list]
 458                set c $z2
 459                incr c
 460        }
 461        if {$c < $n} {
 462                set buf_rdi [string range $buf_rdi $c end]
 463        } else {
 464                set buf_rdi {}
 465        }
 466
 467        rescan_done $fd buf_rdi $after
 468}
 469
 470proc read_diff_files {fd after} {
 471        global buf_rdf
 472
 473        append buf_rdf [read $fd]
 474        set c 0
 475        set n [string length $buf_rdf]
 476        while {$c < $n} {
 477                set z1 [string first "\0" $buf_rdf $c]
 478                if {$z1 == -1} break
 479                incr z1
 480                set z2 [string first "\0" $buf_rdf $z1]
 481                if {$z2 == -1} break
 482
 483                incr c
 484                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 485                merge_state \
 486                        [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 487                        ?[lindex $i 4] \
 488                        [list] \
 489                        [list [lindex $i 0] [lindex $i 2]]
 490                set c $z2
 491                incr c
 492        }
 493        if {$c < $n} {
 494                set buf_rdf [string range $buf_rdf $c end]
 495        } else {
 496                set buf_rdf {}
 497        }
 498
 499        rescan_done $fd buf_rdf $after
 500}
 501
 502proc read_ls_others {fd after} {
 503        global buf_rlo
 504
 505        append buf_rlo [read $fd]
 506        set pck [split $buf_rlo "\0"]
 507        set buf_rlo [lindex $pck end]
 508        foreach p [lrange $pck 0 end-1] {
 509                merge_state $p ?O
 510        }
 511        rescan_done $fd buf_rlo $after
 512}
 513
 514proc rescan_done {fd buf after} {
 515        global rescan_active
 516        global file_states repo_config
 517        upvar $buf to_clear
 518
 519        if {![eof $fd]} return
 520        set to_clear {}
 521        close $fd
 522        if {[incr rescan_active -1] > 0} return
 523
 524        prune_selection
 525        unlock_index
 526        display_all_files
 527        reshow_diff
 528        uplevel #0 $after
 529}
 530
 531proc prune_selection {} {
 532        global file_states selected_paths
 533
 534        foreach path [array names selected_paths] {
 535                if {[catch {set still_here $file_states($path)}]} {
 536                        unset selected_paths($path)
 537                }
 538        }
 539}
 540
 541######################################################################
 542##
 543## diff
 544
 545proc clear_diff {} {
 546        global ui_diff current_diff_path ui_index ui_workdir
 547
 548        $ui_diff conf -state normal
 549        $ui_diff delete 0.0 end
 550        $ui_diff conf -state disabled
 551
 552        set current_diff_path {}
 553
 554        $ui_index tag remove in_diff 0.0 end
 555        $ui_workdir tag remove in_diff 0.0 end
 556}
 557
 558proc reshow_diff {} {
 559        global ui_status_value file_states file_lists
 560        global current_diff_path current_diff_side
 561
 562        set p $current_diff_path
 563        if {$p eq {}
 564                || $current_diff_side eq {}
 565                || [catch {set s $file_states($p)}]
 566                || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
 567                clear_diff
 568        } else {
 569                show_diff $p $current_diff_side
 570        }
 571}
 572
 573proc handle_empty_diff {} {
 574        global current_diff_path file_states file_lists
 575
 576        set path $current_diff_path
 577        set s $file_states($path)
 578        if {[lindex $s 0] ne {_M}} return
 579
 580        info_popup "No differences detected.
 581
 582[short_path $path] has no changes.
 583
 584The modification date of this file was updated
 585by another application and you currently have
 586the Trust File Modification Timestamps option
 587enabled, so Git did not automatically detect
 588that there are no content differences in this
 589file.
 590
 591This file will now be removed from the modified
 592files list, to prevent possible confusion.
 593"
 594        if {[catch {exec git update-index -- $path} err]} {
 595                error_popup "Failed to refresh index:\n\n$err"
 596        }
 597
 598        clear_diff
 599        display_file $path __
 600}
 601
 602proc show_diff {path w {lno {}}} {
 603        global file_states file_lists
 604        global is_3way_diff diff_active repo_config
 605        global ui_diff ui_status_value ui_index ui_workdir
 606        global current_diff_path current_diff_side
 607
 608        if {$diff_active || ![lock_index read]} return
 609
 610        clear_diff
 611        if {$w eq {} || $lno == {}} {
 612                foreach w [array names file_lists] {
 613                        set lno [lsearch -sorted $file_lists($w) $path]
 614                        if {$lno >= 0} {
 615                                incr lno
 616                                break
 617                        }
 618                }
 619        }
 620        if {$w ne {} && $lno >= 1} {
 621                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 622        }
 623
 624        set s $file_states($path)
 625        set m [lindex $s 0]
 626        set is_3way_diff 0
 627        set diff_active 1
 628        set current_diff_path $path
 629        set current_diff_side $w
 630        set ui_status_value "Loading diff of [escape_path $path]..."
 631
 632        # - Git won't give us the diff, there's nothing to compare to!
 633        #
 634        if {$m eq {_O}} {
 635                if {[catch {
 636                                set fd [open $path r]
 637                                set content [read $fd]
 638                                close $fd
 639                        } err ]} {
 640                        set diff_active 0
 641                        unlock_index
 642                        set ui_status_value "Unable to display [escape_path $path]"
 643                        error_popup "Error loading file:\n\n$err"
 644                        return
 645                }
 646                $ui_diff conf -state normal
 647                $ui_diff insert end $content
 648                $ui_diff conf -state disabled
 649                set diff_active 0
 650                unlock_index
 651                set ui_status_value {Ready.}
 652                return
 653        }
 654
 655        set cmd [list | git]
 656        if {$w eq $ui_index} {
 657                lappend cmd diff-index
 658                lappend cmd --cached
 659        } elseif {$w eq $ui_workdir} {
 660                if {[string index $m 0] eq {U}} {
 661                        lappend cmd diff
 662                } else {
 663                        lappend cmd diff-files
 664                }
 665        }
 666
 667        lappend cmd -p
 668        lappend cmd --no-color
 669        if {$repo_config(gui.diffcontext) > 0} {
 670                lappend cmd "-U$repo_config(gui.diffcontext)"
 671        }
 672        if {$w eq $ui_index} {
 673                lappend cmd [PARENT]
 674        }
 675        lappend cmd --
 676        lappend cmd $path
 677
 678        if {[catch {set fd [open $cmd r]} err]} {
 679                set diff_active 0
 680                unlock_index
 681                set ui_status_value "Unable to display [escape_path $path]"
 682                error_popup "Error loading diff:\n\n$err"
 683                return
 684        }
 685
 686        fconfigure $fd -blocking 0 -translation auto
 687        fileevent $fd readable [list read_diff $fd]
 688}
 689
 690proc read_diff {fd} {
 691        global ui_diff ui_status_value is_3way_diff diff_active
 692        global repo_config
 693
 694        $ui_diff conf -state normal
 695        while {[gets $fd line] >= 0} {
 696                # -- Cleanup uninteresting diff header lines.
 697                #
 698                if {[string match {diff --git *}      $line]} continue
 699                if {[string match {diff --cc *}       $line]} continue
 700                if {[string match {diff --combined *} $line]} continue
 701                if {[string match {--- *}             $line]} continue
 702                if {[string match {+++ *}             $line]} continue
 703                if {$line eq {deleted file mode 120000}} {
 704                        set line "deleted symlink"
 705                }
 706
 707                # -- Automatically detect if this is a 3 way diff.
 708                #
 709                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 710
 711                if {[string match {index *} $line]
 712                        || [regexp {^\* Unmerged path } $line]} {
 713                        set tags {}
 714                } elseif {$is_3way_diff} {
 715                        set op [string range $line 0 1]
 716                        switch -- $op {
 717                        {  } {set tags {}}
 718                        {@@} {set tags d_@}
 719                        { +} {set tags d_s+}
 720                        { -} {set tags d_s-}
 721                        {+ } {set tags d_+s}
 722                        {- } {set tags d_-s}
 723                        {--} {set tags d_--}
 724                        {++} {
 725                                if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 726                                        set line [string replace $line 0 1 {  }]
 727                                        set tags d$op
 728                                } else {
 729                                        set tags d_++
 730                                }
 731                        }
 732                        default {
 733                                puts "error: Unhandled 3 way diff marker: {$op}"
 734                                set tags {}
 735                        }
 736                        }
 737                } else {
 738                        set op [string index $line 0]
 739                        switch -- $op {
 740                        { } {set tags {}}
 741                        {@} {set tags d_@}
 742                        {-} {set tags d_-}
 743                        {+} {
 744                                if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 745                                        set line [string replace $line 0 0 { }]
 746                                        set tags d$op
 747                                } else {
 748                                        set tags d_+
 749                                }
 750                        }
 751                        default {
 752                                puts "error: Unhandled 2 way diff marker: {$op}"
 753                                set tags {}
 754                        }
 755                        }
 756                }
 757                $ui_diff insert end $line $tags
 758                $ui_diff insert end "\n" $tags
 759        }
 760        $ui_diff conf -state disabled
 761
 762        if {[eof $fd]} {
 763                close $fd
 764                set diff_active 0
 765                unlock_index
 766                set ui_status_value {Ready.}
 767
 768                if {$repo_config(gui.trustmtime) eq {true}
 769                        && [$ui_diff index end] eq {2.0}} {
 770                        handle_empty_diff
 771                }
 772        }
 773}
 774
 775######################################################################
 776##
 777## commit
 778
 779proc load_last_commit {} {
 780        global HEAD PARENT MERGE_HEAD commit_type ui_comm
 781
 782        if {[llength $PARENT] == 0} {
 783                error_popup {There is nothing to amend.
 784
 785You are about to create the initial commit.
 786There is no commit before this to amend.
 787}
 788                return
 789        }
 790
 791        repository_state curType curHEAD curMERGE_HEAD
 792        if {$curType eq {merge}} {
 793                error_popup {Cannot amend while merging.
 794
 795You are currently in the middle of a merge that
 796has not been fully completed.  You cannot amend
 797the prior commit unless you first abort the
 798current merge activity.
 799}
 800                return
 801        }
 802
 803        set msg {}
 804        set parents [list]
 805        if {[catch {
 806                        set fd [open "| git cat-file commit $curHEAD" r]
 807                        while {[gets $fd line] > 0} {
 808                                if {[string match {parent *} $line]} {
 809                                        lappend parents [string range $line 7 end]
 810                                }
 811                        }
 812                        set msg [string trim [read $fd]]
 813                        close $fd
 814                } err]} {
 815                error_popup "Error loading commit data for amend:\n\n$err"
 816                return
 817        }
 818
 819        set HEAD $curHEAD
 820        set PARENT $parents
 821        set MERGE_HEAD [list]
 822        switch -- [llength $parents] {
 823        0       {set commit_type amend-initial}
 824        1       {set commit_type amend}
 825        default {set commit_type amend-merge}
 826        }
 827
 828        $ui_comm delete 0.0 end
 829        $ui_comm insert end $msg
 830        $ui_comm edit reset
 831        $ui_comm edit modified false
 832        rescan {set ui_status_value {Ready.}}
 833}
 834
 835proc create_new_commit {} {
 836        global commit_type ui_comm
 837
 838        set commit_type normal
 839        $ui_comm delete 0.0 end
 840        $ui_comm edit reset
 841        $ui_comm edit modified false
 842        rescan {set ui_status_value {Ready.}}
 843}
 844
 845set GIT_COMMITTER_IDENT {}
 846
 847proc committer_ident {} {
 848        global GIT_COMMITTER_IDENT
 849
 850        if {$GIT_COMMITTER_IDENT eq {}} {
 851                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 852                        error_popup "Unable to obtain your identity:\n\n$err"
 853                        return {}
 854                }
 855                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 856                        $me me GIT_COMMITTER_IDENT]} {
 857                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 858                        return {}
 859                }
 860        }
 861
 862        return $GIT_COMMITTER_IDENT
 863}
 864
 865proc commit_tree {} {
 866        global HEAD commit_type file_states ui_comm repo_config
 867        global ui_status_value pch_error
 868
 869        if {![lock_index update]} return
 870        if {[committer_ident] eq {}} return
 871
 872        # -- Our in memory state should match the repository.
 873        #
 874        repository_state curType curHEAD curMERGE_HEAD
 875        if {[string match amend* $commit_type]
 876                && $curType eq {normal}
 877                && $curHEAD eq $HEAD} {
 878        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 879                info_popup {Last scanned state does not match repository state.
 880
 881Another Git program has modified this repository
 882since the last scan.  A rescan must be performed
 883before another commit can be created.
 884
 885The rescan will be automatically started now.
 886}
 887                unlock_index
 888                rescan {set ui_status_value {Ready.}}
 889                return
 890        }
 891
 892        # -- At least one file should differ in the index.
 893        #
 894        set files_ready 0
 895        foreach path [array names file_states] {
 896                switch -glob -- [lindex $file_states($path) 0] {
 897                _? {continue}
 898                A? -
 899                D? -
 900                M? {set files_ready 1}
 901                U? {
 902                        error_popup "Unmerged files cannot be committed.
 903
 904File [short_path $path] has merge conflicts.
 905You must resolve them and add the file before committing.
 906"
 907                        unlock_index
 908                        return
 909                }
 910                default {
 911                        error_popup "Unknown file state [lindex $s 0] detected.
 912
 913File [short_path $path] cannot be committed by this program.
 914"
 915                }
 916                }
 917        }
 918        if {!$files_ready} {
 919                info_popup {No changes to commit.
 920
 921You must add at least 1 file before you can commit.
 922}
 923                unlock_index
 924                return
 925        }
 926
 927        # -- A message is required.
 928        #
 929        set msg [string trim [$ui_comm get 1.0 end]]
 930        if {$msg eq {}} {
 931                error_popup {Please supply a commit message.
 932
 933A good commit message has the following format:
 934
 935- First line: Describe in one sentance what you did.
 936- Second line: Blank
 937- Remaining lines: Describe why this change is good.
 938}
 939                unlock_index
 940                return
 941        }
 942
 943        # -- Run the pre-commit hook.
 944        #
 945        set pchook [gitdir hooks pre-commit]
 946
 947        # On Cygwin [file executable] might lie so we need to ask
 948        # the shell if the hook is executable.  Yes that's annoying.
 949        #
 950        if {[is_Windows] && [file isfile $pchook]} {
 951                set pchook [list sh -c [concat \
 952                        "if test -x \"$pchook\";" \
 953                        "then exec \"$pchook\" 2>&1;" \
 954                        "fi"]]
 955        } elseif {[file executable $pchook]} {
 956                set pchook [list $pchook |& cat]
 957        } else {
 958                commit_writetree $curHEAD $msg
 959                return
 960        }
 961
 962        set ui_status_value {Calling pre-commit hook...}
 963        set pch_error {}
 964        set fd_ph [open "| $pchook" r]
 965        fconfigure $fd_ph -blocking 0 -translation binary
 966        fileevent $fd_ph readable \
 967                [list commit_prehook_wait $fd_ph $curHEAD $msg]
 968}
 969
 970proc commit_prehook_wait {fd_ph curHEAD msg} {
 971        global pch_error ui_status_value
 972
 973        append pch_error [read $fd_ph]
 974        fconfigure $fd_ph -blocking 1
 975        if {[eof $fd_ph]} {
 976                if {[catch {close $fd_ph}]} {
 977                        set ui_status_value {Commit declined by pre-commit hook.}
 978                        hook_failed_popup pre-commit $pch_error
 979                        unlock_index
 980                } else {
 981                        commit_writetree $curHEAD $msg
 982                }
 983                set pch_error {}
 984                return
 985        }
 986        fconfigure $fd_ph -blocking 0
 987}
 988
 989proc commit_writetree {curHEAD msg} {
 990        global ui_status_value
 991
 992        set ui_status_value {Committing changes...}
 993        set fd_wt [open "| git write-tree" r]
 994        fileevent $fd_wt readable \
 995                [list commit_committree $fd_wt $curHEAD $msg]
 996}
 997
 998proc commit_committree {fd_wt curHEAD msg} {
 999        global HEAD PARENT MERGE_HEAD commit_type
1000        global single_commit
1001        global ui_status_value ui_comm selected_commit_type
1002        global file_states selected_paths rescan_active
1003
1004        gets $fd_wt tree_id
1005        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1006                error_popup "write-tree failed:\n\n$err"
1007                set ui_status_value {Commit failed.}
1008                unlock_index
1009                return
1010        }
1011
1012        # -- Create the commit.
1013        #
1014        set cmd [list git commit-tree $tree_id]
1015        set parents [concat $PARENT $MERGE_HEAD]
1016        if {[llength $parents] > 0} {
1017                foreach p $parents {
1018                        lappend cmd -p $p
1019                }
1020        } else {
1021                # git commit-tree writes to stderr during initial commit.
1022                lappend cmd 2>/dev/null
1023        }
1024        lappend cmd << $msg
1025        if {[catch {set cmt_id [eval exec $cmd]} err]} {
1026                error_popup "commit-tree failed:\n\n$err"
1027                set ui_status_value {Commit failed.}
1028                unlock_index
1029                return
1030        }
1031
1032        # -- Update the HEAD ref.
1033        #
1034        set reflogm commit
1035        if {$commit_type ne {normal}} {
1036                append reflogm " ($commit_type)"
1037        }
1038        set i [string first "\n" $msg]
1039        if {$i >= 0} {
1040                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1041        } else {
1042                append reflogm {: } $msg
1043        }
1044        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1045        if {[catch {eval exec $cmd} err]} {
1046                error_popup "update-ref failed:\n\n$err"
1047                set ui_status_value {Commit failed.}
1048                unlock_index
1049                return
1050        }
1051
1052        # -- Cleanup after ourselves.
1053        #
1054        catch {file delete [gitdir MERGE_HEAD]}
1055        catch {file delete [gitdir MERGE_MSG]}
1056        catch {file delete [gitdir SQUASH_MSG]}
1057        catch {file delete [gitdir GITGUI_MSG]}
1058
1059        # -- Let rerere do its thing.
1060        #
1061        if {[file isdirectory [gitdir rr-cache]]} {
1062                catch {exec git rerere}
1063        }
1064
1065        # -- Run the post-commit hook.
1066        #
1067        set pchook [gitdir hooks post-commit]
1068        if {[is_Windows] && [file isfile $pchook]} {
1069                set pchook [list sh -c [concat \
1070                        "if test -x \"$pchook\";" \
1071                        "then exec \"$pchook\";" \
1072                        "fi"]]
1073        } elseif {![file executable $pchook]} {
1074                set pchook {}
1075        }
1076        if {$pchook ne {}} {
1077                catch {exec $pchook &}
1078        }
1079
1080        $ui_comm delete 0.0 end
1081        $ui_comm edit reset
1082        $ui_comm edit modified false
1083
1084        if {$single_commit} do_quit
1085
1086        # -- Update in memory status
1087        #
1088        set selected_commit_type new
1089        set commit_type normal
1090        set HEAD $cmt_id
1091        set PARENT $cmt_id
1092        set MERGE_HEAD [list]
1093
1094        foreach path [array names file_states] {
1095                set s $file_states($path)
1096                set m [lindex $s 0]
1097                switch -glob -- $m {
1098                _O -
1099                _M -
1100                _D {continue}
1101                __ -
1102                A_ -
1103                M_ -
1104                D_ {
1105                        unset file_states($path)
1106                        catch {unset selected_paths($path)}
1107                }
1108                DO {
1109                        set file_states($path) [list _O [lindex $s 1] {} {}]
1110                }
1111                AM -
1112                AD -
1113                MM -
1114                MD {
1115                        set file_states($path) [list \
1116                                _[string index $m 1] \
1117                                [lindex $s 1] \
1118                                [lindex $s 3] \
1119                                {}]
1120                }
1121                }
1122        }
1123
1124        display_all_files
1125        unlock_index
1126        reshow_diff
1127        set ui_status_value \
1128                "Changes committed as [string range $cmt_id 0 7]."
1129}
1130
1131######################################################################
1132##
1133## fetch pull push
1134
1135proc fetch_from {remote} {
1136        set w [new_console "fetch $remote" \
1137                "Fetching new changes from $remote"]
1138        set cmd [list git fetch]
1139        lappend cmd $remote
1140        console_exec $w $cmd
1141}
1142
1143proc pull_remote {remote branch} {
1144        global HEAD commit_type file_states repo_config
1145
1146        if {![lock_index update]} return
1147
1148        # -- Our in memory state should match the repository.
1149        #
1150        repository_state curType curHEAD curMERGE_HEAD
1151        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1152                info_popup {Last scanned state does not match repository state.
1153
1154Another Git program has modified this repository
1155since the last scan.  A rescan must be performed
1156before a pull operation can be started.
1157
1158The rescan will be automatically started now.
1159}
1160                unlock_index
1161                rescan {set ui_status_value {Ready.}}
1162                return
1163        }
1164
1165        # -- No differences should exist before a pull.
1166        #
1167        if {[array size file_states] != 0} {
1168                error_popup {Uncommitted but modified files are present.
1169
1170You should not perform a pull with unmodified
1171files in your working directory as Git will be
1172unable to recover from an incorrect merge.
1173
1174You should commit or revert all changes before
1175starting a pull operation.
1176}
1177                unlock_index
1178                return
1179        }
1180
1181        set w [new_console "pull $remote $branch" \
1182                "Pulling new changes from branch $branch in $remote"]
1183        set cmd [list git pull]
1184        if {$repo_config(gui.pullsummary) eq {false}} {
1185                lappend cmd --no-summary
1186        }
1187        lappend cmd $remote
1188        lappend cmd $branch
1189        console_exec $w $cmd [list post_pull_remote $remote $branch]
1190}
1191
1192proc post_pull_remote {remote branch success} {
1193        global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1194        global ui_status_value
1195
1196        unlock_index
1197        if {$success} {
1198                repository_state commit_type HEAD MERGE_HEAD
1199                set PARENT $HEAD
1200                set selected_commit_type new
1201                set ui_status_value "Pulling $branch from $remote complete."
1202        } else {
1203                rescan [list set ui_status_value \
1204                        "Conflicts detected while pulling $branch from $remote."]
1205        }
1206}
1207
1208proc push_to {remote} {
1209        set w [new_console "push $remote" \
1210                "Pushing changes to $remote"]
1211        set cmd [list git push]
1212        lappend cmd $remote
1213        console_exec $w $cmd
1214}
1215
1216######################################################################
1217##
1218## ui helpers
1219
1220proc mapicon {w state path} {
1221        global all_icons
1222
1223        if {[catch {set r $all_icons($state$w)}]} {
1224                puts "error: no icon for $w state={$state} $path"
1225                return file_plain
1226        }
1227        return $r
1228}
1229
1230proc mapdesc {state path} {
1231        global all_descs
1232
1233        if {[catch {set r $all_descs($state)}]} {
1234                puts "error: no desc for state={$state} $path"
1235                return $state
1236        }
1237        return $r
1238}
1239
1240proc escape_path {path} {
1241        regsub -all "\n" $path "\\n" path
1242        return $path
1243}
1244
1245proc short_path {path} {
1246        return [escape_path [lindex [file split $path] end]]
1247}
1248
1249set next_icon_id 0
1250set null_sha1 [string repeat 0 40]
1251
1252proc merge_state {path new_state {head_info {}} {index_info {}}} {
1253        global file_states next_icon_id null_sha1
1254
1255        set s0 [string index $new_state 0]
1256        set s1 [string index $new_state 1]
1257
1258        if {[catch {set info $file_states($path)}]} {
1259                set state __
1260                set icon n[incr next_icon_id]
1261        } else {
1262                set state [lindex $info 0]
1263                set icon [lindex $info 1]
1264                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1265                if {$index_info eq {}} {set index_info [lindex $info 3]}
1266        }
1267
1268        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1269        elseif {$s0 eq {_}} {set s0 _}
1270
1271        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1272        elseif {$s1 eq {_}} {set s1 _}
1273
1274        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1275                set head_info [list 0 $null_sha1]
1276        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1277                && $head_info eq {}} {
1278                set head_info $index_info
1279        }
1280
1281        set file_states($path) [list $s0$s1 $icon \
1282                $head_info $index_info \
1283                ]
1284        return $state
1285}
1286
1287proc display_file_helper {w path icon_name old_m new_m} {
1288        global file_lists
1289
1290        if {$new_m eq {_}} {
1291                set lno [lsearch -sorted $file_lists($w) $path]
1292                if {$lno >= 0} {
1293                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1294                        incr lno
1295                        $w conf -state normal
1296                        $w delete $lno.0 [expr {$lno + 1}].0
1297                        $w conf -state disabled
1298                }
1299        } elseif {$old_m eq {_} && $new_m ne {_}} {
1300                lappend file_lists($w) $path
1301                set file_lists($w) [lsort -unique $file_lists($w)]
1302                set lno [lsearch -sorted $file_lists($w) $path]
1303                incr lno
1304                $w conf -state normal
1305                $w image create $lno.0 \
1306                        -align center -padx 5 -pady 1 \
1307                        -name $icon_name \
1308                        -image [mapicon $w $new_m $path]
1309                $w insert $lno.1 "[escape_path $path]\n"
1310                $w conf -state disabled
1311        } elseif {$old_m ne $new_m} {
1312                $w conf -state normal
1313                $w image conf $icon_name -image [mapicon $w $new_m $path]
1314                $w conf -state disabled
1315        }
1316}
1317
1318proc display_file {path state} {
1319        global file_states selected_paths
1320        global ui_index ui_workdir
1321
1322        set old_m [merge_state $path $state]
1323        set s $file_states($path)
1324        set new_m [lindex $s 0]
1325        set icon_name [lindex $s 1]
1326
1327        set o [string index $old_m 0]
1328        set n [string index $new_m 0]
1329        if {$o eq {U}} {
1330                set o _
1331        }
1332        if {$n eq {U}} {
1333                set n _
1334        }
1335        display_file_helper     $ui_index $path $icon_name $o $n
1336
1337        if {[string index $old_m 0] eq {U}} {
1338                set o U
1339        } else {
1340                set o [string index $old_m 1]
1341        }
1342        if {[string index $new_m 0] eq {U}} {
1343                set n U
1344        } else {
1345                set n [string index $new_m 1]
1346        }
1347        display_file_helper     $ui_workdir $path $icon_name $o $n
1348
1349        if {$new_m eq {__}} {
1350                unset file_states($path)
1351                catch {unset selected_paths($path)}
1352        }
1353}
1354
1355proc display_all_files_helper {w path icon_name m} {
1356        global file_lists
1357
1358        lappend file_lists($w) $path
1359        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1360        $w image create end \
1361                -align center -padx 5 -pady 1 \
1362                -name $icon_name \
1363                -image [mapicon $w $m $path]
1364        $w insert end "[escape_path $path]\n"
1365}
1366
1367proc display_all_files {} {
1368        global ui_index ui_workdir
1369        global file_states file_lists
1370        global last_clicked
1371
1372        $ui_index conf -state normal
1373        $ui_workdir conf -state normal
1374
1375        $ui_index delete 0.0 end
1376        $ui_workdir delete 0.0 end
1377        set last_clicked {}
1378
1379        set file_lists($ui_index) [list]
1380        set file_lists($ui_workdir) [list]
1381
1382        foreach path [lsort [array names file_states]] {
1383                set s $file_states($path)
1384                set m [lindex $s 0]
1385                set icon_name [lindex $s 1]
1386
1387                set s [string index $m 0]
1388                if {$s ne {U} && $s ne {_}} {
1389                        display_all_files_helper $ui_index $path \
1390                                $icon_name $s
1391                }
1392
1393                if {[string index $m 0] eq {U}} {
1394                        set s U
1395                } else {
1396                        set s [string index $m 1]
1397                }
1398                if {$s ne {_}} {
1399                        display_all_files_helper $ui_workdir $path \
1400                                $icon_name $s
1401                }
1402        }
1403
1404        $ui_index conf -state disabled
1405        $ui_workdir conf -state disabled
1406}
1407
1408proc update_indexinfo {msg pathList after} {
1409        global update_index_cp ui_status_value
1410
1411        if {![lock_index update]} return
1412
1413        set update_index_cp 0
1414        set pathList [lsort $pathList]
1415        set totalCnt [llength $pathList]
1416        set batch [expr {int($totalCnt * .01) + 1}]
1417        if {$batch > 25} {set batch 25}
1418
1419        set ui_status_value [format \
1420                "$msg... %i/%i files (%.2f%%)" \
1421                $update_index_cp \
1422                $totalCnt \
1423                0.0]
1424        set fd [open "| git update-index -z --index-info" w]
1425        fconfigure $fd \
1426                -blocking 0 \
1427                -buffering full \
1428                -buffersize 512 \
1429                -translation binary
1430        fileevent $fd writable [list \
1431                write_update_indexinfo \
1432                $fd \
1433                $pathList \
1434                $totalCnt \
1435                $batch \
1436                $msg \
1437                $after \
1438                ]
1439}
1440
1441proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1442        global update_index_cp ui_status_value
1443        global file_states current_diff_path
1444
1445        if {$update_index_cp >= $totalCnt} {
1446                close $fd
1447                unlock_index
1448                uplevel #0 $after
1449                return
1450        }
1451
1452        for {set i $batch} \
1453                {$update_index_cp < $totalCnt && $i > 0} \
1454                {incr i -1} {
1455                set path [lindex $pathList $update_index_cp]
1456                incr update_index_cp
1457
1458                set s $file_states($path)
1459                switch -glob -- [lindex $s 0] {
1460                A? {set new _O}
1461                M? {set new _M}
1462                D_ {set new _D}
1463                D? {set new _?}
1464                ?? {continue}
1465                }
1466                set info [lindex $s 2]
1467                if {$info eq {}} continue
1468
1469                puts -nonewline $fd "$info\t$path\0"
1470                display_file $path $new
1471        }
1472
1473        set ui_status_value [format \
1474                "$msg... %i/%i files (%.2f%%)" \
1475                $update_index_cp \
1476                $totalCnt \
1477                [expr {100.0 * $update_index_cp / $totalCnt}]]
1478}
1479
1480proc update_index {msg pathList after} {
1481        global update_index_cp ui_status_value
1482
1483        if {![lock_index update]} return
1484
1485        set update_index_cp 0
1486        set pathList [lsort $pathList]
1487        set totalCnt [llength $pathList]
1488        set batch [expr {int($totalCnt * .01) + 1}]
1489        if {$batch > 25} {set batch 25}
1490
1491        set ui_status_value [format \
1492                "$msg... %i/%i files (%.2f%%)" \
1493                $update_index_cp \
1494                $totalCnt \
1495                0.0]
1496        set fd [open "| git update-index --add --remove -z --stdin" w]
1497        fconfigure $fd \
1498                -blocking 0 \
1499                -buffering full \
1500                -buffersize 512 \
1501                -translation binary
1502        fileevent $fd writable [list \
1503                write_update_index \
1504                $fd \
1505                $pathList \
1506                $totalCnt \
1507                $batch \
1508                $msg \
1509                $after \
1510                ]
1511}
1512
1513proc write_update_index {fd pathList totalCnt batch msg after} {
1514        global update_index_cp ui_status_value
1515        global file_states current_diff_path
1516
1517        if {$update_index_cp >= $totalCnt} {
1518                close $fd
1519                unlock_index
1520                uplevel #0 $after
1521                return
1522        }
1523
1524        for {set i $batch} \
1525                {$update_index_cp < $totalCnt && $i > 0} \
1526                {incr i -1} {
1527                set path [lindex $pathList $update_index_cp]
1528                incr update_index_cp
1529
1530                switch -glob -- [lindex $file_states($path) 0] {
1531                AD {set new __}
1532                ?D {set new D_}
1533                _O -
1534                AM {set new A_}
1535                U? {
1536                        if {[file exists $path]} {
1537                                set new M_
1538                        } else {
1539                                set new D_
1540                        }
1541                }
1542                ?M {set new M_}
1543                ?? {continue}
1544                }
1545                puts -nonewline $fd "$path\0"
1546                display_file $path $new
1547        }
1548
1549        set ui_status_value [format \
1550                "$msg... %i/%i files (%.2f%%)" \
1551                $update_index_cp \
1552                $totalCnt \
1553                [expr {100.0 * $update_index_cp / $totalCnt}]]
1554}
1555
1556proc checkout_index {msg pathList after} {
1557        global update_index_cp ui_status_value
1558
1559        if {![lock_index update]} return
1560
1561        set update_index_cp 0
1562        set pathList [lsort $pathList]
1563        set totalCnt [llength $pathList]
1564        set batch [expr {int($totalCnt * .01) + 1}]
1565        if {$batch > 25} {set batch 25}
1566
1567        set ui_status_value [format \
1568                "$msg... %i/%i files (%.2f%%)" \
1569                $update_index_cp \
1570                $totalCnt \
1571                0.0]
1572        set cmd [list git checkout-index]
1573        lappend cmd --index
1574        lappend cmd --quiet
1575        lappend cmd --force
1576        lappend cmd -z
1577        lappend cmd --stdin
1578        set fd [open "| $cmd " w]
1579        fconfigure $fd \
1580                -blocking 0 \
1581                -buffering full \
1582                -buffersize 512 \
1583                -translation binary
1584        fileevent $fd writable [list \
1585                write_checkout_index \
1586                $fd \
1587                $pathList \
1588                $totalCnt \
1589                $batch \
1590                $msg \
1591                $after \
1592                ]
1593}
1594
1595proc write_checkout_index {fd pathList totalCnt batch msg after} {
1596        global update_index_cp ui_status_value
1597        global file_states current_diff_path
1598
1599        if {$update_index_cp >= $totalCnt} {
1600                close $fd
1601                unlock_index
1602                uplevel #0 $after
1603                return
1604        }
1605
1606        for {set i $batch} \
1607                {$update_index_cp < $totalCnt && $i > 0} \
1608                {incr i -1} {
1609                set path [lindex $pathList $update_index_cp]
1610                incr update_index_cp
1611                switch -glob -- [lindex $file_states($path) 0] {
1612                U? {continue}
1613                ?M -
1614                ?D {
1615                        puts -nonewline $fd "$path\0"
1616                        display_file $path ?_
1617                }
1618                }
1619        }
1620
1621        set ui_status_value [format \
1622                "$msg... %i/%i files (%.2f%%)" \
1623                $update_index_cp \
1624                $totalCnt \
1625                [expr {100.0 * $update_index_cp / $totalCnt}]]
1626}
1627
1628######################################################################
1629##
1630## branch management
1631
1632proc load_all_heads {} {
1633        global all_heads tracking_branches
1634
1635        set all_heads [list]
1636        set cmd [list git for-each-ref]
1637        lappend cmd --format=%(refname)
1638        lappend cmd refs/heads
1639        set fd [open "| $cmd" r]
1640        while {[gets $fd line] > 0} {
1641                if {![catch {set info $tracking_branches($line)}]} continue
1642                if {![regsub ^refs/heads/ $line {} name]} continue
1643                lappend all_heads $name
1644        }
1645        close $fd
1646
1647        set all_heads [lsort $all_heads]
1648}
1649
1650proc populate_branch_menu {} {
1651        global all_heads disable_on_lock
1652
1653        set m .mbar.branch
1654        set last [$m index last]
1655        for {set i 0} {$i <= $last} {incr i} {
1656                if {[$m type $i] eq {separator}} {
1657                        $m delete $i last
1658                        set new_dol [list]
1659                        foreach a $disable_on_lock {
1660                                if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1661                                        lappend new_dol $a
1662                                }
1663                        }
1664                        set disable_on_lock $new_dol
1665                        break
1666                }
1667        }
1668
1669        $m add separator
1670        foreach b $all_heads {
1671                $m add radiobutton \
1672                        -label $b \
1673                        -command [list switch_branch $b] \
1674                        -variable current_branch \
1675                        -value $b \
1676                        -font font_ui
1677                lappend disable_on_lock \
1678                        [list $m entryconf [$m index last] -state]
1679        }
1680}
1681
1682proc all_tracking_branches {} {
1683        global tracking_branches
1684
1685        set all_trackings [list]
1686        foreach b [array names tracking_branches] {
1687                regsub ^refs/(heads|remotes)/ $b {} b
1688                lappend all_trackings $b
1689        }
1690        return [lsort -unique $all_trackings]
1691}
1692
1693proc do_create_branch_action {w} {
1694        global all_heads null_sha1 repo_config
1695        global create_branch_checkout create_branch_revtype
1696        global create_branch_head create_branch_trackinghead
1697
1698        set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1699        if {$newbranch eq {}
1700                || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1701                tk_messageBox \
1702                        -icon error \
1703                        -type ok \
1704                        -title [wm title $w] \
1705                        -parent $w \
1706                        -message "Please supply a branch name."
1707                focus $w.desc.name_t
1708                return
1709        }
1710        if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1711                tk_messageBox \
1712                        -icon error \
1713                        -type ok \
1714                        -title [wm title $w] \
1715                        -parent $w \
1716                        -message "Branch '$newbranch' already exists."
1717                focus $w.desc.name_t
1718                return
1719        }
1720        if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1721                tk_messageBox \
1722                        -icon error \
1723                        -type ok \
1724                        -title [wm title $w] \
1725                        -parent $w \
1726                        -message "We do not like '$newbranch' as a branch name."
1727                focus $w.desc.name_t
1728                return
1729        }
1730
1731        set rev {}
1732        switch -- $create_branch_revtype {
1733        head {set rev $create_branch_head}
1734        tracking {set rev $create_branch_trackinghead}
1735        expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1736        }
1737        if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1738                tk_messageBox \
1739                        -icon error \
1740                        -type ok \
1741                        -title [wm title $w] \
1742                        -parent $w \
1743                        -message "Invalid starting revision: $rev"
1744                return
1745        }
1746        set cmd [list git update-ref]
1747        lappend cmd -m
1748        lappend cmd "branch: Created from $rev"
1749        lappend cmd "refs/heads/$newbranch"
1750        lappend cmd $cmt
1751        lappend cmd $null_sha1
1752        if {[catch {eval exec $cmd} err]} {
1753                tk_messageBox \
1754                        -icon error \
1755                        -type ok \
1756                        -title [wm title $w] \
1757                        -parent $w \
1758                        -message "Failed to create '$newbranch'.\n\n$err"
1759                return
1760        }
1761
1762        lappend all_heads $newbranch
1763        set all_heads [lsort $all_heads]
1764        populate_branch_menu
1765        destroy $w
1766        if {$create_branch_checkout} {
1767                switch_branch $newbranch
1768        }
1769}
1770
1771proc do_create_branch {} {
1772        global all_heads current_branch repo_config
1773        global create_branch_checkout create_branch_revtype
1774        global create_branch_head create_branch_trackinghead
1775
1776        set create_branch_checkout 1
1777        set create_branch_revtype head
1778        set create_branch_head $current_branch
1779        set create_branch_trackinghead {}
1780
1781        set w .branch_editor
1782        toplevel $w
1783        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1784
1785        label $w.header -text {Create New Branch} \
1786                -font font_uibold
1787        pack $w.header -side top -fill x
1788
1789        frame $w.buttons
1790        button $w.buttons.create -text Create \
1791                -font font_ui \
1792                -default active \
1793                -command [list do_create_branch_action $w]
1794        pack $w.buttons.create -side right
1795        button $w.buttons.cancel -text {Cancel} \
1796                -font font_ui \
1797                -command [list destroy $w]
1798        pack $w.buttons.cancel -side right -padx 5
1799        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1800
1801        labelframe $w.desc \
1802                -text {Branch Description} \
1803                -font font_ui
1804        label $w.desc.name_l -text {Name:} -font font_ui
1805        text $w.desc.name_t \
1806                -borderwidth 1 \
1807                -relief sunken \
1808                -height 1 \
1809                -width 40 \
1810                -font font_ui
1811        $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1812        grid $w.desc.name_l $w.desc.name_t -stick we -padx {0 5}
1813        bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1814        bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1815        bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1816        bind $w.desc.name_t <Key> {
1817                if {{%K} ne {BackSpace}
1818                        && {%K} ne {Tab}
1819                        && {%K} ne {Escape}
1820                        && {%K} ne {Return}} {
1821                        if {%k <= 32} break
1822                        if {[string first %A {~^:?*[}] >= 0} break
1823                }
1824        }
1825        grid columnconfigure $w.desc 1 -weight 1
1826        pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1827
1828        labelframe $w.from \
1829                -text {Starting Revision} \
1830                -font font_ui
1831        radiobutton $w.from.head_r \
1832                -text {Local Branch:} \
1833                -value head \
1834                -variable create_branch_revtype \
1835                -font font_ui
1836        eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1837        grid $w.from.head_r $w.from.head_m -sticky w
1838        set all_trackings [all_tracking_branches]
1839        if {$all_trackings ne {}} {
1840                set create_branch_trackinghead [lindex $all_trackings 0]
1841                radiobutton $w.from.tracking_r \
1842                        -text {Tracking Branch:} \
1843                        -value tracking \
1844                        -variable create_branch_revtype \
1845                        -font font_ui
1846                eval tk_optionMenu $w.from.tracking_m \
1847                        create_branch_trackinghead \
1848                        $all_trackings
1849                grid $w.from.tracking_r $w.from.tracking_m -sticky w
1850        }
1851        radiobutton $w.from.exp_r \
1852                -text {Revision Expression:} \
1853                -value expression \
1854                -variable create_branch_revtype \
1855                -font font_ui
1856        text $w.from.exp_t \
1857                -borderwidth 1 \
1858                -relief sunken \
1859                -height 1 \
1860                -width 50 \
1861                -font font_ui
1862        grid $w.from.exp_r $w.from.exp_t -stick we -padx {0 5}
1863        bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1864        bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
1865        bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
1866        grid columnconfigure $w.from 1 -weight 1
1867        pack $w.from -anchor nw -fill x -pady 5 -padx 5
1868
1869        labelframe $w.postActions \
1870                -text {Post Creation Actions} \
1871                -font font_ui
1872        checkbutton $w.postActions.checkout \
1873                -text {Checkout after creation} \
1874                -variable create_branch_checkout \
1875                -font font_ui
1876        pack $w.postActions.checkout -anchor nw
1877        pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1878
1879        bind $w <Visibility> "grab $w; focus $w.desc.name_t"
1880        bind $w <Key-Escape> "destroy $w"
1881        bind $w <Key-Return> "do_create_branch_action $w;break"
1882        wm title $w "[appname] ([reponame]): Create Branch"
1883        tkwait window $w
1884}
1885
1886proc do_delete_branch_action {w} {
1887        global all_heads
1888        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1889
1890        set check_rev {}
1891        switch -- $delete_branch_checktype {
1892        head {set check_rev $delete_branch_head}
1893        tracking {set check_rev $delete_branch_trackinghead}
1894        always {set check_rev {:none}}
1895        }
1896        if {$check_rev eq {:none}} {
1897                set check_cmt {}
1898        } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
1899                tk_messageBox \
1900                        -icon error \
1901                        -type ok \
1902                        -title [wm title $w] \
1903                        -parent $w \
1904                        -message "Invalid check revision: $check_rev"
1905                return
1906        }
1907
1908        set to_delete [list]
1909        set not_merged [list]
1910        foreach i [$w.list.l curselection] {
1911                set b [$w.list.l get $i]
1912                if {[catch {set o [exec git rev-parse --verify $b]}]} continue
1913                if {$check_cmt ne {}} {
1914                        if {$b eq $check_rev} continue
1915                        if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
1916                        if {$o ne $m} {
1917                                lappend not_merged $b
1918                                continue
1919                        }
1920                }
1921                lappend to_delete [list $b $o]
1922        }
1923        if {$not_merged ne {}} {
1924                set msg "The following branches are not completely merged into $check_rev:
1925
1926 - [join $not_merged "\n - "]"
1927                tk_messageBox \
1928                        -icon info \
1929                        -type ok \
1930                        -title [wm title $w] \
1931                        -parent $w \
1932                        -message $msg
1933        }
1934        if {$to_delete eq {}} return
1935        if {$delete_branch_checktype eq {always}} {
1936                set msg {Recovering deleted branches is difficult.
1937
1938Delete the selected branches?}
1939                if {[tk_messageBox \
1940                        -icon warning \
1941                        -type yesno \
1942                        -title [wm title $w] \
1943                        -parent $w \
1944                        -message $msg] ne yes} {
1945                        return
1946                }
1947        }
1948
1949        set failed {}
1950        foreach i $to_delete {
1951                set b [lindex $i 0]
1952                set o [lindex $i 1]
1953                if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
1954                        append failed " - $b: $err\n"
1955                } else {
1956                        set x [lsearch -sorted $all_heads $b]
1957                        if {$x >= 0} {
1958                                set all_heads [lreplace $all_heads $x $x]
1959                        }
1960                }
1961        }
1962
1963        if {$failed ne {}} {
1964                tk_messageBox \
1965                        -icon error \
1966                        -type ok \
1967                        -title [wm title $w] \
1968                        -parent $w \
1969                        -message "Failed to delete branches:\n$failed"
1970        }
1971
1972        set all_heads [lsort $all_heads]
1973        populate_branch_menu
1974        destroy $w
1975}
1976
1977proc do_delete_branch {} {
1978        global all_heads tracking_branches current_branch
1979        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1980
1981        set delete_branch_checktype head
1982        set delete_branch_head $current_branch
1983        set delete_branch_trackinghead {}
1984
1985        set w .branch_editor
1986        toplevel $w
1987        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1988
1989        label $w.header -text {Delete Local Branch} \
1990                -font font_uibold
1991        pack $w.header -side top -fill x
1992
1993        frame $w.buttons
1994        button $w.buttons.create -text Delete \
1995                -font font_ui \
1996                -command [list do_delete_branch_action $w]
1997        pack $w.buttons.create -side right
1998        button $w.buttons.cancel -text {Cancel} \
1999                -font font_ui \
2000                -command [list destroy $w]
2001        pack $w.buttons.cancel -side right -padx 5
2002        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2003
2004        labelframe $w.list \
2005                -text {Local Branches} \
2006                -font font_ui
2007        listbox $w.list.l \
2008                -height 10 \
2009                -width 50 \
2010                -selectmode extended \
2011                -font font_ui
2012        foreach h $all_heads {
2013                if {$h ne $current_branch} {
2014                        $w.list.l insert end $h
2015                }
2016        }
2017        pack $w.list.l -fill both -pady 5 -padx 5
2018        pack $w.list -fill both -pady 5 -padx 5
2019
2020        labelframe $w.validate \
2021                -text {Delete Only If} \
2022                -font font_ui
2023        radiobutton $w.validate.head_r \
2024                -text {Merged Into Local Branch:} \
2025                -value head \
2026                -variable delete_branch_checktype \
2027                -font font_ui
2028        eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2029        grid $w.validate.head_r $w.validate.head_m -sticky w
2030        set all_trackings [all_tracking_branches]
2031        if {$all_trackings ne {}} {
2032                set delete_branch_trackinghead [lindex $all_trackings 0]
2033                radiobutton $w.validate.tracking_r \
2034                        -text {Merged Into Tracking Branch:} \
2035                        -value tracking \
2036                        -variable delete_branch_checktype \
2037                        -font font_ui
2038                eval tk_optionMenu $w.validate.tracking_m \
2039                        delete_branch_trackinghead \
2040                        $all_trackings
2041                grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2042        }
2043        radiobutton $w.validate.always_r \
2044                -text {Always (Do not perform merge checks)} \
2045                -value always \
2046                -variable delete_branch_checktype \
2047                -font font_ui
2048        grid $w.validate.always_r -columnspan 2 -sticky w
2049        grid columnconfigure $w.validate 1 -weight 1
2050        pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2051
2052        bind $w <Visibility> "grab $w; focus $w"
2053        bind $w <Key-Escape> "destroy $w"
2054        wm title $w "[appname] ([reponame]): Delete Branch"
2055        tkwait window $w
2056}
2057
2058proc switch_branch {b} {
2059        global HEAD commit_type file_states current_branch
2060        global selected_commit_type ui_comm
2061
2062        if {![lock_index switch]} return
2063
2064        # -- Backup the selected branch (repository_state resets it)
2065        #
2066        set new_branch $current_branch
2067
2068        # -- Our in memory state should match the repository.
2069        #
2070        repository_state curType curHEAD curMERGE_HEAD
2071        if {[string match amend* $commit_type]
2072                && $curType eq {normal}
2073                && $curHEAD eq $HEAD} {
2074        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2075                info_popup {Last scanned state does not match repository state.
2076
2077Another Git program has modified this repository
2078since the last scan.  A rescan must be performed
2079before the current branch can be changed.
2080
2081The rescan will be automatically started now.
2082}
2083                unlock_index
2084                rescan {set ui_status_value {Ready.}}
2085                return
2086        }
2087
2088        # -- Toss the message buffer if we are in amend mode.
2089        #
2090        if {[string match amend* $curType]} {
2091                $ui_comm delete 0.0 end
2092                $ui_comm edit reset
2093                $ui_comm edit modified false
2094        }
2095
2096        set selected_commit_type new
2097        set current_branch $new_branch
2098
2099        unlock_index
2100        error "NOT FINISHED"
2101}
2102
2103######################################################################
2104##
2105## remote management
2106
2107proc load_all_remotes {} {
2108        global repo_config
2109        global all_remotes tracking_branches
2110
2111        set all_remotes [list]
2112        array unset tracking_branches
2113
2114        set rm_dir [gitdir remotes]
2115        if {[file isdirectory $rm_dir]} {
2116                set all_remotes [glob \
2117                        -types f \
2118                        -tails \
2119                        -nocomplain \
2120                        -directory $rm_dir *]
2121
2122                foreach name $all_remotes {
2123                        catch {
2124                                set fd [open [file join $rm_dir $name] r]
2125                                while {[gets $fd line] >= 0} {
2126                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2127                                                $line line src dst]} continue
2128                                        if {![regexp ^refs/ $dst]} {
2129                                                set dst "refs/heads/$dst"
2130                                        }
2131                                        set tracking_branches($dst) [list $name $src]
2132                                }
2133                                close $fd
2134                        }
2135                }
2136        }
2137
2138        foreach line [array names repo_config remote.*.url] {
2139                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2140                lappend all_remotes $name
2141
2142                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2143                        set fl {}
2144                }
2145                foreach line $fl {
2146                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2147                        if {![regexp ^refs/ $dst]} {
2148                                set dst "refs/heads/$dst"
2149                        }
2150                        set tracking_branches($dst) [list $name $src]
2151                }
2152        }
2153
2154        set all_remotes [lsort -unique $all_remotes]
2155}
2156
2157proc populate_fetch_menu {m} {
2158        global all_remotes repo_config
2159
2160        foreach r $all_remotes {
2161                set enable 0
2162                if {![catch {set a $repo_config(remote.$r.url)}]} {
2163                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2164                                set enable 1
2165                        }
2166                } else {
2167                        catch {
2168                                set fd [open [gitdir remotes $r] r]
2169                                while {[gets $fd n] >= 0} {
2170                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2171                                                set enable 1
2172                                                break
2173                                        }
2174                                }
2175                                close $fd
2176                        }
2177                }
2178
2179                if {$enable} {
2180                        $m add command \
2181                                -label "Fetch from $r..." \
2182                                -command [list fetch_from $r] \
2183                                -font font_ui
2184                }
2185        }
2186}
2187
2188proc populate_push_menu {m} {
2189        global all_remotes repo_config
2190
2191        foreach r $all_remotes {
2192                set enable 0
2193                if {![catch {set a $repo_config(remote.$r.url)}]} {
2194                        if {![catch {set a $repo_config(remote.$r.push)}]} {
2195                                set enable 1
2196                        }
2197                } else {
2198                        catch {
2199                                set fd [open [gitdir remotes $r] r]
2200                                while {[gets $fd n] >= 0} {
2201                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2202                                                set enable 1
2203                                                break
2204                                        }
2205                                }
2206                                close $fd
2207                        }
2208                }
2209
2210                if {$enable} {
2211                        $m add command \
2212                                -label "Push to $r..." \
2213                                -command [list push_to $r] \
2214                                -font font_ui
2215                }
2216        }
2217}
2218
2219proc populate_pull_menu {m} {
2220        global repo_config all_remotes disable_on_lock
2221
2222        foreach remote $all_remotes {
2223                set rb_list [list]
2224                if {[array get repo_config remote.$remote.url] ne {}} {
2225                        if {[array get repo_config remote.$remote.fetch] ne {}} {
2226                                foreach line $repo_config(remote.$remote.fetch) {
2227                                        if {[regexp {^([^:]+):} $line line rb]} {
2228                                                lappend rb_list $rb
2229                                        }
2230                                }
2231                        }
2232                } else {
2233                        catch {
2234                                set fd [open [gitdir remotes $remote] r]
2235                                while {[gets $fd line] >= 0} {
2236                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2237                                                lappend rb_list $rb
2238                                        }
2239                                }
2240                                close $fd
2241                        }
2242                }
2243
2244                foreach rb $rb_list {
2245                        regsub ^refs/heads/ $rb {} rb_short
2246                        $m add command \
2247                                -label "Branch $rb_short from $remote..." \
2248                                -command [list pull_remote $remote $rb] \
2249                                -font font_ui
2250                        lappend disable_on_lock \
2251                                [list $m entryconf [$m index last] -state]
2252                }
2253        }
2254}
2255
2256######################################################################
2257##
2258## icons
2259
2260set filemask {
2261#define mask_width 14
2262#define mask_height 15
2263static unsigned char mask_bits[] = {
2264   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2265   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2266   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2267}
2268
2269image create bitmap file_plain -background white -foreground black -data {
2270#define plain_width 14
2271#define plain_height 15
2272static unsigned char plain_bits[] = {
2273   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2274   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2275   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2276} -maskdata $filemask
2277
2278image create bitmap file_mod -background white -foreground blue -data {
2279#define mod_width 14
2280#define mod_height 15
2281static unsigned char mod_bits[] = {
2282   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2283   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2284   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2285} -maskdata $filemask
2286
2287image create bitmap file_fulltick -background white -foreground "#007000" -data {
2288#define file_fulltick_width 14
2289#define file_fulltick_height 15
2290static unsigned char file_fulltick_bits[] = {
2291   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2292   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2293   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2294} -maskdata $filemask
2295
2296image create bitmap file_parttick -background white -foreground "#005050" -data {
2297#define parttick_width 14
2298#define parttick_height 15
2299static unsigned char parttick_bits[] = {
2300   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2301   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2302   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2303} -maskdata $filemask
2304
2305image create bitmap file_question -background white -foreground black -data {
2306#define file_question_width 14
2307#define file_question_height 15
2308static unsigned char file_question_bits[] = {
2309   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2310   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2311   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2312} -maskdata $filemask
2313
2314image create bitmap file_removed -background white -foreground red -data {
2315#define file_removed_width 14
2316#define file_removed_height 15
2317static unsigned char file_removed_bits[] = {
2318   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2319   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2320   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2321} -maskdata $filemask
2322
2323image create bitmap file_merge -background white -foreground blue -data {
2324#define file_merge_width 14
2325#define file_merge_height 15
2326static unsigned char file_merge_bits[] = {
2327   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2328   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2329   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2330} -maskdata $filemask
2331
2332set ui_index .vpane.files.index.list
2333set ui_workdir .vpane.files.workdir.list
2334
2335set all_icons(_$ui_index)   file_plain
2336set all_icons(A$ui_index)   file_fulltick
2337set all_icons(M$ui_index)   file_fulltick
2338set all_icons(D$ui_index)   file_removed
2339set all_icons(U$ui_index)   file_merge
2340
2341set all_icons(_$ui_workdir) file_plain
2342set all_icons(M$ui_workdir) file_mod
2343set all_icons(D$ui_workdir) file_question
2344set all_icons(U$ui_workdir) file_merge
2345set all_icons(O$ui_workdir) file_plain
2346
2347set max_status_desc 0
2348foreach i {
2349                {__ "Unmodified"}
2350
2351                {_M "Modified, not staged"}
2352                {M_ "Staged for commit"}
2353                {MM "Portions staged for commit"}
2354                {MD "Staged for commit, missing"}
2355
2356                {_O "Untracked, not staged"}
2357                {A_ "Staged for commit"}
2358                {AM "Portions staged for commit"}
2359                {AD "Staged for commit, missing"}
2360
2361                {_D "Missing"}
2362                {D_ "Staged for removal"}
2363                {DO "Staged for removal, still present"}
2364
2365                {U_ "Requires merge resolution"}
2366                {UU "Requires merge resolution"}
2367                {UM "Requires merge resolution"}
2368                {UD "Requires merge resolution"}
2369        } {
2370        if {$max_status_desc < [string length [lindex $i 1]]} {
2371                set max_status_desc [string length [lindex $i 1]]
2372        }
2373        set all_descs([lindex $i 0]) [lindex $i 1]
2374}
2375unset i
2376
2377######################################################################
2378##
2379## util
2380
2381proc is_MacOSX {} {
2382        global tcl_platform tk_library
2383        if {[tk windowingsystem] eq {aqua}} {
2384                return 1
2385        }
2386        return 0
2387}
2388
2389proc is_Windows {} {
2390        global tcl_platform
2391        if {$tcl_platform(platform) eq {windows}} {
2392                return 1
2393        }
2394        return 0
2395}
2396
2397proc bind_button3 {w cmd} {
2398        bind $w <Any-Button-3> $cmd
2399        if {[is_MacOSX]} {
2400                bind $w <Control-Button-1> $cmd
2401        }
2402}
2403
2404proc incr_font_size {font {amt 1}} {
2405        set sz [font configure $font -size]
2406        incr sz $amt
2407        font configure $font -size $sz
2408        font configure ${font}bold -size $sz
2409}
2410
2411proc hook_failed_popup {hook msg} {
2412        set w .hookfail
2413        toplevel $w
2414
2415        frame $w.m
2416        label $w.m.l1 -text "$hook hook failed:" \
2417                -anchor w \
2418                -justify left \
2419                -font font_uibold
2420        text $w.m.t \
2421                -background white -borderwidth 1 \
2422                -relief sunken \
2423                -width 80 -height 10 \
2424                -font font_diff \
2425                -yscrollcommand [list $w.m.sby set]
2426        label $w.m.l2 \
2427                -text {You must correct the above errors before committing.} \
2428                -anchor w \
2429                -justify left \
2430                -font font_uibold
2431        scrollbar $w.m.sby -command [list $w.m.t yview]
2432        pack $w.m.l1 -side top -fill x
2433        pack $w.m.l2 -side bottom -fill x
2434        pack $w.m.sby -side right -fill y
2435        pack $w.m.t -side left -fill both -expand 1
2436        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2437
2438        $w.m.t insert 1.0 $msg
2439        $w.m.t conf -state disabled
2440
2441        button $w.ok -text OK \
2442                -width 15 \
2443                -font font_ui \
2444                -command "destroy $w"
2445        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2446
2447        bind $w <Visibility> "grab $w; focus $w"
2448        bind $w <Key-Return> "destroy $w"
2449        wm title $w "[appname] ([reponame]): error"
2450        tkwait window $w
2451}
2452
2453set next_console_id 0
2454
2455proc new_console {short_title long_title} {
2456        global next_console_id console_data
2457        set w .console[incr next_console_id]
2458        set console_data($w) [list $short_title $long_title]
2459        return [console_init $w]
2460}
2461
2462proc console_init {w} {
2463        global console_cr console_data M1B
2464
2465        set console_cr($w) 1.0
2466        toplevel $w
2467        frame $w.m
2468        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2469                -anchor w \
2470                -justify left \
2471                -font font_uibold
2472        text $w.m.t \
2473                -background white -borderwidth 1 \
2474                -relief sunken \
2475                -width 80 -height 10 \
2476                -font font_diff \
2477                -state disabled \
2478                -yscrollcommand [list $w.m.sby set]
2479        label $w.m.s -text {Working... please wait...} \
2480                -anchor w \
2481                -justify left \
2482                -font font_uibold
2483        scrollbar $w.m.sby -command [list $w.m.t yview]
2484        pack $w.m.l1 -side top -fill x
2485        pack $w.m.s -side bottom -fill x
2486        pack $w.m.sby -side right -fill y
2487        pack $w.m.t -side left -fill both -expand 1
2488        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2489
2490        menu $w.ctxm -tearoff 0
2491        $w.ctxm add command -label "Copy" \
2492                -font font_ui \
2493                -command "tk_textCopy $w.m.t"
2494        $w.ctxm add command -label "Select All" \
2495                -font font_ui \
2496                -command "$w.m.t tag add sel 0.0 end"
2497        $w.ctxm add command -label "Copy All" \
2498                -font font_ui \
2499                -command "
2500                        $w.m.t tag add sel 0.0 end
2501                        tk_textCopy $w.m.t
2502                        $w.m.t tag remove sel 0.0 end
2503                "
2504
2505        button $w.ok -text {Close} \
2506                -font font_ui \
2507                -state disabled \
2508                -command "destroy $w"
2509        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2510
2511        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2512        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2513        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2514        bind $w <Visibility> "focus $w"
2515        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2516        return $w
2517}
2518
2519proc console_exec {w cmd {after {}}} {
2520        # -- Windows tosses the enviroment when we exec our child.
2521        #    But most users need that so we have to relogin. :-(
2522        #
2523        if {[is_Windows]} {
2524                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2525        }
2526
2527        # -- Tcl won't let us redirect both stdout and stderr to
2528        #    the same pipe.  So pass it through cat...
2529        #
2530        set cmd [concat | $cmd |& cat]
2531
2532        set fd_f [open $cmd r]
2533        fconfigure $fd_f -blocking 0 -translation binary
2534        fileevent $fd_f readable [list console_read $w $fd_f $after]
2535}
2536
2537proc console_read {w fd after} {
2538        global console_cr console_data
2539
2540        set buf [read $fd]
2541        if {$buf ne {}} {
2542                if {![winfo exists $w]} {console_init $w}
2543                $w.m.t conf -state normal
2544                set c 0
2545                set n [string length $buf]
2546                while {$c < $n} {
2547                        set cr [string first "\r" $buf $c]
2548                        set lf [string first "\n" $buf $c]
2549                        if {$cr < 0} {set cr [expr {$n + 1}]}
2550                        if {$lf < 0} {set lf [expr {$n + 1}]}
2551
2552                        if {$lf < $cr} {
2553                                $w.m.t insert end [string range $buf $c $lf]
2554                                set console_cr($w) [$w.m.t index {end -1c}]
2555                                set c $lf
2556                                incr c
2557                        } else {
2558                                $w.m.t delete $console_cr($w) end
2559                                $w.m.t insert end "\n"
2560                                $w.m.t insert end [string range $buf $c $cr]
2561                                set c $cr
2562                                incr c
2563                        }
2564                }
2565                $w.m.t conf -state disabled
2566                $w.m.t see end
2567        }
2568
2569        fconfigure $fd -blocking 1
2570        if {[eof $fd]} {
2571                if {[catch {close $fd}]} {
2572                        if {![winfo exists $w]} {console_init $w}
2573                        $w.m.s conf -background red -text {Error: Command Failed}
2574                        $w.ok conf -state normal
2575                        set ok 0
2576                } elseif {[winfo exists $w]} {
2577                        $w.m.s conf -background green -text {Success}
2578                        $w.ok conf -state normal
2579                        set ok 1
2580                }
2581                array unset console_cr $w
2582                array unset console_data $w
2583                if {$after ne {}} {
2584                        uplevel #0 $after $ok
2585                }
2586                return
2587        }
2588        fconfigure $fd -blocking 0
2589}
2590
2591######################################################################
2592##
2593## ui commands
2594
2595set starting_gitk_msg {Starting gitk... please wait...}
2596
2597proc do_gitk {revs} {
2598        global ui_status_value starting_gitk_msg
2599
2600        set cmd gitk
2601        if {$revs ne {}} {
2602                append cmd { }
2603                append cmd $revs
2604        }
2605        if {[is_Windows]} {
2606                set cmd "sh -c \"exec $cmd\""
2607        }
2608        append cmd { &}
2609
2610        if {[catch {eval exec $cmd} err]} {
2611                error_popup "Failed to start gitk:\n\n$err"
2612        } else {
2613                set ui_status_value $starting_gitk_msg
2614                after 10000 {
2615                        if {$ui_status_value eq $starting_gitk_msg} {
2616                                set ui_status_value {Ready.}
2617                        }
2618                }
2619        }
2620}
2621
2622proc do_gc {} {
2623        set w [new_console {gc} {Compressing the object database}]
2624        console_exec $w {git gc}
2625}
2626
2627proc do_fsck_objects {} {
2628        set w [new_console {fsck-objects} \
2629                {Verifying the object database with fsck-objects}]
2630        set cmd [list git fsck-objects]
2631        lappend cmd --full
2632        lappend cmd --cache
2633        lappend cmd --strict
2634        console_exec $w $cmd
2635}
2636
2637set is_quitting 0
2638
2639proc do_quit {} {
2640        global ui_comm is_quitting repo_config commit_type
2641
2642        if {$is_quitting} return
2643        set is_quitting 1
2644
2645        # -- Stash our current commit buffer.
2646        #
2647        set save [gitdir GITGUI_MSG]
2648        set msg [string trim [$ui_comm get 0.0 end]]
2649        if {![string match amend* $commit_type]
2650                && [$ui_comm edit modified]
2651                && $msg ne {}} {
2652                catch {
2653                        set fd [open $save w]
2654                        puts $fd [string trim [$ui_comm get 0.0 end]]
2655                        close $fd
2656                }
2657        } else {
2658                catch {file delete $save}
2659        }
2660
2661        # -- Stash our current window geometry into this repository.
2662        #
2663        set cfg_geometry [list]
2664        lappend cfg_geometry [wm geometry .]
2665        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2666        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2667        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2668                set rc_geometry {}
2669        }
2670        if {$cfg_geometry ne $rc_geometry} {
2671                catch {exec git repo-config gui.geometry $cfg_geometry}
2672        }
2673
2674        destroy .
2675}
2676
2677proc do_rescan {} {
2678        rescan {set ui_status_value {Ready.}}
2679}
2680
2681proc unstage_helper {txt paths} {
2682        global file_states current_diff_path
2683
2684        if {![lock_index begin-update]} return
2685
2686        set pathList [list]
2687        set after {}
2688        foreach path $paths {
2689                switch -glob -- [lindex $file_states($path) 0] {
2690                A? -
2691                M? -
2692                D? {
2693                        lappend pathList $path
2694                        if {$path eq $current_diff_path} {
2695                                set after {reshow_diff;}
2696                        }
2697                }
2698                }
2699        }
2700        if {$pathList eq {}} {
2701                unlock_index
2702        } else {
2703                update_indexinfo \
2704                        $txt \
2705                        $pathList \
2706                        [concat $after {set ui_status_value {Ready.}}]
2707        }
2708}
2709
2710proc do_unstage_selection {} {
2711        global current_diff_path selected_paths
2712
2713        if {[array size selected_paths] > 0} {
2714                unstage_helper \
2715                        {Unstaging selected files from commit} \
2716                        [array names selected_paths]
2717        } elseif {$current_diff_path ne {}} {
2718                unstage_helper \
2719                        "Unstaging [short_path $current_diff_path] from commit" \
2720                        [list $current_diff_path]
2721        }
2722}
2723
2724proc add_helper {txt paths} {
2725        global file_states current_diff_path
2726
2727        if {![lock_index begin-update]} return
2728
2729        set pathList [list]
2730        set after {}
2731        foreach path $paths {
2732                switch -glob -- [lindex $file_states($path) 0] {
2733                _O -
2734                ?M -
2735                ?D -
2736                U? {
2737                        lappend pathList $path
2738                        if {$path eq $current_diff_path} {
2739                                set after {reshow_diff;}
2740                        }
2741                }
2742                }
2743        }
2744        if {$pathList eq {}} {
2745                unlock_index
2746        } else {
2747                update_index \
2748                        $txt \
2749                        $pathList \
2750                        [concat $after {set ui_status_value {Ready to commit.}}]
2751        }
2752}
2753
2754proc do_add_selection {} {
2755        global current_diff_path selected_paths
2756
2757        if {[array size selected_paths] > 0} {
2758                add_helper \
2759                        {Adding selected files} \
2760                        [array names selected_paths]
2761        } elseif {$current_diff_path ne {}} {
2762                add_helper \
2763                        "Adding [short_path $current_diff_path]" \
2764                        [list $current_diff_path]
2765        }
2766}
2767
2768proc do_add_all {} {
2769        global file_states
2770
2771        set paths [list]
2772        foreach path [array names file_states] {
2773                switch -glob -- [lindex $file_states($path) 0] {
2774                U? {continue}
2775                ?M -
2776                ?D {lappend paths $path}
2777                }
2778        }
2779        add_helper {Adding all changed files} $paths
2780}
2781
2782proc revert_helper {txt paths} {
2783        global file_states current_diff_path
2784
2785        if {![lock_index begin-update]} return
2786
2787        set pathList [list]
2788        set after {}
2789        foreach path $paths {
2790                switch -glob -- [lindex $file_states($path) 0] {
2791                U? {continue}
2792                ?M -
2793                ?D {
2794                        lappend pathList $path
2795                        if {$path eq $current_diff_path} {
2796                                set after {reshow_diff;}
2797                        }
2798                }
2799                }
2800        }
2801
2802        set n [llength $pathList]
2803        if {$n == 0} {
2804                unlock_index
2805                return
2806        } elseif {$n == 1} {
2807                set s "[short_path [lindex $pathList]]"
2808        } else {
2809                set s "these $n files"
2810        }
2811
2812        set reply [tk_dialog \
2813                .confirm_revert \
2814                "[appname] ([reponame])" \
2815                "Revert changes in $s?
2816
2817Any unadded changes will be permanently lost by the revert." \
2818                question \
2819                1 \
2820                {Do Nothing} \
2821                {Revert Changes} \
2822                ]
2823        if {$reply == 1} {
2824                checkout_index \
2825                        $txt \
2826                        $pathList \
2827                        [concat $after {set ui_status_value {Ready.}}]
2828        } else {
2829                unlock_index
2830        }
2831}
2832
2833proc do_revert_selection {} {
2834        global current_diff_path selected_paths
2835
2836        if {[array size selected_paths] > 0} {
2837                revert_helper \
2838                        {Reverting selected files} \
2839                        [array names selected_paths]
2840        } elseif {$current_diff_path ne {}} {
2841                revert_helper \
2842                        "Reverting [short_path $current_diff_path]" \
2843                        [list $current_diff_path]
2844        }
2845}
2846
2847proc do_signoff {} {
2848        global ui_comm
2849
2850        set me [committer_ident]
2851        if {$me eq {}} return
2852
2853        set sob "Signed-off-by: $me"
2854        set last [$ui_comm get {end -1c linestart} {end -1c}]
2855        if {$last ne $sob} {
2856                $ui_comm edit separator
2857                if {$last ne {}
2858                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2859                        $ui_comm insert end "\n"
2860                }
2861                $ui_comm insert end "\n$sob"
2862                $ui_comm edit separator
2863                $ui_comm see end
2864        }
2865}
2866
2867proc do_select_commit_type {} {
2868        global commit_type selected_commit_type
2869
2870        if {$selected_commit_type eq {new}
2871                && [string match amend* $commit_type]} {
2872                create_new_commit
2873        } elseif {$selected_commit_type eq {amend}
2874                && ![string match amend* $commit_type]} {
2875                load_last_commit
2876
2877                # The amend request was rejected...
2878                #
2879                if {![string match amend* $commit_type]} {
2880                        set selected_commit_type new
2881                }
2882        }
2883}
2884
2885proc do_commit {} {
2886        commit_tree
2887}
2888
2889proc do_about {} {
2890        global appvers copyright
2891        global tcl_patchLevel tk_patchLevel
2892
2893        set w .about_dialog
2894        toplevel $w
2895        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2896
2897        label $w.header -text "About [appname]" \
2898                -font font_uibold
2899        pack $w.header -side top -fill x
2900
2901        frame $w.buttons
2902        button $w.buttons.close -text {Close} \
2903                -font font_ui \
2904                -command [list destroy $w]
2905        pack $w.buttons.close -side right
2906        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2907
2908        label $w.desc \
2909                -text "[appname] - a commit creation tool for Git.
2910$copyright" \
2911                -padx 5 -pady 5 \
2912                -justify left \
2913                -anchor w \
2914                -borderwidth 1 \
2915                -relief solid \
2916                -font font_ui
2917        pack $w.desc -side top -fill x -padx 5 -pady 5
2918
2919        set v {}
2920        append v "[appname] version $appvers\n"
2921        append v "[exec git version]\n"
2922        append v "\n"
2923        if {$tcl_patchLevel eq $tk_patchLevel} {
2924                append v "Tcl/Tk version $tcl_patchLevel"
2925        } else {
2926                append v "Tcl version $tcl_patchLevel"
2927                append v ", Tk version $tk_patchLevel"
2928        }
2929
2930        label $w.vers \
2931                -text $v \
2932                -padx 5 -pady 5 \
2933                -justify left \
2934                -anchor w \
2935                -borderwidth 1 \
2936                -relief solid \
2937                -font font_ui
2938        pack $w.vers -side top -fill x -padx 5 -pady 5
2939
2940        menu $w.ctxm -tearoff 0
2941        $w.ctxm add command \
2942                -label {Copy} \
2943                -font font_ui \
2944                -command "
2945                clipboard clear
2946                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2947        "
2948
2949        bind $w <Visibility> "grab $w; focus $w"
2950        bind $w <Key-Escape> "destroy $w"
2951        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2952        wm title $w "About [appname]"
2953        tkwait window $w
2954}
2955
2956proc do_options {} {
2957        global repo_config global_config font_descs
2958        global repo_config_new global_config_new
2959
2960        array unset repo_config_new
2961        array unset global_config_new
2962        foreach name [array names repo_config] {
2963                set repo_config_new($name) $repo_config($name)
2964        }
2965        load_config 1
2966        foreach name [array names repo_config] {
2967                switch -- $name {
2968                gui.diffcontext {continue}
2969                }
2970                set repo_config_new($name) $repo_config($name)
2971        }
2972        foreach name [array names global_config] {
2973                set global_config_new($name) $global_config($name)
2974        }
2975
2976        set w .options_editor
2977        toplevel $w
2978        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2979
2980        label $w.header -text "[appname] Options" \
2981                -font font_uibold
2982        pack $w.header -side top -fill x
2983
2984        frame $w.buttons
2985        button $w.buttons.restore -text {Restore Defaults} \
2986                -font font_ui \
2987                -command do_restore_defaults
2988        pack $w.buttons.restore -side left
2989        button $w.buttons.save -text Save \
2990                -font font_ui \
2991                -command "
2992                        catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
2993                        do_save_config $w
2994                "
2995        pack $w.buttons.save -side right
2996        button $w.buttons.cancel -text {Cancel} \
2997                -font font_ui \
2998                -command [list destroy $w]
2999        pack $w.buttons.cancel -side right -padx 5
3000        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3001
3002        labelframe $w.repo -text "[reponame] Repository" \
3003                -font font_ui \
3004                -relief raised -borderwidth 2
3005        labelframe $w.global -text {Global (All Repositories)} \
3006                -font font_ui \
3007                -relief raised -borderwidth 2
3008        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3009        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3010
3011        foreach option {
3012                {b pullsummary {Show Pull Summary}}
3013                {b trustmtime  {Trust File Modification Timestamps}}
3014                {i diffcontext {Number of Diff Context Lines}}
3015                {t newbranchtemplate {New Branch Name Template}}
3016                } {
3017                set type [lindex $option 0]
3018                set name [lindex $option 1]
3019                set text [lindex $option 2]
3020                foreach f {repo global} {
3021                        switch $type {
3022                        b {
3023                                checkbutton $w.$f.$name -text $text \
3024                                        -variable ${f}_config_new(gui.$name) \
3025                                        -onvalue true \
3026                                        -offvalue false \
3027                                        -font font_ui
3028                                pack $w.$f.$name -side top -anchor w
3029                        }
3030                        i {
3031                                frame $w.$f.$name
3032                                label $w.$f.$name.l -text "$text:" -font font_ui
3033                                pack $w.$f.$name.l -side left -anchor w -fill x
3034                                spinbox $w.$f.$name.v \
3035                                        -textvariable ${f}_config_new(gui.$name) \
3036                                        -from 1 -to 99 -increment 1 \
3037                                        -width 3 \
3038                                        -font font_ui
3039                                bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3040                                pack $w.$f.$name.v -side right -anchor e -padx 5
3041                                pack $w.$f.$name -side top -anchor w -fill x
3042                        }
3043                        t {
3044                                frame $w.$f.$name
3045                                label $w.$f.$name.l -text "$text:" -font font_ui
3046                                text $w.$f.$name.v \
3047                                        -borderwidth 1 \
3048                                        -relief sunken \
3049                                        -height 1 \
3050                                        -width 20 \
3051                                        -font font_ui
3052                                $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3053                                bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3054                                bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3055                                bind $w.$f.$name.v <Key-Return> break
3056                                bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3057                                bind $w.$f.$name.v <FocusOut> "
3058                                        set ${f}_config_new(gui.$name) \
3059                                        \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3060                                "
3061                                pack $w.$f.$name.l -side left -anchor w
3062                                pack $w.$f.$name.v -side left -anchor w \
3063                                        -fill x -expand 1 \
3064                                        -padx 5
3065                                pack $w.$f.$name -side top -anchor w -fill x
3066                        }
3067                        }
3068                }
3069        }
3070
3071        set all_fonts [lsort [font families]]
3072        foreach option $font_descs {
3073                set name [lindex $option 0]
3074                set font [lindex $option 1]
3075                set text [lindex $option 2]
3076
3077                set global_config_new(gui.$font^^family) \
3078                        [font configure $font -family]
3079                set global_config_new(gui.$font^^size) \
3080                        [font configure $font -size]
3081
3082                frame $w.global.$name
3083                label $w.global.$name.l -text "$text:" -font font_ui
3084                pack $w.global.$name.l -side left -anchor w -fill x
3085                eval tk_optionMenu $w.global.$name.family \
3086                        global_config_new(gui.$font^^family) \
3087                        $all_fonts
3088                spinbox $w.global.$name.size \
3089                        -textvariable global_config_new(gui.$font^^size) \
3090                        -from 2 -to 80 -increment 1 \
3091                        -width 3 \
3092                        -font font_ui
3093                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3094                pack $w.global.$name.size -side right -anchor e
3095                pack $w.global.$name.family -side right -anchor e
3096                pack $w.global.$name -side top -anchor w -fill x
3097        }
3098
3099        bind $w <Visibility> "grab $w; focus $w"
3100        bind $w <Key-Escape> "destroy $w"
3101        wm title $w "[appname] ([reponame]): Options"
3102        tkwait window $w
3103}
3104
3105proc do_restore_defaults {} {
3106        global font_descs default_config repo_config
3107        global repo_config_new global_config_new
3108
3109        foreach name [array names default_config] {
3110                set repo_config_new($name) $default_config($name)
3111                set global_config_new($name) $default_config($name)
3112        }
3113
3114        foreach option $font_descs {
3115                set name [lindex $option 0]
3116                set repo_config(gui.$name) $default_config(gui.$name)
3117        }
3118        apply_config
3119
3120        foreach option $font_descs {
3121                set name [lindex $option 0]
3122                set font [lindex $option 1]
3123                set global_config_new(gui.$font^^family) \
3124                        [font configure $font -family]
3125                set global_config_new(gui.$font^^size) \
3126                        [font configure $font -size]
3127        }
3128}
3129
3130proc do_save_config {w} {
3131        if {[catch {save_config} err]} {
3132                error_popup "Failed to completely save options:\n\n$err"
3133        }
3134        reshow_diff
3135        destroy $w
3136}
3137
3138proc do_windows_shortcut {} {
3139        global argv0
3140
3141        if {[catch {
3142                set desktop [exec cygpath \
3143                        --windows \
3144                        --absolute \
3145                        --long-name \
3146                        --desktop]
3147                }]} {
3148                        set desktop .
3149        }
3150        set fn [tk_getSaveFile \
3151                -parent . \
3152                -title "[appname] ([reponame]): Create Desktop Icon" \
3153                -initialdir $desktop \
3154                -initialfile "Git [reponame].bat"]
3155        if {$fn != {}} {
3156                if {[catch {
3157                                set fd [open $fn w]
3158                                set sh [exec cygpath \
3159                                        --windows \
3160                                        --absolute \
3161                                        /bin/sh]
3162                                set me [exec cygpath \
3163                                        --unix \
3164                                        --absolute \
3165                                        $argv0]
3166                                set gd [exec cygpath \
3167                                        --unix \
3168                                        --absolute \
3169                                        [gitdir]]
3170                                set gw [exec cygpath \
3171                                        --windows \
3172                                        --absolute \
3173                                        [file dirname [gitdir]]]
3174                                regsub -all ' $me "'\\''" me
3175                                regsub -all ' $gd "'\\''" gd
3176                                puts $fd "@ECHO Entering $gw"
3177                                puts $fd "@ECHO Starting git-gui... please wait..."
3178                                puts -nonewline $fd "@\"$sh\" --login -c \""
3179                                puts -nonewline $fd "GIT_DIR='$gd'"
3180                                puts -nonewline $fd " '$me'"
3181                                puts $fd "&\""
3182                                close $fd
3183                        } err]} {
3184                        error_popup "Cannot write script:\n\n$err"
3185                }
3186        }
3187}
3188
3189proc do_macosx_app {} {
3190        global argv0 env
3191
3192        set fn [tk_getSaveFile \
3193                -parent . \
3194                -title "[appname] ([reponame]): Create Desktop Icon" \
3195                -initialdir [file join $env(HOME) Desktop] \
3196                -initialfile "Git [reponame].app"]
3197        if {$fn != {}} {
3198                if {[catch {
3199                                set Contents [file join $fn Contents]
3200                                set MacOS [file join $Contents MacOS]
3201                                set exe [file join $MacOS git-gui]
3202
3203                                file mkdir $MacOS
3204
3205                                set fd [open [file join $Contents Info.plist] w]
3206                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3207<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3208<plist version="1.0">
3209<dict>
3210        <key>CFBundleDevelopmentRegion</key>
3211        <string>English</string>
3212        <key>CFBundleExecutable</key>
3213        <string>git-gui</string>
3214        <key>CFBundleIdentifier</key>
3215        <string>org.spearce.git-gui</string>
3216        <key>CFBundleInfoDictionaryVersion</key>
3217        <string>6.0</string>
3218        <key>CFBundlePackageType</key>
3219        <string>APPL</string>
3220        <key>CFBundleSignature</key>
3221        <string>????</string>
3222        <key>CFBundleVersion</key>
3223        <string>1.0</string>
3224        <key>NSPrincipalClass</key>
3225        <string>NSApplication</string>
3226</dict>
3227</plist>}
3228                                close $fd
3229
3230                                set fd [open $exe w]
3231                                set gd [file normalize [gitdir]]
3232                                set ep [file normalize [exec git --exec-path]]
3233                                regsub -all ' $gd "'\\''" gd
3234                                regsub -all ' $ep "'\\''" ep
3235                                puts $fd "#!/bin/sh"
3236                                foreach name [array names env] {
3237                                        if {[string match GIT_* $name]} {
3238                                                regsub -all ' $env($name) "'\\''" v
3239                                                puts $fd "export $name='$v'"
3240                                        }
3241                                }
3242                                puts $fd "export PATH='$ep':\$PATH"
3243                                puts $fd "export GIT_DIR='$gd'"
3244                                puts $fd "exec [file normalize $argv0]"
3245                                close $fd
3246
3247                                file attributes $exe -permissions u+x,g+x,o+x
3248                        } err]} {
3249                        error_popup "Cannot write icon:\n\n$err"
3250                }
3251        }
3252}
3253
3254proc toggle_or_diff {w x y} {
3255        global file_states file_lists current_diff_path ui_index ui_workdir
3256        global last_clicked selected_paths
3257
3258        set pos [split [$w index @$x,$y] .]
3259        set lno [lindex $pos 0]
3260        set col [lindex $pos 1]
3261        set path [lindex $file_lists($w) [expr {$lno - 1}]]
3262        if {$path eq {}} {
3263                set last_clicked {}
3264                return
3265        }
3266
3267        set last_clicked [list $w $lno]
3268        array unset selected_paths
3269        $ui_index tag remove in_sel 0.0 end
3270        $ui_workdir tag remove in_sel 0.0 end
3271
3272        if {$col == 0} {
3273                if {$current_diff_path eq $path} {
3274                        set after {reshow_diff;}
3275                } else {
3276                        set after {}
3277                }
3278                if {$w eq $ui_index} {
3279                        update_indexinfo \
3280                                "Unstaging [short_path $path] from commit" \
3281                                [list $path] \
3282                                [concat $after {set ui_status_value {Ready.}}]
3283                } elseif {$w eq $ui_workdir} {
3284                        update_index \
3285                                "Adding [short_path $path]" \
3286                                [list $path] \
3287                                [concat $after {set ui_status_value {Ready.}}]
3288                }
3289        } else {
3290                show_diff $path $w $lno
3291        }
3292}
3293
3294proc add_one_to_selection {w x y} {
3295        global file_lists last_clicked selected_paths
3296
3297        set lno [lindex [split [$w index @$x,$y] .] 0]
3298        set path [lindex $file_lists($w) [expr {$lno - 1}]]
3299        if {$path eq {}} {
3300                set last_clicked {}
3301                return
3302        }
3303
3304        if {$last_clicked ne {}
3305                && [lindex $last_clicked 0] ne $w} {
3306                array unset selected_paths
3307                [lindex $last_clicked 0] tag remove in_sel 0.0 end
3308        }
3309
3310        set last_clicked [list $w $lno]
3311        if {[catch {set in_sel $selected_paths($path)}]} {
3312                set in_sel 0
3313        }
3314        if {$in_sel} {
3315                unset selected_paths($path)
3316                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3317        } else {
3318                set selected_paths($path) 1
3319                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3320        }
3321}
3322
3323proc add_range_to_selection {w x y} {
3324        global file_lists last_clicked selected_paths
3325
3326        if {[lindex $last_clicked 0] ne $w} {
3327                toggle_or_diff $w $x $y
3328                return
3329        }
3330
3331        set lno [lindex [split [$w index @$x,$y] .] 0]
3332        set lc [lindex $last_clicked 1]
3333        if {$lc < $lno} {
3334                set begin $lc
3335                set end $lno
3336        } else {
3337                set begin $lno
3338                set end $lc
3339        }
3340
3341        foreach path [lrange $file_lists($w) \
3342                [expr {$begin - 1}] \
3343                [expr {$end - 1}]] {
3344                set selected_paths($path) 1
3345        }
3346        $w tag add in_sel $begin.0 [expr {$end + 1}].0
3347}
3348
3349######################################################################
3350##
3351## config defaults
3352
3353set cursor_ptr arrow
3354font create font_diff -family Courier -size 10
3355font create font_ui
3356catch {
3357        label .dummy
3358        eval font configure font_ui [font actual [.dummy cget -font]]
3359        destroy .dummy
3360}
3361
3362font create font_uibold
3363font create font_diffbold
3364
3365if {[is_Windows]} {
3366        set M1B Control
3367        set M1T Ctrl
3368} elseif {[is_MacOSX]} {
3369        set M1B M1
3370        set M1T Cmd
3371} else {
3372        set M1B M1
3373        set M1T M1
3374}
3375
3376proc apply_config {} {
3377        global repo_config font_descs
3378
3379        foreach option $font_descs {
3380                set name [lindex $option 0]
3381                set font [lindex $option 1]
3382                if {[catch {
3383                        foreach {cn cv} $repo_config(gui.$name) {
3384                                font configure $font $cn $cv
3385                        }
3386                        } err]} {
3387                        error_popup "Invalid font specified in gui.$name:\n\n$err"
3388                }
3389                foreach {cn cv} [font configure $font] {
3390                        font configure ${font}bold $cn $cv
3391                }
3392                font configure ${font}bold -weight bold
3393        }
3394}
3395
3396set default_config(gui.trustmtime) false
3397set default_config(gui.pullsummary) true
3398set default_config(gui.diffcontext) 5
3399set default_config(gui.newbranchtemplate) {}
3400set default_config(gui.fontui) [font configure font_ui]
3401set default_config(gui.fontdiff) [font configure font_diff]
3402set font_descs {
3403        {fontui   font_ui   {Main Font}}
3404        {fontdiff font_diff {Diff/Console Font}}
3405}
3406load_config 0
3407apply_config
3408
3409######################################################################
3410##
3411## ui construction
3412
3413# -- Menu Bar
3414#
3415menu .mbar -tearoff 0
3416.mbar add cascade -label Repository -menu .mbar.repository
3417.mbar add cascade -label Edit -menu .mbar.edit
3418if {!$single_commit} {
3419        .mbar add cascade -label Branch -menu .mbar.branch
3420}
3421.mbar add cascade -label Commit -menu .mbar.commit
3422if {!$single_commit} {
3423        .mbar add cascade -label Fetch -menu .mbar.fetch
3424        .mbar add cascade -label Pull -menu .mbar.pull
3425        .mbar add cascade -label Push -menu .mbar.push
3426}
3427. configure -menu .mbar
3428
3429# -- Repository Menu
3430#
3431menu .mbar.repository
3432.mbar.repository add command \
3433        -label {Visualize Current Branch} \
3434        -command {do_gitk {}} \
3435        -font font_ui
3436if {![is_MacOSX]} {
3437        .mbar.repository add command \
3438                -label {Visualize All Branches} \
3439                -command {do_gitk {--all}} \
3440                -font font_ui
3441}
3442.mbar.repository add separator
3443
3444if {!$single_commit} {
3445        .mbar.repository add command -label {Compress Database} \
3446                -command do_gc \
3447                -font font_ui
3448
3449        .mbar.repository add command -label {Verify Database} \
3450                -command do_fsck_objects \
3451                -font font_ui
3452
3453        .mbar.repository add separator
3454
3455        if {[is_Windows]} {
3456                .mbar.repository add command \
3457                        -label {Create Desktop Icon} \
3458                        -command do_windows_shortcut \
3459                        -font font_ui
3460        } elseif {[is_MacOSX]} {
3461                .mbar.repository add command \
3462                        -label {Create Desktop Icon} \
3463                        -command do_macosx_app \
3464                        -font font_ui
3465        }
3466}
3467
3468.mbar.repository add command -label Quit \
3469        -command do_quit \
3470        -accelerator $M1T-Q \
3471        -font font_ui
3472
3473# -- Edit Menu
3474#
3475menu .mbar.edit
3476.mbar.edit add command -label Undo \
3477        -command {catch {[focus] edit undo}} \
3478        -accelerator $M1T-Z \
3479        -font font_ui
3480.mbar.edit add command -label Redo \
3481        -command {catch {[focus] edit redo}} \
3482        -accelerator $M1T-Y \
3483        -font font_ui
3484.mbar.edit add separator
3485.mbar.edit add command -label Cut \
3486        -command {catch {tk_textCut [focus]}} \
3487        -accelerator $M1T-X \
3488        -font font_ui
3489.mbar.edit add command -label Copy \
3490        -command {catch {tk_textCopy [focus]}} \
3491        -accelerator $M1T-C \
3492        -font font_ui
3493.mbar.edit add command -label Paste \
3494        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3495        -accelerator $M1T-V \
3496        -font font_ui
3497.mbar.edit add command -label Delete \
3498        -command {catch {[focus] delete sel.first sel.last}} \
3499        -accelerator Del \
3500        -font font_ui
3501.mbar.edit add separator
3502.mbar.edit add command -label {Select All} \
3503        -command {catch {[focus] tag add sel 0.0 end}} \
3504        -accelerator $M1T-A \
3505        -font font_ui
3506
3507# -- Branch Menu
3508#
3509if {!$single_commit} {
3510        menu .mbar.branch
3511
3512        .mbar.branch add command -label {Create...} \
3513                -command do_create_branch \
3514                -accelerator $M1T-N \
3515                -font font_ui
3516        lappend disable_on_lock [list .mbar.branch entryconf \
3517                [.mbar.branch index last] -state]
3518
3519        .mbar.branch add command -label {Delete...} \
3520                -command do_delete_branch \
3521                -font font_ui
3522        lappend disable_on_lock [list .mbar.branch entryconf \
3523                [.mbar.branch index last] -state]
3524}
3525
3526# -- Commit Menu
3527#
3528menu .mbar.commit
3529
3530.mbar.commit add radiobutton \
3531        -label {New Commit} \
3532        -command do_select_commit_type \
3533        -variable selected_commit_type \
3534        -value new \
3535        -font font_ui
3536lappend disable_on_lock \
3537        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3538
3539.mbar.commit add radiobutton \
3540        -label {Amend Last Commit} \
3541        -command do_select_commit_type \
3542        -variable selected_commit_type \
3543        -value amend \
3544        -font font_ui
3545lappend disable_on_lock \
3546        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3547
3548.mbar.commit add separator
3549
3550.mbar.commit add command -label Rescan \
3551        -command do_rescan \
3552        -accelerator F5 \
3553        -font font_ui
3554lappend disable_on_lock \
3555        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3556
3557.mbar.commit add command -label {Add To Commit} \
3558        -command do_add_selection \
3559        -font font_ui
3560lappend disable_on_lock \
3561        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3562
3563.mbar.commit add command -label {Add All To Commit} \
3564        -command do_add_all \
3565        -accelerator $M1T-I \
3566        -font font_ui
3567lappend disable_on_lock \
3568        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3569
3570.mbar.commit add command -label {Unstage From Commit} \
3571        -command do_unstage_selection \
3572        -font font_ui
3573lappend disable_on_lock \
3574        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3575
3576.mbar.commit add command -label {Revert Changes} \
3577        -command do_revert_selection \
3578        -font font_ui
3579lappend disable_on_lock \
3580        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3581
3582.mbar.commit add separator
3583
3584.mbar.commit add command -label {Sign Off} \
3585        -command do_signoff \
3586        -accelerator $M1T-S \
3587        -font font_ui
3588
3589.mbar.commit add command -label Commit \
3590        -command do_commit \
3591        -accelerator $M1T-Return \
3592        -font font_ui
3593lappend disable_on_lock \
3594        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3595
3596# -- Transport menus
3597#
3598if {!$single_commit} {
3599        menu .mbar.fetch
3600        menu .mbar.pull
3601        menu .mbar.push
3602}
3603
3604if {[is_MacOSX]} {
3605        # -- Apple Menu (Mac OS X only)
3606        #
3607        .mbar add cascade -label Apple -menu .mbar.apple
3608        menu .mbar.apple
3609
3610        .mbar.apple add command -label "About [appname]" \
3611                -command do_about \
3612                -font font_ui
3613        .mbar.apple add command -label "[appname] Options..." \
3614                -command do_options \
3615                -font font_ui
3616} else {
3617        # -- Edit Menu
3618        #
3619        .mbar.edit add separator
3620        .mbar.edit add command -label {Options...} \
3621                -command do_options \
3622                -font font_ui
3623
3624        # -- Tools Menu
3625        #
3626        if {[file exists /usr/local/miga/lib/gui-miga]
3627                && [file exists .pvcsrc]} {
3628        proc do_miga {} {
3629                global ui_status_value
3630                if {![lock_index update]} return
3631                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3632                set miga_fd [open "|$cmd" r]
3633                fconfigure $miga_fd -blocking 0
3634                fileevent $miga_fd readable [list miga_done $miga_fd]
3635                set ui_status_value {Running miga...}
3636        }
3637        proc miga_done {fd} {
3638                read $fd 512
3639                if {[eof $fd]} {
3640                        close $fd
3641                        unlock_index
3642                        rescan [list set ui_status_value {Ready.}]
3643                }
3644        }
3645        .mbar add cascade -label Tools -menu .mbar.tools
3646        menu .mbar.tools
3647        .mbar.tools add command -label "Migrate" \
3648                -command do_miga \
3649                -font font_ui
3650        lappend disable_on_lock \
3651                [list .mbar.tools entryconf [.mbar.tools index last] -state]
3652        }
3653
3654        # -- Help Menu
3655        #
3656        .mbar add cascade -label Help -menu .mbar.help
3657        menu .mbar.help
3658
3659        .mbar.help add command -label "About [appname]" \
3660                -command do_about \
3661                -font font_ui
3662}
3663
3664
3665# -- Branch Control
3666#
3667frame .branch \
3668        -borderwidth 1 \
3669        -relief sunken
3670label .branch.l1 \
3671        -text {Current Branch:} \
3672        -anchor w \
3673        -justify left \
3674        -font font_ui
3675label .branch.cb \
3676        -textvariable current_branch \
3677        -anchor w \
3678        -justify left \
3679        -font font_ui
3680pack .branch.l1 -side left
3681pack .branch.cb -side left -fill x
3682pack .branch -side top -fill x
3683
3684# -- Main Window Layout
3685#
3686panedwindow .vpane -orient vertical
3687panedwindow .vpane.files -orient horizontal
3688.vpane add .vpane.files -sticky nsew -height 100 -width 400
3689pack .vpane -anchor n -side top -fill both -expand 1
3690
3691# -- Index File List
3692#
3693frame .vpane.files.index -height 100 -width 400
3694label .vpane.files.index.title -text {Changes To Be Committed} \
3695        -background green \
3696        -font font_ui
3697text $ui_index -background white -borderwidth 0 \
3698        -width 40 -height 10 \
3699        -wrap none \
3700        -font font_ui \
3701        -cursor $cursor_ptr \
3702        -xscrollcommand {.vpane.files.index.sx set} \
3703        -yscrollcommand {.vpane.files.index.sy set} \
3704        -state disabled
3705scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3706scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3707pack .vpane.files.index.title -side top -fill x
3708pack .vpane.files.index.sx -side bottom -fill x
3709pack .vpane.files.index.sy -side right -fill y
3710pack $ui_index -side left -fill both -expand 1
3711.vpane.files add .vpane.files.index -sticky nsew
3712
3713# -- Working Directory File List
3714#
3715frame .vpane.files.workdir -height 100 -width 100
3716label .vpane.files.workdir.title -text {Changed But Not Updated} \
3717        -background red \
3718        -font font_ui
3719text $ui_workdir -background white -borderwidth 0 \
3720        -width 40 -height 10 \
3721        -wrap none \
3722        -font font_ui \
3723        -cursor $cursor_ptr \
3724        -xscrollcommand {.vpane.files.workdir.sx set} \
3725        -yscrollcommand {.vpane.files.workdir.sy set} \
3726        -state disabled
3727scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3728scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3729pack .vpane.files.workdir.title -side top -fill x
3730pack .vpane.files.workdir.sx -side bottom -fill x
3731pack .vpane.files.workdir.sy -side right -fill y
3732pack $ui_workdir -side left -fill both -expand 1
3733.vpane.files add .vpane.files.workdir -sticky nsew
3734
3735foreach i [list $ui_index $ui_workdir] {
3736        $i tag conf in_diff -font font_uibold
3737        $i tag conf in_sel \
3738                -background [$i cget -foreground] \
3739                -foreground [$i cget -background]
3740}
3741unset i
3742
3743# -- Diff and Commit Area
3744#
3745frame .vpane.lower -height 300 -width 400
3746frame .vpane.lower.commarea
3747frame .vpane.lower.diff -relief sunken -borderwidth 1
3748pack .vpane.lower.commarea -side top -fill x
3749pack .vpane.lower.diff -side bottom -fill both -expand 1
3750.vpane add .vpane.lower -stick nsew
3751
3752# -- Commit Area Buttons
3753#
3754frame .vpane.lower.commarea.buttons
3755label .vpane.lower.commarea.buttons.l -text {} \
3756        -anchor w \
3757        -justify left \
3758        -font font_ui
3759pack .vpane.lower.commarea.buttons.l -side top -fill x
3760pack .vpane.lower.commarea.buttons -side left -fill y
3761
3762button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3763        -command do_rescan \
3764        -font font_ui
3765pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3766lappend disable_on_lock \
3767        {.vpane.lower.commarea.buttons.rescan conf -state}
3768
3769button .vpane.lower.commarea.buttons.incall -text {Add All} \
3770        -command do_add_all \
3771        -font font_ui
3772pack .vpane.lower.commarea.buttons.incall -side top -fill x
3773lappend disable_on_lock \
3774        {.vpane.lower.commarea.buttons.incall conf -state}
3775
3776button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3777        -command do_signoff \
3778        -font font_ui
3779pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3780
3781button .vpane.lower.commarea.buttons.commit -text {Commit} \
3782        -command do_commit \
3783        -font font_ui
3784pack .vpane.lower.commarea.buttons.commit -side top -fill x
3785lappend disable_on_lock \
3786        {.vpane.lower.commarea.buttons.commit conf -state}
3787
3788# -- Commit Message Buffer
3789#
3790frame .vpane.lower.commarea.buffer
3791frame .vpane.lower.commarea.buffer.header
3792set ui_comm .vpane.lower.commarea.buffer.t
3793set ui_coml .vpane.lower.commarea.buffer.header.l
3794radiobutton .vpane.lower.commarea.buffer.header.new \
3795        -text {New Commit} \
3796        -command do_select_commit_type \
3797        -variable selected_commit_type \
3798        -value new \
3799        -font font_ui
3800lappend disable_on_lock \
3801        [list .vpane.lower.commarea.buffer.header.new conf -state]
3802radiobutton .vpane.lower.commarea.buffer.header.amend \
3803        -text {Amend Last Commit} \
3804        -command do_select_commit_type \
3805        -variable selected_commit_type \
3806        -value amend \
3807        -font font_ui
3808lappend disable_on_lock \
3809        [list .vpane.lower.commarea.buffer.header.amend conf -state]
3810label $ui_coml \
3811        -anchor w \
3812        -justify left \
3813        -font font_ui
3814proc trace_commit_type {varname args} {
3815        global ui_coml commit_type
3816        switch -glob -- $commit_type {
3817        initial       {set txt {Initial Commit Message:}}
3818        amend         {set txt {Amended Commit Message:}}
3819        amend-initial {set txt {Amended Initial Commit Message:}}
3820        amend-merge   {set txt {Amended Merge Commit Message:}}
3821        merge         {set txt {Merge Commit Message:}}
3822        *             {set txt {Commit Message:}}
3823        }
3824        $ui_coml conf -text $txt
3825}
3826trace add variable commit_type write trace_commit_type
3827pack $ui_coml -side left -fill x
3828pack .vpane.lower.commarea.buffer.header.amend -side right
3829pack .vpane.lower.commarea.buffer.header.new -side right
3830
3831text $ui_comm -background white -borderwidth 1 \
3832        -undo true \
3833        -maxundo 20 \
3834        -autoseparators true \
3835        -relief sunken \
3836        -width 75 -height 9 -wrap none \
3837        -font font_diff \
3838        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3839scrollbar .vpane.lower.commarea.buffer.sby \
3840        -command [list $ui_comm yview]
3841pack .vpane.lower.commarea.buffer.header -side top -fill x
3842pack .vpane.lower.commarea.buffer.sby -side right -fill y
3843pack $ui_comm -side left -fill y
3844pack .vpane.lower.commarea.buffer -side left -fill y
3845
3846# -- Commit Message Buffer Context Menu
3847#
3848set ctxm .vpane.lower.commarea.buffer.ctxm
3849menu $ctxm -tearoff 0
3850$ctxm add command \
3851        -label {Cut} \
3852        -font font_ui \
3853        -command {tk_textCut $ui_comm}
3854$ctxm add command \
3855        -label {Copy} \
3856        -font font_ui \
3857        -command {tk_textCopy $ui_comm}
3858$ctxm add command \
3859        -label {Paste} \
3860        -font font_ui \
3861        -command {tk_textPaste $ui_comm}
3862$ctxm add command \
3863        -label {Delete} \
3864        -font font_ui \
3865        -command {$ui_comm delete sel.first sel.last}
3866$ctxm add separator
3867$ctxm add command \
3868        -label {Select All} \
3869        -font font_ui \
3870        -command {$ui_comm tag add sel 0.0 end}
3871$ctxm add command \
3872        -label {Copy All} \
3873        -font font_ui \
3874        -command {
3875                $ui_comm tag add sel 0.0 end
3876                tk_textCopy $ui_comm
3877                $ui_comm tag remove sel 0.0 end
3878        }
3879$ctxm add separator
3880$ctxm add command \
3881        -label {Sign Off} \
3882        -font font_ui \
3883        -command do_signoff
3884bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3885
3886# -- Diff Header
3887#
3888set current_diff_path {}
3889set diff_actions [list]
3890proc trace_current_diff_path {varname args} {
3891        global current_diff_path diff_actions file_states
3892        if {$current_diff_path eq {}} {
3893                set s {}
3894                set f {}
3895                set p {}
3896                set o disabled
3897        } else {
3898                set p $current_diff_path
3899                set s [mapdesc [lindex $file_states($p) 0] $p]
3900                set f {File:}
3901                set p [escape_path $p]
3902                set o normal
3903        }
3904
3905        .vpane.lower.diff.header.status configure -text $s
3906        .vpane.lower.diff.header.file configure -text $f
3907        .vpane.lower.diff.header.path configure -text $p
3908        foreach w $diff_actions {
3909                uplevel #0 $w $o
3910        }
3911}
3912trace add variable current_diff_path write trace_current_diff_path
3913
3914frame .vpane.lower.diff.header -background orange
3915label .vpane.lower.diff.header.status \
3916        -background orange \
3917        -width $max_status_desc \
3918        -anchor w \
3919        -justify left \
3920        -font font_ui
3921label .vpane.lower.diff.header.file \
3922        -background orange \
3923        -anchor w \
3924        -justify left \
3925        -font font_ui
3926label .vpane.lower.diff.header.path \
3927        -background orange \
3928        -anchor w \
3929        -justify left \
3930        -font font_ui
3931pack .vpane.lower.diff.header.status -side left
3932pack .vpane.lower.diff.header.file -side left
3933pack .vpane.lower.diff.header.path -fill x
3934set ctxm .vpane.lower.diff.header.ctxm
3935menu $ctxm -tearoff 0
3936$ctxm add command \
3937        -label {Copy} \
3938        -font font_ui \
3939        -command {
3940                clipboard clear
3941                clipboard append \
3942                        -format STRING \
3943                        -type STRING \
3944                        -- $current_diff_path
3945        }
3946lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3947bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3948
3949# -- Diff Body
3950#
3951frame .vpane.lower.diff.body
3952set ui_diff .vpane.lower.diff.body.t
3953text $ui_diff -background white -borderwidth 0 \
3954        -width 80 -height 15 -wrap none \
3955        -font font_diff \
3956        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3957        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3958        -state disabled
3959scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3960        -command [list $ui_diff xview]
3961scrollbar .vpane.lower.diff.body.sby -orient vertical \
3962        -command [list $ui_diff yview]
3963pack .vpane.lower.diff.body.sbx -side bottom -fill x
3964pack .vpane.lower.diff.body.sby -side right -fill y
3965pack $ui_diff -side left -fill both -expand 1
3966pack .vpane.lower.diff.header -side top -fill x
3967pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3968
3969$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3970$ui_diff tag conf d_+ -foreground {#00a000}
3971$ui_diff tag conf d_- -foreground red
3972
3973$ui_diff tag conf d_++ -foreground {#00a000}
3974$ui_diff tag conf d_-- -foreground red
3975$ui_diff tag conf d_+s \
3976        -foreground {#00a000} \
3977        -background {#e2effa}
3978$ui_diff tag conf d_-s \
3979        -foreground red \
3980        -background {#e2effa}
3981$ui_diff tag conf d_s+ \
3982        -foreground {#00a000} \
3983        -background ivory1
3984$ui_diff tag conf d_s- \
3985        -foreground red \
3986        -background ivory1
3987
3988$ui_diff tag conf d<<<<<<< \
3989        -foreground orange \
3990        -font font_diffbold
3991$ui_diff tag conf d======= \
3992        -foreground orange \
3993        -font font_diffbold
3994$ui_diff tag conf d>>>>>>> \
3995        -foreground orange \
3996        -font font_diffbold
3997
3998$ui_diff tag raise sel
3999
4000# -- Diff Body Context Menu
4001#
4002set ctxm .vpane.lower.diff.body.ctxm
4003menu $ctxm -tearoff 0
4004$ctxm add command \
4005        -label {Refresh} \
4006        -font font_ui \
4007        -command reshow_diff
4008$ctxm add command \
4009        -label {Copy} \
4010        -font font_ui \
4011        -command {tk_textCopy $ui_diff}
4012lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4013$ctxm add command \
4014        -label {Select All} \
4015        -font font_ui \
4016        -command {$ui_diff tag add sel 0.0 end}
4017lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4018$ctxm add command \
4019        -label {Copy All} \
4020        -font font_ui \
4021        -command {
4022                $ui_diff tag add sel 0.0 end
4023                tk_textCopy $ui_diff
4024                $ui_diff tag remove sel 0.0 end
4025        }
4026lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4027$ctxm add separator
4028$ctxm add command \
4029        -label {Decrease Font Size} \
4030        -font font_ui \
4031        -command {incr_font_size font_diff -1}
4032lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4033$ctxm add command \
4034        -label {Increase Font Size} \
4035        -font font_ui \
4036        -command {incr_font_size font_diff 1}
4037lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4038$ctxm add separator
4039$ctxm add command \
4040        -label {Show Less Context} \
4041        -font font_ui \
4042        -command {if {$repo_config(gui.diffcontext) >= 2} {
4043                incr repo_config(gui.diffcontext) -1
4044                reshow_diff
4045        }}
4046lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4047$ctxm add command \
4048        -label {Show More Context} \
4049        -font font_ui \
4050        -command {
4051                incr repo_config(gui.diffcontext)
4052                reshow_diff
4053        }
4054lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4055$ctxm add separator
4056$ctxm add command -label {Options...} \
4057        -font font_ui \
4058        -command do_options
4059bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
4060
4061# -- Status Bar
4062#
4063set ui_status_value {Initializing...}
4064label .status -textvariable ui_status_value \
4065        -anchor w \
4066        -justify left \
4067        -borderwidth 1 \
4068        -relief sunken \
4069        -font font_ui
4070pack .status -anchor w -side bottom -fill x
4071
4072# -- Load geometry
4073#
4074catch {
4075set gm $repo_config(gui.geometry)
4076wm geometry . [lindex $gm 0]
4077.vpane sash place 0 \
4078        [lindex [.vpane sash coord 0] 0] \
4079        [lindex $gm 1]
4080.vpane.files sash place 0 \
4081        [lindex $gm 2] \
4082        [lindex [.vpane.files sash coord 0] 1]
4083unset gm
4084}
4085
4086# -- Key Bindings
4087#
4088bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4089bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4090bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4091bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4092bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4093bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4094bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4095bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4096bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4097bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4098bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4099
4100bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4101bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4102bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4103bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4104bind $ui_diff <$M1B-Key-v> {break}
4105bind $ui_diff <$M1B-Key-V> {break}
4106bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4107bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4108bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4109bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4110bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4111bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4112
4113if {!$single_commit} {
4114        bind . <$M1B-Key-n> do_create_branch
4115        bind . <$M1B-Key-N> do_create_branch
4116}
4117
4118bind .   <Destroy> do_quit
4119bind all <Key-F5> do_rescan
4120bind all <$M1B-Key-r> do_rescan
4121bind all <$M1B-Key-R> do_rescan
4122bind .   <$M1B-Key-s> do_signoff
4123bind .   <$M1B-Key-S> do_signoff
4124bind .   <$M1B-Key-i> do_add_all
4125bind .   <$M1B-Key-I> do_add_all
4126bind .   <$M1B-Key-Return> do_commit
4127bind all <$M1B-Key-q> do_quit
4128bind all <$M1B-Key-Q> do_quit
4129bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4130bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4131foreach i [list $ui_index $ui_workdir] {
4132        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4133        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4134        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4135}
4136unset i
4137
4138set file_lists($ui_index) [list]
4139set file_lists($ui_workdir) [list]
4140
4141set HEAD {}
4142set PARENT {}
4143set MERGE_HEAD [list]
4144set commit_type {}
4145set empty_tree {}
4146set current_branch {}
4147set current_diff_path {}
4148set selected_commit_type new
4149
4150wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4151focus -force $ui_comm
4152
4153# -- Warn the user about environmental problems.  Cygwin's Tcl
4154#    does *not* pass its env array onto any processes it spawns.
4155#    This means that git processes get none of our environment.
4156#
4157if {[is_Windows]} {
4158        set ignored_env 0
4159        set suggest_user {}
4160        set msg "Possible environment issues exist.
4161
4162The following environment variables are probably
4163going to be ignored by any Git subprocess run
4164by [appname]:
4165
4166"
4167        foreach name [array names env] {
4168                switch -regexp -- $name {
4169                {^GIT_INDEX_FILE$} -
4170                {^GIT_OBJECT_DIRECTORY$} -
4171                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4172                {^GIT_DIFF_OPTS$} -
4173                {^GIT_EXTERNAL_DIFF$} -
4174                {^GIT_PAGER$} -
4175                {^GIT_TRACE$} -
4176                {^GIT_CONFIG$} -
4177                {^GIT_CONFIG_LOCAL$} -
4178                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4179                        append msg " - $name\n"
4180                        incr ignored_env
4181                }
4182                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4183                        append msg " - $name\n"
4184                        incr ignored_env
4185                        set suggest_user $name
4186                }
4187                }
4188        }
4189        if {$ignored_env > 0} {
4190                append msg "
4191This is due to a known issue with the
4192Tcl binary distributed by Cygwin."
4193
4194                if {$suggest_user ne {}} {
4195                        append msg "
4196
4197A good replacement for $suggest_user
4198is placing values for the user.name and
4199user.email settings into your personal
4200~/.gitconfig file.
4201"
4202                }
4203                warn_popup $msg
4204        }
4205        unset ignored_env msg suggest_user name
4206}
4207
4208# -- Only initialize complex UI if we are going to stay running.
4209#
4210if {!$single_commit} {
4211        load_all_remotes
4212        load_all_heads
4213
4214        populate_branch_menu
4215        populate_fetch_menu .mbar.fetch
4216        populate_pull_menu .mbar.pull
4217        populate_push_menu .mbar.push
4218}
4219
4220# -- Only suggest a gc run if we are going to stay running.
4221#
4222if {!$single_commit} {
4223        set object_limit 2000
4224        if {[is_Windows]} {set object_limit 200}
4225        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4226        if {$objects_current >= $object_limit} {
4227                if {[ask_popup \
4228                        "This repository currently has $objects_current loose objects.
4229
4230To maintain optimal performance it is strongly
4231recommended that you compress the database
4232when more than $object_limit loose objects exist.
4233
4234Compress the database now?"] eq yes} {
4235                        do_gc
4236                }
4237        }
4238        unset object_limit _junk objects_current
4239}
4240
4241lock_index begin-read
4242after 1 do_rescan