git-guion commit git-gui: Restore the all important shebang line. (bd11b82)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10set appname [lindex [file split $argv0] end]
  11set gitdir {}
  12
  13######################################################################
  14##
  15## config
  16
  17proc is_many_config {name} {
  18        switch -glob -- $name {
  19        remote.*.fetch -
  20        remote.*.push
  21                {return 1}
  22        *
  23                {return 0}
  24        }
  25}
  26
  27proc load_config {include_global} {
  28        global repo_config global_config default_config
  29
  30        array unset global_config
  31        if {$include_global} {
  32                catch {
  33                        set fd_rc [open "| git repo-config --global --list" r]
  34                        while {[gets $fd_rc line] >= 0} {
  35                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                        if {[is_many_config $name]} {
  37                                                lappend global_config($name) $value
  38                                        } else {
  39                                                set global_config($name) $value
  40                                        }
  41                                }
  42                        }
  43                        close $fd_rc
  44                }
  45        }
  46
  47        array unset repo_config
  48        catch {
  49                set fd_rc [open "| git repo-config --list" r]
  50                while {[gets $fd_rc line] >= 0} {
  51                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                if {[is_many_config $name]} {
  53                                        lappend repo_config($name) $value
  54                                } else {
  55                                        set repo_config($name) $value
  56                                }
  57                        }
  58                }
  59                close $fd_rc
  60        }
  61
  62        foreach name [array names default_config] {
  63                if {[catch {set v $global_config($name)}]} {
  64                        set global_config($name) $default_config($name)
  65                }
  66                if {[catch {set v $repo_config($name)}]} {
  67                        set repo_config($name) $default_config($name)
  68                }
  69        }
  70}
  71
  72proc save_config {} {
  73        global default_config font_descs
  74        global repo_config global_config
  75        global repo_config_new global_config_new
  76
  77        foreach option $font_descs {
  78                set name [lindex $option 0]
  79                set font [lindex $option 1]
  80                font configure $font \
  81                        -family $global_config_new(gui.$font^^family) \
  82                        -size $global_config_new(gui.$font^^size)
  83                font configure ${font}bold \
  84                        -family $global_config_new(gui.$font^^family) \
  85                        -size $global_config_new(gui.$font^^size)
  86                set global_config_new(gui.$name) [font configure $font]
  87                unset global_config_new(gui.$font^^family)
  88                unset global_config_new(gui.$font^^size)
  89        }
  90
  91        foreach name [array names default_config] {
  92                set value $global_config_new($name)
  93                if {$value ne $global_config($name)} {
  94                        if {$value eq $default_config($name)} {
  95                                catch {exec git repo-config --global --unset $name}
  96                        } else {
  97                                regsub -all "\[{}\]" $value {"} value
  98                                exec git repo-config --global $name $value
  99                        }
 100                        set global_config($name) $value
 101                        if {$value eq $repo_config($name)} {
 102                                catch {exec git repo-config --unset $name}
 103                                set repo_config($name) $value
 104                        }
 105                }
 106        }
 107
 108        foreach name [array names default_config] {
 109                set value $repo_config_new($name)
 110                if {$value ne $repo_config($name)} {
 111                        if {$value eq $global_config($name)} {
 112                                catch {exec git repo-config --unset $name}
 113                        } else {
 114                                regsub -all "\[{}\]" $value {"} value
 115                                exec git repo-config $name $value
 116                        }
 117                        set repo_config($name) $value
 118                }
 119        }
 120}
 121
 122proc error_popup {msg} {
 123        global gitdir appname
 124
 125        set title $appname
 126        if {$gitdir ne {}} {
 127                append title { (}
 128                append title [lindex \
 129                        [file split [file normalize [file dirname $gitdir]]] \
 130                        end]
 131                append title {)}
 132        }
 133        set cmd [list tk_messageBox \
 134                -icon error \
 135                -type ok \
 136                -title "$title: error" \
 137                -message $msg]
 138        if {[winfo ismapped .]} {
 139                lappend cmd -parent .
 140        }
 141        eval $cmd
 142}
 143
 144proc info_popup {msg} {
 145        global gitdir appname
 146
 147        set title $appname
 148        if {$gitdir ne {}} {
 149                append title { (}
 150                append title [lindex \
 151                        [file split [file normalize [file dirname $gitdir]]] \
 152                        end]
 153                append title {)}
 154        }
 155        tk_messageBox \
 156                -parent . \
 157                -icon error \
 158                -type ok \
 159                -title $title \
 160                -message $msg
 161}
 162
 163######################################################################
 164##
 165## repository setup
 166
 167if {   [catch {set gitdir $env(GIT_DIR)}]
 168        && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 169        catch {wm withdraw .}
 170        error_popup "Cannot find the git directory:\n\n$err"
 171        exit 1
 172}
 173if {![file isdirectory $gitdir]} {
 174        catch {wm withdraw .}
 175        error_popup "Git directory not found:\n\n$gitdir"
 176        exit 1
 177}
 178if {[lindex [file split $gitdir] end] ne {.git}} {
 179        catch {wm withdraw .}
 180        error_popup "Cannot use funny .git directory:\n\n$gitdir"
 181        exit 1
 182}
 183if {[catch {cd [file dirname $gitdir]} err]} {
 184        catch {wm withdraw .}
 185        error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 186        exit 1
 187}
 188
 189set single_commit 0
 190if {$appname eq {git-citool}} {
 191        set single_commit 1
 192}
 193
 194######################################################################
 195##
 196## task management
 197
 198set rescan_active 0
 199set diff_active 0
 200set last_clicked {}
 201
 202set disable_on_lock [list]
 203set index_lock_type none
 204
 205proc lock_index {type} {
 206        global index_lock_type disable_on_lock
 207
 208        if {$index_lock_type eq {none}} {
 209                set index_lock_type $type
 210                foreach w $disable_on_lock {
 211                        uplevel #0 $w disabled
 212                }
 213                return 1
 214        } elseif {$index_lock_type eq "begin-$type"} {
 215                set index_lock_type $type
 216                return 1
 217        }
 218        return 0
 219}
 220
 221proc unlock_index {} {
 222        global index_lock_type disable_on_lock
 223
 224        set index_lock_type none
 225        foreach w $disable_on_lock {
 226                uplevel #0 $w normal
 227        }
 228}
 229
 230######################################################################
 231##
 232## status
 233
 234proc repository_state {hdvar ctvar} {
 235        global gitdir
 236        upvar $hdvar hd $ctvar ct
 237
 238        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 239                set hd {}
 240                set ct initial
 241        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 242                set ct merge
 243        } else {
 244                set ct normal
 245        }
 246}
 247
 248proc PARENT {} {
 249        global PARENT empty_tree
 250
 251        if {$PARENT ne {}} {
 252                return $PARENT
 253        }
 254        if {$empty_tree eq {}} {
 255                set empty_tree [exec git mktree << {}]
 256        }
 257        return $empty_tree
 258}
 259
 260proc rescan {after} {
 261        global HEAD PARENT commit_type
 262        global ui_index ui_other ui_status_value ui_comm
 263        global rescan_active file_states
 264        global repo_config
 265
 266        if {$rescan_active > 0 || ![lock_index read]} return
 267
 268        repository_state new_HEAD new_type
 269        if {[string match amend* $commit_type]
 270                && $new_type eq {normal}
 271                && $new_HEAD eq $HEAD} {
 272        } else {
 273                set HEAD $new_HEAD
 274                set PARENT $new_HEAD
 275                set commit_type $new_type
 276        }
 277
 278        array unset file_states
 279
 280        if {![$ui_comm edit modified]
 281                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 282                if {[load_message GITGUI_MSG]} {
 283                } elseif {[load_message MERGE_MSG]} {
 284                } elseif {[load_message SQUASH_MSG]} {
 285                }
 286                $ui_comm edit modified false
 287                $ui_comm edit reset
 288        }
 289
 290        if {$repo_config(gui.trustmtime) eq {true}} {
 291                rescan_stage2 {} $after
 292        } else {
 293                set rescan_active 1
 294                set ui_status_value {Refreshing file status...}
 295                set cmd [list git update-index]
 296                lappend cmd -q
 297                lappend cmd --unmerged
 298                lappend cmd --ignore-missing
 299                lappend cmd --refresh
 300                set fd_rf [open "| $cmd" r]
 301                fconfigure $fd_rf -blocking 0 -translation binary
 302                fileevent $fd_rf readable \
 303                        [list rescan_stage2 $fd_rf $after]
 304        }
 305}
 306
 307proc rescan_stage2 {fd after} {
 308        global gitdir ui_status_value
 309        global rescan_active buf_rdi buf_rdf buf_rlo
 310
 311        if {$fd ne {}} {
 312                read $fd
 313                if {![eof $fd]} return
 314                close $fd
 315        }
 316
 317        set ls_others [list | git ls-files --others -z \
 318                --exclude-per-directory=.gitignore]
 319        set info_exclude [file join $gitdir info exclude]
 320        if {[file readable $info_exclude]} {
 321                lappend ls_others "--exclude-from=$info_exclude"
 322        }
 323
 324        set buf_rdi {}
 325        set buf_rdf {}
 326        set buf_rlo {}
 327
 328        set rescan_active 3
 329        set ui_status_value {Scanning for modified files ...}
 330        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 331        set fd_df [open "| git diff-files -z" r]
 332        set fd_lo [open $ls_others r]
 333
 334        fconfigure $fd_di -blocking 0 -translation binary
 335        fconfigure $fd_df -blocking 0 -translation binary
 336        fconfigure $fd_lo -blocking 0 -translation binary
 337        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 338        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 339        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 340}
 341
 342proc load_message {file} {
 343        global gitdir ui_comm
 344
 345        set f [file join $gitdir $file]
 346        if {[file isfile $f]} {
 347                if {[catch {set fd [open $f r]}]} {
 348                        return 0
 349                }
 350                set content [string trim [read $fd]]
 351                close $fd
 352                $ui_comm delete 0.0 end
 353                $ui_comm insert end $content
 354                return 1
 355        }
 356        return 0
 357}
 358
 359proc read_diff_index {fd after} {
 360        global buf_rdi
 361
 362        append buf_rdi [read $fd]
 363        set c 0
 364        set n [string length $buf_rdi]
 365        while {$c < $n} {
 366                set z1 [string first "\0" $buf_rdi $c]
 367                if {$z1 == -1} break
 368                incr z1
 369                set z2 [string first "\0" $buf_rdi $z1]
 370                if {$z2 == -1} break
 371
 372                incr c
 373                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 374                merge_state \
 375                        [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 376                        [lindex $i 4]? \
 377                        [list [lindex $i 0] [lindex $i 2]] \
 378                        [list]
 379                set c $z2
 380                incr c
 381        }
 382        if {$c < $n} {
 383                set buf_rdi [string range $buf_rdi $c end]
 384        } else {
 385                set buf_rdi {}
 386        }
 387
 388        rescan_done $fd buf_rdi $after
 389}
 390
 391proc read_diff_files {fd after} {
 392        global buf_rdf
 393
 394        append buf_rdf [read $fd]
 395        set c 0
 396        set n [string length $buf_rdf]
 397        while {$c < $n} {
 398                set z1 [string first "\0" $buf_rdf $c]
 399                if {$z1 == -1} break
 400                incr z1
 401                set z2 [string first "\0" $buf_rdf $z1]
 402                if {$z2 == -1} break
 403
 404                incr c
 405                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 406                merge_state \
 407                        [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 408                        ?[lindex $i 4] \
 409                        [list] \
 410                        [list [lindex $i 0] [lindex $i 2]]
 411                set c $z2
 412                incr c
 413        }
 414        if {$c < $n} {
 415                set buf_rdf [string range $buf_rdf $c end]
 416        } else {
 417                set buf_rdf {}
 418        }
 419
 420        rescan_done $fd buf_rdf $after
 421}
 422
 423proc read_ls_others {fd after} {
 424        global buf_rlo
 425
 426        append buf_rlo [read $fd]
 427        set pck [split $buf_rlo "\0"]
 428        set buf_rlo [lindex $pck end]
 429        foreach p [lrange $pck 0 end-1] {
 430                merge_state $p ?O
 431        }
 432        rescan_done $fd buf_rlo $after
 433}
 434
 435proc rescan_done {fd buf after} {
 436        global rescan_active
 437        global file_states repo_config
 438        upvar $buf to_clear
 439
 440        if {![eof $fd]} return
 441        set to_clear {}
 442        close $fd
 443        if {[incr rescan_active -1] > 0} return
 444
 445        prune_selection
 446        unlock_index
 447        display_all_files
 448
 449        if {$repo_config(gui.partialinclude) ne {true}} {
 450                set pathList [list]
 451                foreach path [array names file_states] {
 452                        switch -- [lindex $file_states($path) 0] {
 453                        AM -
 454                        MM {lappend pathList $path}
 455                        }
 456                }
 457                if {$pathList ne {}} {
 458                        update_index \
 459                                "Updating included files" \
 460                                $pathList \
 461                                [concat {reshow_diff;} $after]
 462                        return
 463                }
 464        }
 465
 466        reshow_diff
 467        uplevel #0 $after
 468}
 469
 470proc prune_selection {} {
 471        global file_states selected_paths
 472
 473        foreach path [array names selected_paths] {
 474                if {[catch {set still_here $file_states($path)}]} {
 475                        unset selected_paths($path)
 476                }
 477        }
 478}
 479
 480######################################################################
 481##
 482## diff
 483
 484proc clear_diff {} {
 485        global ui_diff current_diff ui_index ui_other
 486
 487        $ui_diff conf -state normal
 488        $ui_diff delete 0.0 end
 489        $ui_diff conf -state disabled
 490
 491        set current_diff {}
 492
 493        $ui_index tag remove in_diff 0.0 end
 494        $ui_other tag remove in_diff 0.0 end
 495}
 496
 497proc reshow_diff {} {
 498        global current_diff ui_status_value file_states
 499
 500        if {$current_diff eq {}
 501                || [catch {set s $file_states($current_diff)}]} {
 502                clear_diff
 503        } else {
 504                show_diff $current_diff
 505        }
 506}
 507
 508proc handle_empty_diff {} {
 509        global current_diff file_states file_lists
 510
 511        set path $current_diff
 512        set s $file_states($path)
 513        if {[lindex $s 0] ne {_M}} return
 514
 515        info_popup "No differences detected.
 516
 517[short_path $path] has no changes.
 518
 519The modification date of this file was updated
 520by another application and you currently have
 521the Trust File Modification Timestamps option
 522enabled, so Git did not automatically detect
 523that there are no content differences in this
 524file.
 525
 526This file will now be removed from the modified
 527files list, to prevent possible confusion.
 528"
 529        if {[catch {exec git update-index -- $path} err]} {
 530                error_popup "Failed to refresh index:\n\n$err"
 531        }
 532
 533        clear_diff
 534        set old_w [mapcol [lindex $file_states($path) 0] $path]
 535        set lno [lsearch -sorted $file_lists($old_w) $path]
 536        if {$lno >= 0} {
 537                set file_lists($old_w) \
 538                        [lreplace $file_lists($old_w) $lno $lno]
 539                incr lno
 540                $old_w conf -state normal
 541                $old_w delete $lno.0 [expr {$lno + 1}].0
 542                $old_w conf -state disabled
 543        }
 544}
 545
 546proc show_diff {path {w {}} {lno {}}} {
 547        global file_states file_lists
 548        global is_3way_diff diff_active repo_config
 549        global ui_diff current_diff ui_status_value
 550
 551        if {$diff_active || ![lock_index read]} return
 552
 553        clear_diff
 554        if {$w eq {} || $lno == {}} {
 555                foreach w [array names file_lists] {
 556                        set lno [lsearch -sorted $file_lists($w) $path]
 557                        if {$lno >= 0} {
 558                                incr lno
 559                                break
 560                        }
 561                }
 562        }
 563        if {$w ne {} && $lno >= 1} {
 564                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 565        }
 566
 567        set s $file_states($path)
 568        set m [lindex $s 0]
 569        set is_3way_diff 0
 570        set diff_active 1
 571        set current_diff $path
 572        set ui_status_value "Loading diff of [escape_path $path]..."
 573
 574        set cmd [list | git diff-index]
 575        lappend cmd --no-color
 576        if {$repo_config(gui.diffcontext) > 0} {
 577                lappend cmd "-U$repo_config(gui.diffcontext)"
 578        }
 579        lappend cmd -p
 580
 581        switch $m {
 582        MM {
 583                lappend cmd -c
 584        }
 585        _O {
 586                if {[catch {
 587                                set fd [open $path r]
 588                                set content [read $fd]
 589                                close $fd
 590                        } err ]} {
 591                        set diff_active 0
 592                        unlock_index
 593                        set ui_status_value "Unable to display [escape_path $path]"
 594                        error_popup "Error loading file:\n\n$err"
 595                        return
 596                }
 597                $ui_diff conf -state normal
 598                $ui_diff insert end $content
 599                $ui_diff conf -state disabled
 600                set diff_active 0
 601                unlock_index
 602                set ui_status_value {Ready.}
 603                return
 604        }
 605        }
 606
 607        lappend cmd [PARENT]
 608        lappend cmd --
 609        lappend cmd $path
 610
 611        if {[catch {set fd [open $cmd r]} err]} {
 612                set diff_active 0
 613                unlock_index
 614                set ui_status_value "Unable to display [escape_path $path]"
 615                error_popup "Error loading diff:\n\n$err"
 616                return
 617        }
 618
 619        fconfigure $fd -blocking 0 -translation auto
 620        fileevent $fd readable [list read_diff $fd]
 621}
 622
 623proc read_diff {fd} {
 624        global ui_diff ui_status_value is_3way_diff diff_active
 625        global repo_config
 626
 627        $ui_diff conf -state normal
 628        while {[gets $fd line] >= 0} {
 629                # -- Cleanup uninteresting diff header lines.
 630                #
 631                if {[string match {diff --git *}      $line]} continue
 632                if {[string match {diff --combined *} $line]} continue
 633                if {[string match {--- *}             $line]} continue
 634                if {[string match {+++ *}             $line]} continue
 635                if {$line eq {deleted file mode 120000}} {
 636                        set line "deleted symlink"
 637                }
 638
 639                # -- Automatically detect if this is a 3 way diff.
 640                #
 641                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 642
 643                # -- Reformat a 3 way diff, 'cause its too weird.
 644                #
 645                if {$is_3way_diff} {
 646                        set op [string range $line 0 1]
 647                        switch -- $op {
 648                        {@@} {set tags d_@}
 649                        {++} {set tags d_+ ; set op { +}}
 650                        {--} {set tags d_- ; set op { -}}
 651                        { +} {set tags d_++; set op {++}}
 652                        { -} {set tags d_--; set op {--}}
 653                        {+ } {set tags d_-+; set op {-+}}
 654                        {- } {set tags d_+-; set op {+-}}
 655                        default {set tags {}}
 656                        }
 657                        set line [string replace $line 0 1 $op]
 658                } else {
 659                        switch -- [string index $line 0] {
 660                        @ {set tags d_@}
 661                        + {set tags d_+}
 662                        - {set tags d_-}
 663                        default {set tags {}}
 664                        }
 665                }
 666                $ui_diff insert end $line $tags
 667                $ui_diff insert end "\n" $tags
 668        }
 669        $ui_diff conf -state disabled
 670
 671        if {[eof $fd]} {
 672                close $fd
 673                set diff_active 0
 674                unlock_index
 675                set ui_status_value {Ready.}
 676
 677                if {$repo_config(gui.trustmtime) eq {true}
 678                        && [$ui_diff index end] eq {2.0}} {
 679                        handle_empty_diff
 680                }
 681        }
 682}
 683
 684######################################################################
 685##
 686## commit
 687
 688proc load_last_commit {} {
 689        global HEAD PARENT commit_type ui_comm
 690
 691        if {[string match amend* $commit_type]} return
 692        if {$commit_type ne {normal}} {
 693                error_popup "Can't amend a $commit_type commit."
 694                return
 695        }
 696
 697        set msg {}
 698        set parent {}
 699        set parent_count 0
 700        if {[catch {
 701                        set fd [open "| git cat-file commit $HEAD" r]
 702                        while {[gets $fd line] > 0} {
 703                                if {[string match {parent *} $line]} {
 704                                        set parent [string range $line 7 end]
 705                                        incr parent_count
 706                                }
 707                        }
 708                        set msg [string trim [read $fd]]
 709                        close $fd
 710                } err]} {
 711                error_popup "Error loading commit data for amend:\n\n$err"
 712                return
 713        }
 714
 715        if {$parent_count > 1} {
 716                error_popup {Can't amend a merge commit.}
 717                return
 718        }
 719
 720        if {$parent_count == 0} {
 721                set commit_type amend-initial
 722                set PARENT {}
 723        } elseif {$parent_count == 1} {
 724                set commit_type amend
 725                set PARENT $parent
 726        }
 727
 728        $ui_comm delete 0.0 end
 729        $ui_comm insert end $msg
 730        $ui_comm edit modified false
 731        $ui_comm edit reset
 732        rescan {set ui_status_value {Ready.}}
 733}
 734
 735proc create_new_commit {} {
 736        global commit_type ui_comm
 737
 738        set commit_type normal
 739        $ui_comm delete 0.0 end
 740        $ui_comm edit modified false
 741        $ui_comm edit reset
 742        rescan {set ui_status_value {Ready.}}
 743}
 744
 745set GIT_COMMITTER_IDENT {}
 746
 747proc committer_ident {} {
 748        global GIT_COMMITTER_IDENT
 749
 750        if {$GIT_COMMITTER_IDENT eq {}} {
 751                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 752                        error_popup "Unable to obtain your identity:\n\n$err"
 753                        return {}
 754                }
 755                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 756                        $me me GIT_COMMITTER_IDENT]} {
 757                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 758                        return {}
 759                }
 760        }
 761
 762        return $GIT_COMMITTER_IDENT
 763}
 764
 765proc commit_tree {} {
 766        global HEAD commit_type file_states ui_comm repo_config
 767
 768        if {![lock_index update]} return
 769        if {[committer_ident] eq {}} return
 770
 771        # -- Our in memory state should match the repository.
 772        #
 773        repository_state curHEAD cur_type
 774        if {[string match amend* $commit_type]
 775                && $cur_type eq {normal}
 776                && $curHEAD eq $HEAD} {
 777        } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 778                info_popup {Last scanned state does not match repository state.
 779
 780Another Git program has modified this repository
 781since the last scan.  A rescan must be performed
 782before another commit can be created.
 783
 784The rescan will be automatically started now.
 785}
 786                unlock_index
 787                rescan {set ui_status_value {Ready.}}
 788                return
 789        }
 790
 791        # -- At least one file should differ in the index.
 792        #
 793        set files_ready 0
 794        foreach path [array names file_states] {
 795                switch -glob -- [lindex $file_states($path) 0] {
 796                _? {continue}
 797                A? -
 798                D? -
 799                M? {set files_ready 1; break}
 800                U? {
 801                        error_popup "Unmerged files cannot be committed.
 802
 803File [short_path $path] has merge conflicts.
 804You must resolve them and include the file before committing.
 805"
 806                        unlock_index
 807                        return
 808                }
 809                default {
 810                        error_popup "Unknown file state [lindex $s 0] detected.
 811
 812File [short_path $path] cannot be committed by this program.
 813"
 814                }
 815                }
 816        }
 817        if {!$files_ready} {
 818                error_popup {No included files to commit.
 819
 820You must include at least 1 file before you can commit.
 821}
 822                unlock_index
 823                return
 824        }
 825
 826        # -- A message is required.
 827        #
 828        set msg [string trim [$ui_comm get 1.0 end]]
 829        if {$msg eq {}} {
 830                error_popup {Please supply a commit message.
 831
 832A good commit message has the following format:
 833
 834- First line: Describe in one sentance what you did.
 835- Second line: Blank
 836- Remaining lines: Describe why this change is good.
 837}
 838                unlock_index
 839                return
 840        }
 841
 842        # -- Update included files if partialincludes are off.
 843        #
 844        if {$repo_config(gui.partialinclude) ne {true}} {
 845                set pathList [list]
 846                foreach path [array names file_states] {
 847                        switch -glob -- [lindex $file_states($path) 0] {
 848                        A? -
 849                        M? {lappend pathList $path}
 850                        }
 851                }
 852                if {$pathList ne {}} {
 853                        unlock_index
 854                        update_index \
 855                                "Updating included files" \
 856                                $pathList \
 857                                [concat {lock_index update;} \
 858                                        [list commit_prehook $curHEAD $msg]]
 859                        return
 860                }
 861        }
 862
 863        commit_prehook $curHEAD $msg
 864}
 865
 866proc commit_prehook {curHEAD msg} {
 867        global tcl_platform gitdir ui_status_value pch_error
 868
 869        # On Cygwin [file executable] might lie so we need to ask
 870        # the shell if the hook is executable.  Yes that's annoying.
 871
 872        set pchook [file join $gitdir hooks pre-commit]
 873        if {$tcl_platform(platform) eq {windows}
 874                && [file isfile $pchook]} {
 875                set pchook [list sh -c [concat \
 876                        "if test -x \"$pchook\";" \
 877                        "then exec \"$pchook\" 2>&1;" \
 878                        "fi"]]
 879        } elseif {[file executable $pchook]} {
 880                set pchook [list $pchook |& cat]
 881        } else {
 882                commit_writetree $curHEAD $msg
 883                return
 884        }
 885
 886        set ui_status_value {Calling pre-commit hook...}
 887        set pch_error {}
 888        set fd_ph [open "| $pchook" r]
 889        fconfigure $fd_ph -blocking 0 -translation binary
 890        fileevent $fd_ph readable \
 891                [list commit_prehook_wait $fd_ph $curHEAD $msg]
 892}
 893
 894proc commit_prehook_wait {fd_ph curHEAD msg} {
 895        global pch_error ui_status_value
 896
 897        append pch_error [read $fd_ph]
 898        fconfigure $fd_ph -blocking 1
 899        if {[eof $fd_ph]} {
 900                if {[catch {close $fd_ph}]} {
 901                        set ui_status_value {Commit declined by pre-commit hook.}
 902                        hook_failed_popup pre-commit $pch_error
 903                        unlock_index
 904                } else {
 905                        commit_writetree $curHEAD $msg
 906                }
 907                set pch_error {}
 908                return
 909        }
 910        fconfigure $fd_ph -blocking 0
 911}
 912
 913proc commit_writetree {curHEAD msg} {
 914        global ui_status_value
 915
 916        set ui_status_value {Committing changes...}
 917        set fd_wt [open "| git write-tree" r]
 918        fileevent $fd_wt readable \
 919                [list commit_committree $fd_wt $curHEAD $msg]
 920}
 921
 922proc commit_committree {fd_wt curHEAD msg} {
 923        global single_commit gitdir HEAD PARENT commit_type tcl_platform
 924        global ui_status_value ui_comm selected_commit_type
 925        global file_states selected_paths
 926
 927        gets $fd_wt tree_id
 928        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 929                error_popup "write-tree failed:\n\n$err"
 930                set ui_status_value {Commit failed.}
 931                unlock_index
 932                return
 933        }
 934
 935        # -- Create the commit.
 936        #
 937        set cmd [list git commit-tree $tree_id]
 938        if {$PARENT ne {}} {
 939                lappend cmd -p $PARENT
 940        }
 941        if {$commit_type eq {merge}} {
 942                if {[catch {
 943                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 944                                while {[gets $fd_mh merge_head] >= 0} {
 945                                        lappend cmd -p $merge_head
 946                                }
 947                                close $fd_mh
 948                        } err]} {
 949                        error_popup "Loading MERGE_HEAD failed:\n\n$err"
 950                        set ui_status_value {Commit failed.}
 951                        unlock_index
 952                        return
 953                }
 954        }
 955        if {$PARENT eq {}} {
 956                # git commit-tree writes to stderr during initial commit.
 957                lappend cmd 2>/dev/null
 958        }
 959        lappend cmd << $msg
 960        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 961                error_popup "commit-tree failed:\n\n$err"
 962                set ui_status_value {Commit failed.}
 963                unlock_index
 964                return
 965        }
 966
 967        # -- Update the HEAD ref.
 968        #
 969        set reflogm commit
 970        if {$commit_type ne {normal}} {
 971                append reflogm " ($commit_type)"
 972        }
 973        set i [string first "\n" $msg]
 974        if {$i >= 0} {
 975                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 976        } else {
 977                append reflogm {: } $msg
 978        }
 979        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 980        if {[catch {eval exec $cmd} err]} {
 981                error_popup "update-ref failed:\n\n$err"
 982                set ui_status_value {Commit failed.}
 983                unlock_index
 984                return
 985        }
 986
 987        # -- Cleanup after ourselves.
 988        #
 989        catch {file delete [file join $gitdir MERGE_HEAD]}
 990        catch {file delete [file join $gitdir MERGE_MSG]}
 991        catch {file delete [file join $gitdir SQUASH_MSG]}
 992        catch {file delete [file join $gitdir GITGUI_MSG]}
 993
 994        # -- Let rerere do its thing.
 995        #
 996        if {[file isdirectory [file join $gitdir rr-cache]]} {
 997                catch {exec git rerere}
 998        }
 999
1000        # -- Run the post-commit hook.
1001        #
1002        set pchook [file join $gitdir hooks post-commit]
1003        if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
1004                set pchook [list sh -c [concat \
1005                        "if test -x \"$pchook\";" \
1006                        "then exec \"$pchook\";" \
1007                        "fi"]]
1008        } elseif {![file executable $pchook]} {
1009                set pchook {}
1010        }
1011        if {$pchook ne {}} {
1012                catch {exec $pchook &}
1013        }
1014
1015        $ui_comm delete 0.0 end
1016        $ui_comm edit modified false
1017        $ui_comm edit reset
1018
1019        if {$single_commit} do_quit
1020
1021        # -- Update status without invoking any git commands.
1022        #
1023        set commit_type normal
1024        set selected_commit_type new
1025        set HEAD $cmt_id
1026        set PARENT $cmt_id
1027
1028        foreach path [array names file_states] {
1029                set s $file_states($path)
1030                set m [lindex $s 0]
1031                switch -glob -- $m {
1032                DD -
1033                AO {set m __}
1034                A? -
1035                M? -
1036                D? {set m _[string index $m 1]}
1037                }
1038
1039                if {$m eq {__}} {
1040                        unset file_states($path)
1041                        catch {unset selected_paths($path)}
1042                } else {
1043                        lset file_states($path) 0 $m
1044                }
1045        }
1046
1047        display_all_files
1048        unlock_index
1049        reshow_diff
1050        set ui_status_value \
1051                "Changes committed as [string range $cmt_id 0 7]."
1052}
1053
1054######################################################################
1055##
1056## fetch pull push
1057
1058proc fetch_from {remote} {
1059        set w [new_console "fetch $remote" \
1060                "Fetching new changes from $remote"]
1061        set cmd [list git fetch]
1062        lappend cmd $remote
1063        console_exec $w $cmd
1064}
1065
1066proc pull_remote {remote branch} {
1067        global HEAD commit_type file_states repo_config
1068
1069        if {![lock_index update]} return
1070
1071        # -- Our in memory state should match the repository.
1072        #
1073        repository_state curHEAD cur_type
1074        if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1075                error_popup {Last scanned state does not match repository state.
1076
1077Its highly likely that another Git program modified the
1078repository since our last scan.  A rescan is required
1079before a pull can be started.
1080}
1081                unlock_index
1082                rescan {set ui_status_value {Ready.}}
1083                return
1084        }
1085
1086        # -- No differences should exist before a pull.
1087        #
1088        if {[array size file_states] != 0} {
1089                error_popup {Uncommitted but modified files are present.
1090
1091You should not perform a pull with unmodified files in your working
1092directory as Git would be unable to recover from an incorrect merge.
1093
1094Commit or throw away all changes before starting a pull operation.
1095}
1096                unlock_index
1097                return
1098        }
1099
1100        set w [new_console "pull $remote $branch" \
1101                "Pulling new changes from branch $branch in $remote"]
1102        set cmd [list git pull]
1103        if {$repo_config(gui.pullsummary) eq {false}} {
1104                lappend cmd --no-summary
1105        }
1106        lappend cmd $remote
1107        lappend cmd $branch
1108        console_exec $w $cmd [list post_pull_remote $remote $branch]
1109}
1110
1111proc post_pull_remote {remote branch success} {
1112        global HEAD PARENT commit_type selected_commit_type
1113        global ui_status_value
1114
1115        unlock_index
1116        if {$success} {
1117                repository_state HEAD commit_type
1118                set PARENT $HEAD
1119                set selected_commit_type new
1120                set $ui_status_value "Pulling $branch from $remote complete."
1121        } else {
1122                set m "Conflicts detected while pulling $branch from $remote."
1123                rescan "set ui_status_value {$m}"
1124        }
1125}
1126
1127proc push_to {remote} {
1128        set w [new_console "push $remote" \
1129                "Pushing changes to $remote"]
1130        set cmd [list git push]
1131        lappend cmd $remote
1132        console_exec $w $cmd
1133}
1134
1135######################################################################
1136##
1137## ui helpers
1138
1139proc mapcol {state path} {
1140        global all_cols ui_other
1141
1142        if {[catch {set r $all_cols($state)}]} {
1143                puts "error: no column for state={$state} $path"
1144                return $ui_other
1145        }
1146        return $r
1147}
1148
1149proc mapicon {state path} {
1150        global all_icons
1151
1152        if {[catch {set r $all_icons($state)}]} {
1153                puts "error: no icon for state={$state} $path"
1154                return file_plain
1155        }
1156        return $r
1157}
1158
1159proc mapdesc {state path} {
1160        global all_descs
1161
1162        if {[catch {set r $all_descs($state)}]} {
1163                puts "error: no desc for state={$state} $path"
1164                return $state
1165        }
1166        return $r
1167}
1168
1169proc escape_path {path} {
1170        regsub -all "\n" $path "\\n" path
1171        return $path
1172}
1173
1174proc short_path {path} {
1175        return [escape_path [lindex [file split $path] end]]
1176}
1177
1178set next_icon_id 0
1179set null_sha1 [string repeat 0 40]
1180
1181proc merge_state {path new_state {head_info {}} {index_info {}}} {
1182        global file_states next_icon_id null_sha1
1183
1184        set s0 [string index $new_state 0]
1185        set s1 [string index $new_state 1]
1186
1187        if {[catch {set info $file_states($path)}]} {
1188                set state __
1189                set icon n[incr next_icon_id]
1190        } else {
1191                set state [lindex $info 0]
1192                set icon [lindex $info 1]
1193                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1194                if {$index_info eq {}} {set index_info [lindex $info 3]}
1195        }
1196
1197        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1198        elseif {$s0 eq {_}} {set s0 _}
1199
1200        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1201        elseif {$s1 eq {_}} {set s1 _}
1202
1203        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1204                set head_info [list 0 $null_sha1]
1205        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1206                && $head_info eq {}} {
1207                set head_info $index_info
1208        }
1209
1210        set file_states($path) [list $s0$s1 $icon \
1211                $head_info $index_info \
1212                ]
1213        return $state
1214}
1215
1216proc display_file {path state} {
1217        global file_states file_lists selected_paths
1218
1219        set old_m [merge_state $path $state]
1220        set s $file_states($path)
1221        set new_m [lindex $s 0]
1222        set new_w [mapcol $new_m $path] 
1223        set old_w [mapcol $old_m $path]
1224        set new_icon [mapicon $new_m $path]
1225
1226        if {$new_w ne $old_w} {
1227                set lno [lsearch -sorted $file_lists($old_w) $path]
1228                if {$lno >= 0} {
1229                        incr lno
1230                        $old_w conf -state normal
1231                        $old_w delete $lno.0 [expr {$lno + 1}].0
1232                        $old_w conf -state disabled
1233                }
1234
1235                lappend file_lists($new_w) $path
1236                set file_lists($new_w) [lsort $file_lists($new_w)]
1237                set lno [lsearch -sorted $file_lists($new_w) $path]
1238                incr lno
1239                $new_w conf -state normal
1240                $new_w image create $lno.0 \
1241                        -align center -padx 5 -pady 1 \
1242                        -name [lindex $s 1] \
1243                        -image $new_icon
1244                $new_w insert $lno.1 "[escape_path $path]\n"
1245                if {[catch {set in_sel $selected_paths($path)}]} {
1246                        set in_sel 0
1247                }
1248                if {$in_sel} {
1249                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1250                }
1251                $new_w conf -state disabled
1252        } elseif {$new_icon ne [mapicon $old_m $path]} {
1253                $new_w conf -state normal
1254                $new_w image conf [lindex $s 1] -image $new_icon
1255                $new_w conf -state disabled
1256        }
1257}
1258
1259proc display_all_files {} {
1260        global ui_index ui_other
1261        global file_states file_lists
1262        global last_clicked selected_paths
1263
1264        $ui_index conf -state normal
1265        $ui_other conf -state normal
1266
1267        $ui_index delete 0.0 end
1268        $ui_other delete 0.0 end
1269        set last_clicked {}
1270
1271        set file_lists($ui_index) [list]
1272        set file_lists($ui_other) [list]
1273
1274        foreach path [lsort [array names file_states]] {
1275                set s $file_states($path)
1276                set m [lindex $s 0]
1277                set w [mapcol $m $path]
1278                lappend file_lists($w) $path
1279                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1280                $w image create end \
1281                        -align center -padx 5 -pady 1 \
1282                        -name [lindex $s 1] \
1283                        -image [mapicon $m $path]
1284                $w insert end "[escape_path $path]\n"
1285                if {[catch {set in_sel $selected_paths($path)}]} {
1286                        set in_sel 0
1287                }
1288                if {$in_sel} {
1289                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1290                }
1291        }
1292
1293        $ui_index conf -state disabled
1294        $ui_other conf -state disabled
1295}
1296
1297proc update_indexinfo {msg pathList after} {
1298        global update_index_cp ui_status_value
1299
1300        if {![lock_index update]} return
1301
1302        set update_index_cp 0
1303        set pathList [lsort $pathList]
1304        set totalCnt [llength $pathList]
1305        set batch [expr {int($totalCnt * .01) + 1}]
1306        if {$batch > 25} {set batch 25}
1307
1308        set ui_status_value [format \
1309                "$msg... %i/%i files (%.2f%%)" \
1310                $update_index_cp \
1311                $totalCnt \
1312                0.0]
1313        set fd [open "| git update-index -z --index-info" w]
1314        fconfigure $fd \
1315                -blocking 0 \
1316                -buffering full \
1317                -buffersize 512 \
1318                -translation binary
1319        fileevent $fd writable [list \
1320                write_update_indexinfo \
1321                $fd \
1322                $pathList \
1323                $totalCnt \
1324                $batch \
1325                $msg \
1326                $after \
1327                ]
1328}
1329
1330proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1331        global update_index_cp ui_status_value
1332        global file_states current_diff
1333
1334        if {$update_index_cp >= $totalCnt} {
1335                close $fd
1336                unlock_index
1337                uplevel #0 $after
1338                return
1339        }
1340
1341        for {set i $batch} \
1342                {$update_index_cp < $totalCnt && $i > 0} \
1343                {incr i -1} {
1344                set path [lindex $pathList $update_index_cp]
1345                incr update_index_cp
1346
1347                set s $file_states($path)
1348                switch -glob -- [lindex $s 0] {
1349                A? {set new _O}
1350                M? {set new _M}
1351                D? {set new _?}
1352                ?? {continue}
1353                }
1354                set info [lindex $s 2]
1355                if {$info eq {}} continue
1356
1357                puts -nonewline $fd $info
1358                puts -nonewline $fd "\t"
1359                puts -nonewline $fd $path
1360                puts -nonewline $fd "\0"
1361                display_file $path $new
1362        }
1363
1364        set ui_status_value [format \
1365                "$msg... %i/%i files (%.2f%%)" \
1366                $update_index_cp \
1367                $totalCnt \
1368                [expr {100.0 * $update_index_cp / $totalCnt}]]
1369}
1370
1371proc update_index {msg pathList after} {
1372        global update_index_cp ui_status_value
1373
1374        if {![lock_index update]} return
1375
1376        set update_index_cp 0
1377        set pathList [lsort $pathList]
1378        set totalCnt [llength $pathList]
1379        set batch [expr {int($totalCnt * .01) + 1}]
1380        if {$batch > 25} {set batch 25}
1381
1382        set ui_status_value [format \
1383                "$msg... %i/%i files (%.2f%%)" \
1384                $update_index_cp \
1385                $totalCnt \
1386                0.0]
1387        set fd [open "| git update-index --add --remove -z --stdin" w]
1388        fconfigure $fd \
1389                -blocking 0 \
1390                -buffering full \
1391                -buffersize 512 \
1392                -translation binary
1393        fileevent $fd writable [list \
1394                write_update_index \
1395                $fd \
1396                $pathList \
1397                $totalCnt \
1398                $batch \
1399                $msg \
1400                $after \
1401                ]
1402}
1403
1404proc write_update_index {fd pathList totalCnt batch msg after} {
1405        global update_index_cp ui_status_value
1406        global file_states current_diff
1407
1408        if {$update_index_cp >= $totalCnt} {
1409                close $fd
1410                unlock_index
1411                uplevel #0 $after
1412                return
1413        }
1414
1415        for {set i $batch} \
1416                {$update_index_cp < $totalCnt && $i > 0} \
1417                {incr i -1} {
1418                set path [lindex $pathList $update_index_cp]
1419                incr update_index_cp
1420
1421                switch -glob -- [lindex $file_states($path) 0] {
1422                AD -
1423                MD -
1424                _D {set new DD}
1425
1426                _M -
1427                MM -
1428                M_ {set new M_}
1429
1430                _O -
1431                AM -
1432                A_ {set new A_}
1433
1434                ?? {continue}
1435                }
1436
1437                puts -nonewline $fd $path
1438                puts -nonewline $fd "\0"
1439                display_file $path $new
1440        }
1441
1442        set ui_status_value [format \
1443                "$msg... %i/%i files (%.2f%%)" \
1444                $update_index_cp \
1445                $totalCnt \
1446                [expr {100.0 * $update_index_cp / $totalCnt}]]
1447}
1448
1449######################################################################
1450##
1451## remote management
1452
1453proc load_all_remotes {} {
1454        global gitdir all_remotes repo_config
1455
1456        set all_remotes [list]
1457        set rm_dir [file join $gitdir remotes]
1458        if {[file isdirectory $rm_dir]} {
1459                set all_remotes [concat $all_remotes [glob \
1460                        -types f \
1461                        -tails \
1462                        -nocomplain \
1463                        -directory $rm_dir *]]
1464        }
1465
1466        foreach line [array names repo_config remote.*.url] {
1467                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1468                        lappend all_remotes $name
1469                }
1470        }
1471
1472        set all_remotes [lsort -unique $all_remotes]
1473}
1474
1475proc populate_fetch_menu {m} {
1476        global gitdir all_remotes repo_config
1477
1478        foreach r $all_remotes {
1479                set enable 0
1480                if {![catch {set a $repo_config(remote.$r.url)}]} {
1481                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1482                                set enable 1
1483                        }
1484                } else {
1485                        catch {
1486                                set fd [open [file join $gitdir remotes $r] r]
1487                                while {[gets $fd n] >= 0} {
1488                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1489                                                set enable 1
1490                                                break
1491                                        }
1492                                }
1493                                close $fd
1494                        }
1495                }
1496
1497                if {$enable} {
1498                        $m add command \
1499                                -label "Fetch from $r..." \
1500                                -command [list fetch_from $r] \
1501                                -font font_ui
1502                }
1503        }
1504}
1505
1506proc populate_push_menu {m} {
1507        global gitdir all_remotes repo_config
1508
1509        foreach r $all_remotes {
1510                set enable 0
1511                if {![catch {set a $repo_config(remote.$r.url)}]} {
1512                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1513                                set enable 1
1514                        }
1515                } else {
1516                        catch {
1517                                set fd [open [file join $gitdir remotes $r] r]
1518                                while {[gets $fd n] >= 0} {
1519                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1520                                                set enable 1
1521                                                break
1522                                        }
1523                                }
1524                                close $fd
1525                        }
1526                }
1527
1528                if {$enable} {
1529                        $m add command \
1530                                -label "Push to $r..." \
1531                                -command [list push_to $r] \
1532                                -font font_ui
1533                }
1534        }
1535}
1536
1537proc populate_pull_menu {m} {
1538        global gitdir repo_config all_remotes disable_on_lock
1539
1540        foreach remote $all_remotes {
1541                set rb {}
1542                if {[array get repo_config remote.$remote.url] ne {}} {
1543                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1544                                regexp {^([^:]+):} \
1545                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1546                                        line rb
1547                        }
1548                } else {
1549                        catch {
1550                                set fd [open [file join $gitdir remotes $remote] r]
1551                                while {[gets $fd line] >= 0} {
1552                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1553                                                break
1554                                        }
1555                                }
1556                                close $fd
1557                        }
1558                }
1559
1560                set rb_short $rb
1561                regsub ^refs/heads/ $rb {} rb_short
1562                if {$rb_short ne {}} {
1563                        $m add command \
1564                                -label "Branch $rb_short from $remote..." \
1565                                -command [list pull_remote $remote $rb] \
1566                                -font font_ui
1567                        lappend disable_on_lock \
1568                                [list $m entryconf [$m index last] -state]
1569                }
1570        }
1571}
1572
1573######################################################################
1574##
1575## icons
1576
1577set filemask {
1578#define mask_width 14
1579#define mask_height 15
1580static unsigned char mask_bits[] = {
1581   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1582   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1583   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1584}
1585
1586image create bitmap file_plain -background white -foreground black -data {
1587#define plain_width 14
1588#define plain_height 15
1589static unsigned char plain_bits[] = {
1590   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1591   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1592   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1593} -maskdata $filemask
1594
1595image create bitmap file_mod -background white -foreground blue -data {
1596#define mod_width 14
1597#define mod_height 15
1598static unsigned char mod_bits[] = {
1599   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1600   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1601   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1602} -maskdata $filemask
1603
1604image create bitmap file_fulltick -background white -foreground "#007000" -data {
1605#define file_fulltick_width 14
1606#define file_fulltick_height 15
1607static unsigned char file_fulltick_bits[] = {
1608   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1609   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1610   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1611} -maskdata $filemask
1612
1613image create bitmap file_parttick -background white -foreground "#005050" -data {
1614#define parttick_width 14
1615#define parttick_height 15
1616static unsigned char parttick_bits[] = {
1617   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1618   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1619   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1620} -maskdata $filemask
1621
1622image create bitmap file_question -background white -foreground black -data {
1623#define file_question_width 14
1624#define file_question_height 15
1625static unsigned char file_question_bits[] = {
1626   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1627   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1628   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1629} -maskdata $filemask
1630
1631image create bitmap file_removed -background white -foreground red -data {
1632#define file_removed_width 14
1633#define file_removed_height 15
1634static unsigned char file_removed_bits[] = {
1635   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1636   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1637   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1638} -maskdata $filemask
1639
1640image create bitmap file_merge -background white -foreground blue -data {
1641#define file_merge_width 14
1642#define file_merge_height 15
1643static unsigned char file_merge_bits[] = {
1644   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1645   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1646   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1647} -maskdata $filemask
1648
1649set ui_index .vpane.files.index.list
1650set ui_other .vpane.files.other.list
1651set max_status_desc 0
1652foreach i {
1653                {__ i plain    "Unmodified"}
1654                {_M i mod      "Modified"}
1655                {M_ i fulltick "Included in commit"}
1656                {MM i parttick "Partially included"}
1657
1658                {_O o plain    "Untracked"}
1659                {A_ o fulltick "Added by commit"}
1660                {AM o parttick "Partially added"}
1661                {AD o question "Added (but now gone)"}
1662
1663                {_D i question "Missing"}
1664                {D_ i removed  "Removed by commit"}
1665                {DD i removed  "Removed by commit"}
1666                {DO i removed  "Removed (still exists)"}
1667
1668                {UM i merge    "Merge conflicts"}
1669                {U_ i merge    "Merge conflicts"}
1670        } {
1671        if {$max_status_desc < [string length [lindex $i 3]]} {
1672                set max_status_desc [string length [lindex $i 3]]
1673        }
1674        if {[lindex $i 1] eq {i}} {
1675                set all_cols([lindex $i 0]) $ui_index
1676        } else {
1677                set all_cols([lindex $i 0]) $ui_other
1678        }
1679        set all_icons([lindex $i 0]) file_[lindex $i 2]
1680        set all_descs([lindex $i 0]) [lindex $i 3]
1681}
1682unset filemask i
1683
1684######################################################################
1685##
1686## util
1687
1688proc is_MacOSX {} {
1689        global tcl_platform tk_library
1690        if {$tcl_platform(platform) eq {unix}
1691                && $tcl_platform(os) eq {Darwin}
1692                && [string match /Library/Frameworks/* $tk_library]} {
1693                return 1
1694        }
1695        return 0
1696}
1697
1698proc bind_button3 {w cmd} {
1699        bind $w <Any-Button-3> $cmd
1700        if {[is_MacOSX]} {
1701                bind $w <Control-Button-1> $cmd
1702        }
1703}
1704
1705proc incr_font_size {font {amt 1}} {
1706        set sz [font configure $font -size]
1707        incr sz $amt
1708        font configure $font -size $sz
1709        font configure ${font}bold -size $sz
1710}
1711
1712proc hook_failed_popup {hook msg} {
1713        global gitdir appname
1714
1715        set w .hookfail
1716        toplevel $w
1717
1718        frame $w.m
1719        label $w.m.l1 -text "$hook hook failed:" \
1720                -anchor w \
1721                -justify left \
1722                -font font_uibold
1723        text $w.m.t \
1724                -background white -borderwidth 1 \
1725                -relief sunken \
1726                -width 80 -height 10 \
1727                -font font_diff \
1728                -yscrollcommand [list $w.m.sby set]
1729        label $w.m.l2 \
1730                -text {You must correct the above errors before committing.} \
1731                -anchor w \
1732                -justify left \
1733                -font font_uibold
1734        scrollbar $w.m.sby -command [list $w.m.t yview]
1735        pack $w.m.l1 -side top -fill x
1736        pack $w.m.l2 -side bottom -fill x
1737        pack $w.m.sby -side right -fill y
1738        pack $w.m.t -side left -fill both -expand 1
1739        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1740
1741        $w.m.t insert 1.0 $msg
1742        $w.m.t conf -state disabled
1743
1744        button $w.ok -text OK \
1745                -width 15 \
1746                -font font_ui \
1747                -command "destroy $w"
1748        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1749
1750        bind $w <Visibility> "grab $w; focus $w"
1751        bind $w <Key-Return> "destroy $w"
1752        wm title $w "$appname ([lindex [file split \
1753                [file normalize [file dirname $gitdir]]] \
1754                end]): error"
1755        tkwait window $w
1756}
1757
1758set next_console_id 0
1759
1760proc new_console {short_title long_title} {
1761        global next_console_id console_data
1762        set w .console[incr next_console_id]
1763        set console_data($w) [list $short_title $long_title]
1764        return [console_init $w]
1765}
1766
1767proc console_init {w} {
1768        global console_cr console_data
1769        global gitdir appname M1B
1770
1771        set console_cr($w) 1.0
1772        toplevel $w
1773        frame $w.m
1774        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1775                -anchor w \
1776                -justify left \
1777                -font font_uibold
1778        text $w.m.t \
1779                -background white -borderwidth 1 \
1780                -relief sunken \
1781                -width 80 -height 10 \
1782                -font font_diff \
1783                -state disabled \
1784                -yscrollcommand [list $w.m.sby set]
1785        label $w.m.s -text {Working... please wait...} \
1786                -anchor w \
1787                -justify left \
1788                -font font_uibold
1789        scrollbar $w.m.sby -command [list $w.m.t yview]
1790        pack $w.m.l1 -side top -fill x
1791        pack $w.m.s -side bottom -fill x
1792        pack $w.m.sby -side right -fill y
1793        pack $w.m.t -side left -fill both -expand 1
1794        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1795
1796        menu $w.ctxm -tearoff 0
1797        $w.ctxm add command -label "Copy" \
1798                -font font_ui \
1799                -command "tk_textCopy $w.m.t"
1800        $w.ctxm add command -label "Select All" \
1801                -font font_ui \
1802                -command "$w.m.t tag add sel 0.0 end"
1803        $w.ctxm add command -label "Copy All" \
1804                -font font_ui \
1805                -command "
1806                        $w.m.t tag add sel 0.0 end
1807                        tk_textCopy $w.m.t
1808                        $w.m.t tag remove sel 0.0 end
1809                "
1810
1811        button $w.ok -text {Close} \
1812                -font font_ui \
1813                -state disabled \
1814                -command "destroy $w"
1815        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1816
1817        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1818        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1819        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1820        bind $w <Visibility> "focus $w"
1821        wm title $w "$appname ([lindex [file split \
1822                [file normalize [file dirname $gitdir]]] \
1823                end]): [lindex $console_data($w) 0]"
1824        return $w
1825}
1826
1827proc console_exec {w cmd {after {}}} {
1828        global tcl_platform
1829
1830        # -- Windows tosses the enviroment when we exec our child.
1831        #    But most users need that so we have to relogin. :-(
1832        #
1833        if {$tcl_platform(platform) eq {windows}} {
1834                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1835        }
1836
1837        # -- Tcl won't let us redirect both stdout and stderr to
1838        #    the same pipe.  So pass it through cat...
1839        #
1840        set cmd [concat | $cmd |& cat]
1841
1842        set fd_f [open $cmd r]
1843        fconfigure $fd_f -blocking 0 -translation binary
1844        fileevent $fd_f readable [list console_read $w $fd_f $after]
1845}
1846
1847proc console_read {w fd after} {
1848        global console_cr console_data
1849
1850        set buf [read $fd]
1851        if {$buf ne {}} {
1852                if {![winfo exists $w]} {console_init $w}
1853                $w.m.t conf -state normal
1854                set c 0
1855                set n [string length $buf]
1856                while {$c < $n} {
1857                        set cr [string first "\r" $buf $c]
1858                        set lf [string first "\n" $buf $c]
1859                        if {$cr < 0} {set cr [expr {$n + 1}]}
1860                        if {$lf < 0} {set lf [expr {$n + 1}]}
1861
1862                        if {$lf < $cr} {
1863                                $w.m.t insert end [string range $buf $c $lf]
1864                                set console_cr($w) [$w.m.t index {end -1c}]
1865                                set c $lf
1866                                incr c
1867                        } else {
1868                                $w.m.t delete $console_cr($w) end
1869                                $w.m.t insert end "\n"
1870                                $w.m.t insert end [string range $buf $c $cr]
1871                                set c $cr
1872                                incr c
1873                        }
1874                }
1875                $w.m.t conf -state disabled
1876                $w.m.t see end
1877        }
1878
1879        fconfigure $fd -blocking 1
1880        if {[eof $fd]} {
1881                if {[catch {close $fd}]} {
1882                        if {![winfo exists $w]} {console_init $w}
1883                        $w.m.s conf -background red -text {Error: Command Failed}
1884                        $w.ok conf -state normal
1885                        set ok 0
1886                } elseif {[winfo exists $w]} {
1887                        $w.m.s conf -background green -text {Success}
1888                        $w.ok conf -state normal
1889                        set ok 1
1890                }
1891                array unset console_cr $w
1892                array unset console_data $w
1893                if {$after ne {}} {
1894                        uplevel #0 $after $ok
1895                }
1896                return
1897        }
1898        fconfigure $fd -blocking 0
1899}
1900
1901######################################################################
1902##
1903## ui commands
1904
1905set starting_gitk_msg {Please wait... Starting gitk...}
1906
1907proc do_gitk {} {
1908        global tcl_platform ui_status_value starting_gitk_msg
1909
1910        set ui_status_value $starting_gitk_msg
1911        after 10000 {
1912                if {$ui_status_value eq $starting_gitk_msg} {
1913                        set ui_status_value {Ready.}
1914                }
1915        }
1916
1917        if {$tcl_platform(platform) eq {windows}} {
1918                exec sh -c gitk &
1919        } else {
1920                exec gitk &
1921        }
1922}
1923
1924proc do_repack {} {
1925        set w [new_console "repack" "Repacking the object database"]
1926        set cmd [list git repack]
1927        lappend cmd -a
1928        lappend cmd -d
1929        console_exec $w $cmd
1930}
1931
1932set is_quitting 0
1933
1934proc do_quit {} {
1935        global gitdir ui_comm is_quitting repo_config
1936
1937        if {$is_quitting} return
1938        set is_quitting 1
1939
1940        # -- Stash our current commit buffer.
1941        #
1942        set save [file join $gitdir GITGUI_MSG]
1943        set msg [string trim [$ui_comm get 0.0 end]]
1944        if {[$ui_comm edit modified] && $msg ne {}} {
1945                catch {
1946                        set fd [open $save w]
1947                        puts $fd [string trim [$ui_comm get 0.0 end]]
1948                        close $fd
1949                }
1950        } elseif {$msg eq {} && [file exists $save]} {
1951                file delete $save
1952        }
1953
1954        # -- Stash our current window geometry into this repository.
1955        #
1956        set cfg_geometry [list]
1957        lappend cfg_geometry [wm geometry .]
1958        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1959        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1960        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1961                set rc_geometry {}
1962        }
1963        if {$cfg_geometry ne $rc_geometry} {
1964                catch {exec git repo-config gui.geometry $cfg_geometry}
1965        }
1966
1967        destroy .
1968}
1969
1970proc do_rescan {} {
1971        rescan {set ui_status_value {Ready.}}
1972}
1973
1974proc remove_helper {txt paths} {
1975        global file_states current_diff
1976
1977        if {![lock_index begin-update]} return
1978
1979        set pathList [list]
1980        set after {}
1981        foreach path $paths {
1982                switch -glob -- [lindex $file_states($path) 0] {
1983                A? -
1984                M? -
1985                D? {
1986                        lappend pathList $path
1987                        if {$path eq $current_diff} {
1988                                set after {reshow_diff;}
1989                        }
1990                }
1991                }
1992        }
1993        if {$pathList eq {}} {
1994                unlock_index
1995        } else {
1996                update_indexinfo \
1997                        $txt \
1998                        $pathList \
1999                        [concat $after {set ui_status_value {Ready.}}]
2000        }
2001}
2002
2003proc do_remove_selection {} {
2004        global current_diff selected_paths
2005
2006        if {[array size selected_paths] > 0} {
2007                remove_helper \
2008                        {Removing selected files from commit} \
2009                        [array names selected_paths]
2010        } elseif {$current_diff ne {}} {
2011                remove_helper \
2012                        "Removing [short_path $current_diff] from commit" \
2013                        [list $current_diff]
2014        }
2015}
2016
2017proc include_helper {txt paths} {
2018        global file_states current_diff
2019
2020        if {![lock_index begin-update]} return
2021
2022        set pathList [list]
2023        set after {}
2024        foreach path $paths {
2025                switch -- [lindex $file_states($path) 0] {
2026                AM -
2027                AD -
2028                MM -
2029                UM -
2030                U_ -
2031                _M -
2032                _D -
2033                _O {
2034                        lappend pathList $path
2035                        if {$path eq $current_diff} {
2036                                set after {reshow_diff;}
2037                        }
2038                }
2039                }
2040        }
2041        if {$pathList eq {}} {
2042                unlock_index
2043        } else {
2044                update_index \
2045                        $txt \
2046                        $pathList \
2047                        [concat $after {set ui_status_value {Ready to commit.}}]
2048        }
2049}
2050
2051proc do_include_selection {} {
2052        global current_diff selected_paths
2053
2054        if {[array size selected_paths] > 0} {
2055                include_helper \
2056                        {Including selected files} \
2057                        [array names selected_paths]
2058        } elseif {$current_diff ne {}} {
2059                include_helper \
2060                        "Including [short_path $current_diff]" \
2061                        [list $current_diff]
2062        }
2063}
2064
2065proc do_include_all {} {
2066        global file_states
2067
2068        set paths [list]
2069        foreach path [array names file_states] {
2070                switch -- [lindex $file_states($path) 0] {
2071                AM -
2072                AD -
2073                MM -
2074                _M -
2075                _D {lappend paths $path}
2076                }
2077        }
2078        include_helper \
2079                {Including all modified files} \
2080                $paths
2081}
2082
2083proc do_signoff {} {
2084        global ui_comm
2085
2086        set me [committer_ident]
2087        if {$me eq {}} return
2088
2089        set sob "Signed-off-by: $me"
2090        set last [$ui_comm get {end -1c linestart} {end -1c}]
2091        if {$last ne $sob} {
2092                $ui_comm edit separator
2093                if {$last ne {}
2094                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2095                        $ui_comm insert end "\n"
2096                }
2097                $ui_comm insert end "\n$sob"
2098                $ui_comm edit separator
2099                $ui_comm see end
2100        }
2101}
2102
2103proc do_select_commit_type {} {
2104        global commit_type selected_commit_type
2105
2106        if {$selected_commit_type eq {new}
2107                && [string match amend* $commit_type]} {
2108                create_new_commit
2109        } elseif {$selected_commit_type eq {amend}
2110                && ![string match amend* $commit_type]} {
2111                load_last_commit
2112
2113                # The amend request was rejected...
2114                #
2115                if {![string match amend* $commit_type]} {
2116                        set selected_commit_type new
2117                }
2118        }
2119}
2120
2121proc do_commit {} {
2122        commit_tree
2123}
2124
2125proc do_options {} {
2126        global appname gitdir font_descs
2127        global repo_config global_config
2128        global repo_config_new global_config_new
2129
2130        array unset repo_config_new
2131        array unset global_config_new
2132        foreach name [array names repo_config] {
2133                set repo_config_new($name) $repo_config($name)
2134        }
2135        load_config 1
2136        foreach name [array names repo_config] {
2137                switch -- $name {
2138                gui.diffcontext {continue}
2139                }
2140                set repo_config_new($name) $repo_config($name)
2141        }
2142        foreach name [array names global_config] {
2143                set global_config_new($name) $global_config($name)
2144        }
2145        set reponame [lindex [file split \
2146                [file normalize [file dirname $gitdir]]] \
2147                end]
2148
2149        set w .options_editor
2150        toplevel $w
2151        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2152
2153        label $w.header -text "$appname Options" \
2154                -font font_uibold
2155        pack $w.header -side top -fill x
2156
2157        frame $w.buttons
2158        button $w.buttons.restore -text {Restore Defaults} \
2159                -font font_ui \
2160                -command do_restore_defaults
2161        pack $w.buttons.restore -side left
2162        button $w.buttons.save -text Save \
2163                -font font_ui \
2164                -command [list do_save_config $w]
2165        pack $w.buttons.save -side right
2166        button $w.buttons.cancel -text {Cancel} \
2167                -font font_ui \
2168                -command [list destroy $w]
2169        pack $w.buttons.cancel -side right
2170        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2171
2172        labelframe $w.repo -text "$reponame Repository" \
2173                -font font_ui \
2174                -relief raised -borderwidth 2
2175        labelframe $w.global -text {Global (All Repositories)} \
2176                -font font_ui \
2177                -relief raised -borderwidth 2
2178        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2179        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2180
2181        foreach option {
2182                {b partialinclude {Allow Partially Included Files}}
2183                {b pullsummary {Show Pull Summary}}
2184                {b trustmtime  {Trust File Modification Timestamps}}
2185                {i diffcontext {Number of Diff Context Lines}}
2186                } {
2187                set type [lindex $option 0]
2188                set name [lindex $option 1]
2189                set text [lindex $option 2]
2190                foreach f {repo global} {
2191                        switch $type {
2192                        b {
2193                                checkbutton $w.$f.$name -text $text \
2194                                        -variable ${f}_config_new(gui.$name) \
2195                                        -onvalue true \
2196                                        -offvalue false \
2197                                        -font font_ui
2198                                pack $w.$f.$name -side top -anchor w
2199                        }
2200                        i {
2201                                frame $w.$f.$name
2202                                label $w.$f.$name.l -text "$text:" -font font_ui
2203                                pack $w.$f.$name.l -side left -anchor w -fill x
2204                                spinbox $w.$f.$name.v \
2205                                        -textvariable ${f}_config_new(gui.$name) \
2206                                        -from 1 -to 99 -increment 1 \
2207                                        -width 3 \
2208                                        -font font_ui
2209                                pack $w.$f.$name.v -side right -anchor e
2210                                pack $w.$f.$name -side top -anchor w -fill x
2211                        }
2212                        }
2213                }
2214        }
2215
2216        set all_fonts [lsort [font families]]
2217        foreach option $font_descs {
2218                set name [lindex $option 0]
2219                set font [lindex $option 1]
2220                set text [lindex $option 2]
2221
2222                set global_config_new(gui.$font^^family) \
2223                        [font configure $font -family]
2224                set global_config_new(gui.$font^^size) \
2225                        [font configure $font -size]
2226
2227                frame $w.global.$name
2228                label $w.global.$name.l -text "$text:" -font font_ui
2229                pack $w.global.$name.l -side left -anchor w -fill x
2230                eval tk_optionMenu $w.global.$name.family \
2231                        global_config_new(gui.$font^^family) \
2232                        $all_fonts
2233                spinbox $w.global.$name.size \
2234                        -textvariable global_config_new(gui.$font^^size) \
2235                        -from 2 -to 80 -increment 1 \
2236                        -width 3 \
2237                        -font font_ui
2238                pack $w.global.$name.size -side right -anchor e
2239                pack $w.global.$name.family -side right -anchor e
2240                pack $w.global.$name -side top -anchor w -fill x
2241        }
2242
2243        bind $w <Visibility> "grab $w; focus $w"
2244        bind $w <Key-Escape> "destroy $w"
2245        wm title $w "$appname ($reponame): Options"
2246        tkwait window $w
2247}
2248
2249proc do_restore_defaults {} {
2250        global font_descs default_config repo_config
2251        global repo_config_new global_config_new
2252
2253        foreach name [array names default_config] {
2254                set repo_config_new($name) $default_config($name)
2255                set global_config_new($name) $default_config($name)
2256        }
2257
2258        foreach option $font_descs {
2259                set name [lindex $option 0]
2260                set repo_config(gui.$name) $default_config(gui.$name)
2261        }
2262        apply_config
2263
2264        foreach option $font_descs {
2265                set name [lindex $option 0]
2266                set font [lindex $option 1]
2267                set global_config_new(gui.$font^^family) \
2268                        [font configure $font -family]
2269                set global_config_new(gui.$font^^size) \
2270                        [font configure $font -size]
2271        }
2272}
2273
2274proc do_save_config {w} {
2275        if {[catch {save_config} err]} {
2276                error_popup "Failed to completely save options:\n\n$err"
2277        }
2278        reshow_diff
2279        destroy $w
2280}
2281
2282proc do_windows_shortcut {} {
2283        global gitdir appname argv0
2284
2285        set reponame [lindex [file split \
2286                [file normalize [file dirname $gitdir]]] \
2287                end]
2288
2289        if {[catch {
2290                set desktop [exec cygpath \
2291                        --windows \
2292                        --absolute \
2293                        --long-name \
2294                        --desktop]
2295                }]} {
2296                        set desktop .
2297        }
2298        set fn [tk_getSaveFile \
2299                -parent . \
2300                -title "$appname ($reponame): Create Desktop Icon" \
2301                -initialdir $desktop \
2302                -initialfile "Git $reponame.bat"]
2303        if {$fn != {}} {
2304                if {[catch {
2305                                set fd [open $fn w]
2306                                set sh [exec cygpath \
2307                                        --windows \
2308                                        --absolute \
2309                                        --long-name \
2310                                        /bin/sh]
2311                                set me [exec cygpath \
2312                                        --unix \
2313                                        --absolute \
2314                                        $argv0]
2315                                set gd [exec cygpath \
2316                                        --unix \
2317                                        --absolute \
2318                                        $gitdir]
2319                                regsub -all ' $me "'\\''" me
2320                                regsub -all ' $gd "'\\''" gd
2321                                puts -nonewline $fd "\"$sh\" --login -c \""
2322                                puts -nonewline $fd "GIT_DIR='$gd'"
2323                                puts -nonewline $fd " '$me'"
2324                                puts $fd "&\""
2325                                close $fd
2326                        } err]} {
2327                        error_popup "Cannot write script:\n\n$err"
2328                }
2329        }
2330}
2331
2332proc do_macosx_app {} {
2333        global gitdir appname argv0 env
2334
2335        set reponame [lindex [file split \
2336                [file normalize [file dirname $gitdir]]] \
2337                end]
2338
2339        set fn [tk_getSaveFile \
2340                -parent . \
2341                -title "$appname ($reponame): Create Desktop Icon" \
2342                -initialdir [file join $env(HOME) Desktop] \
2343                -initialfile "Git $reponame.app"]
2344        if {$fn != {}} {
2345                if {[catch {
2346                                set Contents [file join $fn Contents]
2347                                set MacOS [file join $Contents MacOS]
2348                                set exe [file join $MacOS git-gui]
2349
2350                                file mkdir $MacOS
2351
2352                                set fd [open [file join $Contents Info.plist] w]
2353                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2354<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2355<plist version="1.0">
2356<dict>
2357        <key>CFBundleDevelopmentRegion</key>
2358        <string>English</string>
2359        <key>CFBundleExecutable</key>
2360        <string>git-gui</string>
2361        <key>CFBundleIdentifier</key>
2362        <string>org.spearce.git-gui</string>
2363        <key>CFBundleInfoDictionaryVersion</key>
2364        <string>6.0</string>
2365        <key>CFBundlePackageType</key>
2366        <string>APPL</string>
2367        <key>CFBundleSignature</key>
2368        <string>????</string>
2369        <key>CFBundleVersion</key>
2370        <string>1.0</string>
2371        <key>NSPrincipalClass</key>
2372        <string>NSApplication</string>
2373</dict>
2374</plist>}
2375                                close $fd
2376
2377                                set fd [open $exe w]
2378                                set gd [file normalize $gitdir]
2379                                set ep [file normalize [exec git --exec-path]]
2380                                regsub -all ' $gd "'\\''" gd
2381                                regsub -all ' $ep "'\\''" ep
2382                                puts $fd "#!/bin/sh"
2383                                foreach name [array names env] {
2384                                        if {[string match GIT_* $name]} {
2385                                                regsub -all ' $env($name) "'\\''" v
2386                                                puts $fd "export $name='$v'"
2387                                        }
2388                                }
2389                                puts $fd "export PATH='$ep':\$PATH"
2390                                puts $fd "export GIT_DIR='$gd'"
2391                                puts $fd "exec [file normalize $argv0]"
2392                                close $fd
2393
2394                                file attributes $exe -permissions u+x,g+x,o+x
2395                        } err]} {
2396                        error_popup "Cannot write icon:\n\n$err"
2397                }
2398        }
2399}
2400
2401proc toggle_or_diff {w x y} {
2402        global file_states file_lists current_diff ui_index ui_other
2403        global last_clicked selected_paths
2404
2405        set pos [split [$w index @$x,$y] .]
2406        set lno [lindex $pos 0]
2407        set col [lindex $pos 1]
2408        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2409        if {$path eq {}} {
2410                set last_clicked {}
2411                return
2412        }
2413
2414        set last_clicked [list $w $lno]
2415        array unset selected_paths
2416        $ui_index tag remove in_sel 0.0 end
2417        $ui_other tag remove in_sel 0.0 end
2418
2419        if {$col == 0} {
2420                if {$current_diff eq $path} {
2421                        set after {reshow_diff;}
2422                } else {
2423                        set after {}
2424                }
2425                switch -glob -- [lindex $file_states($path) 0] {
2426                A_ -
2427                AO -
2428                M_ -
2429                DD -
2430                D_ {
2431                        update_indexinfo \
2432                                "Removing [short_path $path] from commit" \
2433                                [list $path] \
2434                                [concat $after {set ui_status_value {Ready.}}]
2435                }
2436                ?? {
2437                        update_index \
2438                                "Including [short_path $path]" \
2439                                [list $path] \
2440                                [concat $after {set ui_status_value {Ready.}}]
2441                }
2442                }
2443        } else {
2444                show_diff $path $w $lno
2445        }
2446}
2447
2448proc add_one_to_selection {w x y} {
2449        global file_lists
2450        global last_clicked selected_paths
2451
2452        set pos [split [$w index @$x,$y] .]
2453        set lno [lindex $pos 0]
2454        set col [lindex $pos 1]
2455        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2456        if {$path eq {}} {
2457                set last_clicked {}
2458                return
2459        }
2460
2461        set last_clicked [list $w $lno]
2462        if {[catch {set in_sel $selected_paths($path)}]} {
2463                set in_sel 0
2464        }
2465        if {$in_sel} {
2466                unset selected_paths($path)
2467                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2468        } else {
2469                set selected_paths($path) 1
2470                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2471        }
2472}
2473
2474proc add_range_to_selection {w x y} {
2475        global file_lists
2476        global last_clicked selected_paths
2477
2478        if {[lindex $last_clicked 0] ne $w} {
2479                toggle_or_diff $w $x $y
2480                return
2481        }
2482
2483        set pos [split [$w index @$x,$y] .]
2484        set lno [lindex $pos 0]
2485        set lc [lindex $last_clicked 1]
2486        if {$lc < $lno} {
2487                set begin $lc
2488                set end $lno
2489        } else {
2490                set begin $lno
2491                set end $lc
2492        }
2493
2494        foreach path [lrange $file_lists($w) \
2495                [expr {$begin - 1}] \
2496                [expr {$end - 1}]] {
2497                set selected_paths($path) 1
2498        }
2499        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2500}
2501
2502######################################################################
2503##
2504## config defaults
2505
2506set cursor_ptr arrow
2507font create font_diff -family Courier -size 10
2508font create font_ui
2509catch {
2510        label .dummy
2511        eval font configure font_ui [font actual [.dummy cget -font]]
2512        destroy .dummy
2513}
2514
2515font create font_uibold
2516font create font_diffbold
2517
2518set M1B M1
2519set M1T M1
2520if {$tcl_platform(platform) eq {windows}} {
2521        set M1B Control
2522        set M1T Ctrl
2523} elseif {[is_MacOSX]} {
2524        set M1B M1
2525        set M1T Cmd
2526}
2527
2528proc apply_config {} {
2529        global repo_config font_descs
2530
2531        foreach option $font_descs {
2532                set name [lindex $option 0]
2533                set font [lindex $option 1]
2534                if {[catch {
2535                        foreach {cn cv} $repo_config(gui.$name) {
2536                                font configure $font $cn $cv
2537                        }
2538                        } err]} {
2539                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2540                }
2541                foreach {cn cv} [font configure $font] {
2542                        font configure ${font}bold $cn $cv
2543                }
2544                font configure ${font}bold -weight bold
2545        }
2546}
2547
2548set default_config(gui.trustmtime) false
2549set default_config(gui.pullsummary) true
2550set default_config(gui.partialinclude) false
2551set default_config(gui.diffcontext) 5
2552set default_config(gui.fontui) [font configure font_ui]
2553set default_config(gui.fontdiff) [font configure font_diff]
2554set font_descs {
2555        {fontui   font_ui   {Main Font}}
2556        {fontdiff font_diff {Diff/Console Font}}
2557}
2558load_config 0
2559apply_config
2560
2561######################################################################
2562##
2563## ui construction
2564
2565# -- Menu Bar
2566#
2567menu .mbar -tearoff 0
2568.mbar add cascade -label Project -menu .mbar.project
2569.mbar add cascade -label Edit -menu .mbar.edit
2570.mbar add cascade -label Commit -menu .mbar.commit
2571if {!$single_commit} {
2572        .mbar add cascade -label Fetch -menu .mbar.fetch
2573        .mbar add cascade -label Pull -menu .mbar.pull
2574        .mbar add cascade -label Push -menu .mbar.push
2575}
2576. configure -menu .mbar
2577
2578# -- Project Menu
2579#
2580menu .mbar.project
2581.mbar.project add command -label Visualize \
2582        -command do_gitk \
2583        -font font_ui
2584if {!$single_commit} {
2585        .mbar.project add command -label {Repack Database} \
2586                -command do_repack \
2587                -font font_ui
2588
2589        if {$tcl_platform(platform) eq {windows}} {
2590                .mbar.project add command \
2591                        -label {Create Desktop Icon} \
2592                        -command do_windows_shortcut \
2593                        -font font_ui
2594        } elseif {[is_MacOSX]} {
2595                .mbar.project add command \
2596                        -label {Create Desktop Icon} \
2597                        -command do_macosx_app \
2598                        -font font_ui
2599        }
2600}
2601.mbar.project add command -label Quit \
2602        -command do_quit \
2603        -accelerator $M1T-Q \
2604        -font font_ui
2605
2606# -- Edit Menu
2607#
2608menu .mbar.edit
2609.mbar.edit add command -label Undo \
2610        -command {catch {[focus] edit undo}} \
2611        -accelerator $M1T-Z \
2612        -font font_ui
2613.mbar.edit add command -label Redo \
2614        -command {catch {[focus] edit redo}} \
2615        -accelerator $M1T-Y \
2616        -font font_ui
2617.mbar.edit add separator
2618.mbar.edit add command -label Cut \
2619        -command {catch {tk_textCut [focus]}} \
2620        -accelerator $M1T-X \
2621        -font font_ui
2622.mbar.edit add command -label Copy \
2623        -command {catch {tk_textCopy [focus]}} \
2624        -accelerator $M1T-C \
2625        -font font_ui
2626.mbar.edit add command -label Paste \
2627        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2628        -accelerator $M1T-V \
2629        -font font_ui
2630.mbar.edit add command -label Delete \
2631        -command {catch {[focus] delete sel.first sel.last}} \
2632        -accelerator Del \
2633        -font font_ui
2634.mbar.edit add separator
2635.mbar.edit add command -label {Select All} \
2636        -command {catch {[focus] tag add sel 0.0 end}} \
2637        -accelerator $M1T-A \
2638        -font font_ui
2639.mbar.edit add separator
2640.mbar.edit add command -label {Options...} \
2641        -command do_options \
2642        -font font_ui
2643
2644# -- Commit Menu
2645#
2646menu .mbar.commit
2647
2648.mbar.commit add radiobutton \
2649        -label {New Commit} \
2650        -command do_select_commit_type \
2651        -variable selected_commit_type \
2652        -value new \
2653        -font font_ui
2654lappend disable_on_lock \
2655        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2656
2657.mbar.commit add radiobutton \
2658        -label {Amend Last Commit} \
2659        -command do_select_commit_type \
2660        -variable selected_commit_type \
2661        -value amend \
2662        -font font_ui
2663lappend disable_on_lock \
2664        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2665
2666.mbar.commit add separator
2667
2668.mbar.commit add command -label Rescan \
2669        -command do_rescan \
2670        -accelerator F5 \
2671        -font font_ui
2672lappend disable_on_lock \
2673        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2674
2675.mbar.commit add command -label {Remove From Commit} \
2676        -command do_remove_selection \
2677        -font font_ui
2678lappend disable_on_lock \
2679        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2680
2681.mbar.commit add command -label {Include In Commit} \
2682        -command do_include_selection \
2683        -font font_ui
2684lappend disable_on_lock \
2685        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2686
2687.mbar.commit add command -label {Include All} \
2688        -command do_include_all \
2689        -accelerator $M1T-I \
2690        -font font_ui
2691lappend disable_on_lock \
2692        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2693
2694.mbar.commit add separator
2695
2696.mbar.commit add command -label {Sign Off} \
2697        -command do_signoff \
2698        -accelerator $M1T-S \
2699        -font font_ui
2700
2701.mbar.commit add command -label Commit \
2702        -command do_commit \
2703        -accelerator $M1T-Return \
2704        -font font_ui
2705lappend disable_on_lock \
2706        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2707
2708# -- Transport menus
2709#
2710if {!$single_commit} {
2711        menu .mbar.fetch
2712        menu .mbar.pull
2713        menu .mbar.push
2714}
2715
2716# -- Main Window Layout
2717#
2718panedwindow .vpane -orient vertical
2719panedwindow .vpane.files -orient horizontal
2720.vpane add .vpane.files -sticky nsew -height 100 -width 400
2721pack .vpane -anchor n -side top -fill both -expand 1
2722
2723# -- Index File List
2724#
2725frame .vpane.files.index -height 100 -width 400
2726label .vpane.files.index.title -text {Modified Files} \
2727        -background green \
2728        -font font_ui
2729text $ui_index -background white -borderwidth 0 \
2730        -width 40 -height 10 \
2731        -font font_ui \
2732        -cursor $cursor_ptr \
2733        -yscrollcommand {.vpane.files.index.sb set} \
2734        -state disabled
2735scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2736pack .vpane.files.index.title -side top -fill x
2737pack .vpane.files.index.sb -side right -fill y
2738pack $ui_index -side left -fill both -expand 1
2739.vpane.files add .vpane.files.index -sticky nsew
2740
2741# -- Other (Add) File List
2742#
2743frame .vpane.files.other -height 100 -width 100
2744label .vpane.files.other.title -text {Untracked Files} \
2745        -background red \
2746        -font font_ui
2747text $ui_other -background white -borderwidth 0 \
2748        -width 40 -height 10 \
2749        -font font_ui \
2750        -cursor $cursor_ptr \
2751        -yscrollcommand {.vpane.files.other.sb set} \
2752        -state disabled
2753scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2754pack .vpane.files.other.title -side top -fill x
2755pack .vpane.files.other.sb -side right -fill y
2756pack $ui_other -side left -fill both -expand 1
2757.vpane.files add .vpane.files.other -sticky nsew
2758
2759foreach i [list $ui_index $ui_other] {
2760        $i tag conf in_diff -font font_uibold
2761        $i tag conf in_sel \
2762                -background [$i cget -foreground] \
2763                -foreground [$i cget -background]
2764}
2765unset i
2766
2767# -- Diff and Commit Area
2768#
2769frame .vpane.lower -height 300 -width 400
2770frame .vpane.lower.commarea
2771frame .vpane.lower.diff -relief sunken -borderwidth 1
2772pack .vpane.lower.commarea -side top -fill x
2773pack .vpane.lower.diff -side bottom -fill both -expand 1
2774.vpane add .vpane.lower -stick nsew
2775
2776# -- Commit Area Buttons
2777#
2778frame .vpane.lower.commarea.buttons
2779label .vpane.lower.commarea.buttons.l -text {} \
2780        -anchor w \
2781        -justify left \
2782        -font font_ui
2783pack .vpane.lower.commarea.buttons.l -side top -fill x
2784pack .vpane.lower.commarea.buttons -side left -fill y
2785
2786button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2787        -command do_rescan \
2788        -font font_ui
2789pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2790lappend disable_on_lock \
2791        {.vpane.lower.commarea.buttons.rescan conf -state}
2792
2793button .vpane.lower.commarea.buttons.incall -text {Include All} \
2794        -command do_include_all \
2795        -font font_ui
2796pack .vpane.lower.commarea.buttons.incall -side top -fill x
2797lappend disable_on_lock \
2798        {.vpane.lower.commarea.buttons.incall conf -state}
2799
2800button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2801        -command do_signoff \
2802        -font font_ui
2803pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2804
2805button .vpane.lower.commarea.buttons.commit -text {Commit} \
2806        -command do_commit \
2807        -font font_ui
2808pack .vpane.lower.commarea.buttons.commit -side top -fill x
2809lappend disable_on_lock \
2810        {.vpane.lower.commarea.buttons.commit conf -state}
2811
2812# -- Commit Message Buffer
2813#
2814frame .vpane.lower.commarea.buffer
2815frame .vpane.lower.commarea.buffer.header
2816set ui_comm .vpane.lower.commarea.buffer.t
2817set ui_coml .vpane.lower.commarea.buffer.header.l
2818radiobutton .vpane.lower.commarea.buffer.header.new \
2819        -text {New Commit} \
2820        -command do_select_commit_type \
2821        -variable selected_commit_type \
2822        -value new \
2823        -font font_ui
2824lappend disable_on_lock \
2825        [list .vpane.lower.commarea.buffer.header.new conf -state]
2826radiobutton .vpane.lower.commarea.buffer.header.amend \
2827        -text {Amend Last Commit} \
2828        -command do_select_commit_type \
2829        -variable selected_commit_type \
2830        -value amend \
2831        -font font_ui
2832lappend disable_on_lock \
2833        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2834label $ui_coml \
2835        -anchor w \
2836        -justify left \
2837        -font font_ui
2838proc trace_commit_type {varname args} {
2839        global ui_coml commit_type
2840        switch -glob -- $commit_type {
2841        initial       {set txt {Initial Commit Message:}}
2842        amend         {set txt {Amended Commit Message:}}
2843        amend-initial {set txt {Amended Initial Commit Message:}}
2844        merge         {set txt {Merge Commit Message:}}
2845        *             {set txt {Commit Message:}}
2846        }
2847        $ui_coml conf -text $txt
2848}
2849trace add variable commit_type write trace_commit_type
2850pack $ui_coml -side left -fill x
2851pack .vpane.lower.commarea.buffer.header.amend -side right
2852pack .vpane.lower.commarea.buffer.header.new -side right
2853
2854text $ui_comm -background white -borderwidth 1 \
2855        -undo true \
2856        -maxundo 20 \
2857        -autoseparators true \
2858        -relief sunken \
2859        -width 75 -height 9 -wrap none \
2860        -font font_diff \
2861        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2862scrollbar .vpane.lower.commarea.buffer.sby \
2863        -command [list $ui_comm yview]
2864pack .vpane.lower.commarea.buffer.header -side top -fill x
2865pack .vpane.lower.commarea.buffer.sby -side right -fill y
2866pack $ui_comm -side left -fill y
2867pack .vpane.lower.commarea.buffer -side left -fill y
2868
2869# -- Commit Message Buffer Context Menu
2870#
2871set ctxm .vpane.lower.commarea.buffer.ctxm
2872menu $ctxm -tearoff 0
2873$ctxm add command \
2874        -label {Cut} \
2875        -font font_ui \
2876        -command {tk_textCut $ui_comm}
2877$ctxm add command \
2878        -label {Copy} \
2879        -font font_ui \
2880        -command {tk_textCopy $ui_comm}
2881$ctxm add command \
2882        -label {Paste} \
2883        -font font_ui \
2884        -command {tk_textPaste $ui_comm}
2885$ctxm add command \
2886        -label {Delete} \
2887        -font font_ui \
2888        -command {$ui_comm delete sel.first sel.last}
2889$ctxm add separator
2890$ctxm add command \
2891        -label {Select All} \
2892        -font font_ui \
2893        -command {$ui_comm tag add sel 0.0 end}
2894$ctxm add command \
2895        -label {Copy All} \
2896        -font font_ui \
2897        -command {
2898                $ui_comm tag add sel 0.0 end
2899                tk_textCopy $ui_comm
2900                $ui_comm tag remove sel 0.0 end
2901        }
2902$ctxm add separator
2903$ctxm add command \
2904        -label {Sign Off} \
2905        -font font_ui \
2906        -command do_signoff
2907bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2908
2909# -- Diff Header
2910#
2911set current_diff {}
2912set diff_actions [list]
2913proc trace_current_diff {varname args} {
2914        global current_diff diff_actions file_states
2915        if {$current_diff eq {}} {
2916                set s {}
2917                set f {}
2918                set p {}
2919                set o disabled
2920        } else {
2921                set p $current_diff
2922                set s [mapdesc [lindex $file_states($p) 0] $p]
2923                set f {File:}
2924                set p [escape_path $p]
2925                set o normal
2926        }
2927
2928        .vpane.lower.diff.header.status configure -text $s
2929        .vpane.lower.diff.header.file configure -text $f
2930        .vpane.lower.diff.header.path configure -text $p
2931        foreach w $diff_actions {
2932                uplevel #0 $w $o
2933        }
2934}
2935trace add variable current_diff write trace_current_diff
2936
2937frame .vpane.lower.diff.header -background orange
2938label .vpane.lower.diff.header.status \
2939        -background orange \
2940        -width $max_status_desc \
2941        -anchor w \
2942        -justify left \
2943        -font font_ui
2944label .vpane.lower.diff.header.file \
2945        -background orange \
2946        -anchor w \
2947        -justify left \
2948        -font font_ui
2949label .vpane.lower.diff.header.path \
2950        -background orange \
2951        -anchor w \
2952        -justify left \
2953        -font font_ui
2954pack .vpane.lower.diff.header.status -side left
2955pack .vpane.lower.diff.header.file -side left
2956pack .vpane.lower.diff.header.path -fill x
2957set ctxm .vpane.lower.diff.header.ctxm
2958menu $ctxm -tearoff 0
2959$ctxm add command \
2960        -label {Copy} \
2961        -font font_ui \
2962        -command {
2963                clipboard clear
2964                clipboard append \
2965                        -format STRING \
2966                        -type STRING \
2967                        -- $current_diff
2968        }
2969lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2970bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2971
2972# -- Diff Body
2973#
2974frame .vpane.lower.diff.body
2975set ui_diff .vpane.lower.diff.body.t
2976text $ui_diff -background white -borderwidth 0 \
2977        -width 80 -height 15 -wrap none \
2978        -font font_diff \
2979        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2980        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2981        -state disabled
2982scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2983        -command [list $ui_diff xview]
2984scrollbar .vpane.lower.diff.body.sby -orient vertical \
2985        -command [list $ui_diff yview]
2986pack .vpane.lower.diff.body.sbx -side bottom -fill x
2987pack .vpane.lower.diff.body.sby -side right -fill y
2988pack $ui_diff -side left -fill both -expand 1
2989pack .vpane.lower.diff.header -side top -fill x
2990pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2991
2992$ui_diff tag conf d_@ -font font_diffbold
2993$ui_diff tag conf d_+  -foreground blue
2994$ui_diff tag conf d_-  -foreground red
2995$ui_diff tag conf d_++ -foreground {#00a000}
2996$ui_diff tag conf d_-- -foreground {#a000a0}
2997$ui_diff tag conf d_+- \
2998        -foreground red \
2999        -background {light goldenrod yellow}
3000$ui_diff tag conf d_-+ \
3001        -foreground blue \
3002        -background azure2
3003
3004# -- Diff Body Context Menu
3005#
3006set ctxm .vpane.lower.diff.body.ctxm
3007menu $ctxm -tearoff 0
3008$ctxm add command \
3009        -label {Copy} \
3010        -font font_ui \
3011        -command {tk_textCopy $ui_diff}
3012lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3013$ctxm add command \
3014        -label {Select All} \
3015        -font font_ui \
3016        -command {$ui_diff tag add sel 0.0 end}
3017lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3018$ctxm add command \
3019        -label {Copy All} \
3020        -font font_ui \
3021        -command {
3022                $ui_diff tag add sel 0.0 end
3023                tk_textCopy $ui_diff
3024                $ui_diff tag remove sel 0.0 end
3025        }
3026lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3027$ctxm add separator
3028$ctxm add command \
3029        -label {Decrease Font Size} \
3030        -font font_ui \
3031        -command {incr_font_size font_diff -1}
3032lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3033$ctxm add command \
3034        -label {Increase Font Size} \
3035        -font font_ui \
3036        -command {incr_font_size font_diff 1}
3037lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3038$ctxm add separator
3039$ctxm add command \
3040        -label {Show Less Context} \
3041        -font font_ui \
3042        -command {if {$repo_config(gui.diffcontext) >= 2} {
3043                incr repo_config(gui.diffcontext) -1
3044                reshow_diff
3045        }}
3046lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3047$ctxm add command \
3048        -label {Show More Context} \
3049        -font font_ui \
3050        -command {
3051                incr repo_config(gui.diffcontext)
3052                reshow_diff
3053        }
3054lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3055$ctxm add separator
3056$ctxm add command -label {Options...} \
3057        -font font_ui \
3058        -command do_options
3059bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3060
3061# -- Status Bar
3062#
3063set ui_status_value {Initializing...}
3064label .status -textvariable ui_status_value \
3065        -anchor w \
3066        -justify left \
3067        -borderwidth 1 \
3068        -relief sunken \
3069        -font font_ui
3070pack .status -anchor w -side bottom -fill x
3071
3072# -- Load geometry
3073#
3074catch {
3075set gm $repo_config(gui.geometry)
3076wm geometry . [lindex $gm 0]
3077.vpane sash place 0 \
3078        [lindex [.vpane sash coord 0] 0] \
3079        [lindex $gm 1]
3080.vpane.files sash place 0 \
3081        [lindex $gm 2] \
3082        [lindex [.vpane.files sash coord 0] 1]
3083unset gm
3084}
3085
3086# -- Key Bindings
3087#
3088bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3089bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3090bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3091bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3092bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3093bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3094bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3095bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3096bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3097bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3098bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3099
3100bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3101bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3102bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3103bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3104bind $ui_diff <$M1B-Key-v> {break}
3105bind $ui_diff <$M1B-Key-V> {break}
3106bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3107bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3108bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3109bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3110bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3111bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3112
3113bind .   <Destroy> do_quit
3114bind all <Key-F5> do_rescan
3115bind all <$M1B-Key-r> do_rescan
3116bind all <$M1B-Key-R> do_rescan
3117bind .   <$M1B-Key-s> do_signoff
3118bind .   <$M1B-Key-S> do_signoff
3119bind .   <$M1B-Key-i> do_include_all
3120bind .   <$M1B-Key-I> do_include_all
3121bind .   <$M1B-Key-Return> do_commit
3122bind all <$M1B-Key-q> do_quit
3123bind all <$M1B-Key-Q> do_quit
3124bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3125bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3126foreach i [list $ui_index $ui_other] {
3127        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3128        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3129        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3130}
3131unset i
3132
3133set file_lists($ui_index) [list]
3134set file_lists($ui_other) [list]
3135
3136set HEAD {}
3137set PARENT {}
3138set commit_type {}
3139set empty_tree {}
3140set current_diff {}
3141set selected_commit_type new
3142
3143wm title . "$appname ([file normalize [file dirname $gitdir]])"
3144focus -force $ui_comm
3145if {!$single_commit} {
3146        load_all_remotes
3147        populate_fetch_menu .mbar.fetch
3148        populate_pull_menu .mbar.pull
3149        populate_push_menu .mbar.push
3150}
3151lock_index begin-read
3152after 1 do_rescan