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