git-guion commit git-gui: Update in memory states after commit. (a29481e)
   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 rescan_active
 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 in memory status
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                _O -
1033                _M -
1034                _D {continue}
1035                __ -
1036                A_ -
1037                M_ -
1038                DD {
1039                        unset file_states($path)
1040                        catch {unset selected_paths($path)}
1041                }
1042                DO {
1043                        set file_states($path) [list _O [lindex $s 1] {} {}]
1044                }
1045                AM -
1046                AD -
1047                MM -
1048                DM {
1049                        set file_states($path) [list \
1050                                _[string index $m 1] \
1051                                [lindex $s 1] \
1052                                [lindex $s 3] \
1053                                {}]
1054                }
1055                }
1056        }
1057
1058        display_all_files
1059        unlock_index
1060        reshow_diff
1061        set ui_status_value \
1062                "Changes committed as [string range $cmt_id 0 7]."
1063}
1064
1065######################################################################
1066##
1067## fetch pull push
1068
1069proc fetch_from {remote} {
1070        set w [new_console "fetch $remote" \
1071                "Fetching new changes from $remote"]
1072        set cmd [list git fetch]
1073        lappend cmd $remote
1074        console_exec $w $cmd
1075}
1076
1077proc pull_remote {remote branch} {
1078        global HEAD commit_type file_states repo_config
1079
1080        if {![lock_index update]} return
1081
1082        # -- Our in memory state should match the repository.
1083        #
1084        repository_state curHEAD cur_type
1085        if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1086                error_popup {Last scanned state does not match repository state.
1087
1088Its highly likely that another Git program modified the
1089repository since our last scan.  A rescan is required
1090before a pull can be started.
1091}
1092                unlock_index
1093                rescan {set ui_status_value {Ready.}}
1094                return
1095        }
1096
1097        # -- No differences should exist before a pull.
1098        #
1099        if {[array size file_states] != 0} {
1100                error_popup {Uncommitted but modified files are present.
1101
1102You should not perform a pull with unmodified files in your working
1103directory as Git would be unable to recover from an incorrect merge.
1104
1105Commit or throw away all changes before starting a pull operation.
1106}
1107                unlock_index
1108                return
1109        }
1110
1111        set w [new_console "pull $remote $branch" \
1112                "Pulling new changes from branch $branch in $remote"]
1113        set cmd [list git pull]
1114        if {$repo_config(gui.pullsummary) eq {false}} {
1115                lappend cmd --no-summary
1116        }
1117        lappend cmd $remote
1118        lappend cmd $branch
1119        console_exec $w $cmd [list post_pull_remote $remote $branch]
1120}
1121
1122proc post_pull_remote {remote branch success} {
1123        global HEAD PARENT commit_type selected_commit_type
1124        global ui_status_value
1125
1126        unlock_index
1127        if {$success} {
1128                repository_state HEAD commit_type
1129                set PARENT $HEAD
1130                set selected_commit_type new
1131                set $ui_status_value "Pulling $branch from $remote complete."
1132        } else {
1133                set m "Conflicts detected while pulling $branch from $remote."
1134                rescan "set ui_status_value {$m}"
1135        }
1136}
1137
1138proc push_to {remote} {
1139        set w [new_console "push $remote" \
1140                "Pushing changes to $remote"]
1141        set cmd [list git push]
1142        lappend cmd $remote
1143        console_exec $w $cmd
1144}
1145
1146######################################################################
1147##
1148## ui helpers
1149
1150proc mapcol {state path} {
1151        global all_cols ui_other
1152
1153        if {[catch {set r $all_cols($state)}]} {
1154                puts "error: no column for state={$state} $path"
1155                return $ui_other
1156        }
1157        return $r
1158}
1159
1160proc mapicon {state path} {
1161        global all_icons
1162
1163        if {[catch {set r $all_icons($state)}]} {
1164                puts "error: no icon for state={$state} $path"
1165                return file_plain
1166        }
1167        return $r
1168}
1169
1170proc mapdesc {state path} {
1171        global all_descs
1172
1173        if {[catch {set r $all_descs($state)}]} {
1174                puts "error: no desc for state={$state} $path"
1175                return $state
1176        }
1177        return $r
1178}
1179
1180proc escape_path {path} {
1181        regsub -all "\n" $path "\\n" path
1182        return $path
1183}
1184
1185proc short_path {path} {
1186        return [escape_path [lindex [file split $path] end]]
1187}
1188
1189set next_icon_id 0
1190set null_sha1 [string repeat 0 40]
1191
1192proc merge_state {path new_state {head_info {}} {index_info {}}} {
1193        global file_states next_icon_id null_sha1
1194
1195        set s0 [string index $new_state 0]
1196        set s1 [string index $new_state 1]
1197
1198        if {[catch {set info $file_states($path)}]} {
1199                set state __
1200                set icon n[incr next_icon_id]
1201        } else {
1202                set state [lindex $info 0]
1203                set icon [lindex $info 1]
1204                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1205                if {$index_info eq {}} {set index_info [lindex $info 3]}
1206        }
1207
1208        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1209        elseif {$s0 eq {_}} {set s0 _}
1210
1211        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1212        elseif {$s1 eq {_}} {set s1 _}
1213
1214        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1215                set head_info [list 0 $null_sha1]
1216        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1217                && $head_info eq {}} {
1218                set head_info $index_info
1219        }
1220
1221        set file_states($path) [list $s0$s1 $icon \
1222                $head_info $index_info \
1223                ]
1224        return $state
1225}
1226
1227proc display_file {path state} {
1228        global file_states file_lists selected_paths
1229
1230        set old_m [merge_state $path $state]
1231        set s $file_states($path)
1232        set new_m [lindex $s 0]
1233        set new_w [mapcol $new_m $path] 
1234        set old_w [mapcol $old_m $path]
1235        set new_icon [mapicon $new_m $path]
1236
1237        if {$new_w ne $old_w} {
1238                set lno [lsearch -sorted $file_lists($old_w) $path]
1239                if {$lno >= 0} {
1240                        incr lno
1241                        $old_w conf -state normal
1242                        $old_w delete $lno.0 [expr {$lno + 1}].0
1243                        $old_w conf -state disabled
1244                }
1245
1246                lappend file_lists($new_w) $path
1247                set file_lists($new_w) [lsort $file_lists($new_w)]
1248                set lno [lsearch -sorted $file_lists($new_w) $path]
1249                incr lno
1250                $new_w conf -state normal
1251                $new_w image create $lno.0 \
1252                        -align center -padx 5 -pady 1 \
1253                        -name [lindex $s 1] \
1254                        -image $new_icon
1255                $new_w insert $lno.1 "[escape_path $path]\n"
1256                if {[catch {set in_sel $selected_paths($path)}]} {
1257                        set in_sel 0
1258                }
1259                if {$in_sel} {
1260                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1261                }
1262                $new_w conf -state disabled
1263        } elseif {$new_icon ne [mapicon $old_m $path]} {
1264                $new_w conf -state normal
1265                $new_w image conf [lindex $s 1] -image $new_icon
1266                $new_w conf -state disabled
1267        }
1268}
1269
1270proc display_all_files {} {
1271        global ui_index ui_other
1272        global file_states file_lists
1273        global last_clicked selected_paths
1274
1275        $ui_index conf -state normal
1276        $ui_other conf -state normal
1277
1278        $ui_index delete 0.0 end
1279        $ui_other delete 0.0 end
1280        set last_clicked {}
1281
1282        set file_lists($ui_index) [list]
1283        set file_lists($ui_other) [list]
1284
1285        foreach path [lsort [array names file_states]] {
1286                set s $file_states($path)
1287                set m [lindex $s 0]
1288                set w [mapcol $m $path]
1289                lappend file_lists($w) $path
1290                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1291                $w image create end \
1292                        -align center -padx 5 -pady 1 \
1293                        -name [lindex $s 1] \
1294                        -image [mapicon $m $path]
1295                $w insert end "[escape_path $path]\n"
1296                if {[catch {set in_sel $selected_paths($path)}]} {
1297                        set in_sel 0
1298                }
1299                if {$in_sel} {
1300                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1301                }
1302        }
1303
1304        $ui_index conf -state disabled
1305        $ui_other conf -state disabled
1306}
1307
1308proc update_indexinfo {msg pathList after} {
1309        global update_index_cp ui_status_value
1310
1311        if {![lock_index update]} return
1312
1313        set update_index_cp 0
1314        set pathList [lsort $pathList]
1315        set totalCnt [llength $pathList]
1316        set batch [expr {int($totalCnt * .01) + 1}]
1317        if {$batch > 25} {set batch 25}
1318
1319        set ui_status_value [format \
1320                "$msg... %i/%i files (%.2f%%)" \
1321                $update_index_cp \
1322                $totalCnt \
1323                0.0]
1324        set fd [open "| git update-index -z --index-info" w]
1325        fconfigure $fd \
1326                -blocking 0 \
1327                -buffering full \
1328                -buffersize 512 \
1329                -translation binary
1330        fileevent $fd writable [list \
1331                write_update_indexinfo \
1332                $fd \
1333                $pathList \
1334                $totalCnt \
1335                $batch \
1336                $msg \
1337                $after \
1338                ]
1339}
1340
1341proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1342        global update_index_cp ui_status_value
1343        global file_states current_diff
1344
1345        if {$update_index_cp >= $totalCnt} {
1346                close $fd
1347                unlock_index
1348                uplevel #0 $after
1349                return
1350        }
1351
1352        for {set i $batch} \
1353                {$update_index_cp < $totalCnt && $i > 0} \
1354                {incr i -1} {
1355                set path [lindex $pathList $update_index_cp]
1356                incr update_index_cp
1357
1358                set s $file_states($path)
1359                switch -glob -- [lindex $s 0] {
1360                A? {set new _O}
1361                M? {set new _M}
1362                D? {set new _?}
1363                ?? {continue}
1364                }
1365                set info [lindex $s 2]
1366                if {$info eq {}} continue
1367
1368                puts -nonewline $fd $info
1369                puts -nonewline $fd "\t"
1370                puts -nonewline $fd $path
1371                puts -nonewline $fd "\0"
1372                display_file $path $new
1373        }
1374
1375        set ui_status_value [format \
1376                "$msg... %i/%i files (%.2f%%)" \
1377                $update_index_cp \
1378                $totalCnt \
1379                [expr {100.0 * $update_index_cp / $totalCnt}]]
1380}
1381
1382proc update_index {msg pathList after} {
1383        global update_index_cp ui_status_value
1384
1385        if {![lock_index update]} return
1386
1387        set update_index_cp 0
1388        set pathList [lsort $pathList]
1389        set totalCnt [llength $pathList]
1390        set batch [expr {int($totalCnt * .01) + 1}]
1391        if {$batch > 25} {set batch 25}
1392
1393        set ui_status_value [format \
1394                "$msg... %i/%i files (%.2f%%)" \
1395                $update_index_cp \
1396                $totalCnt \
1397                0.0]
1398        set fd [open "| git update-index --add --remove -z --stdin" w]
1399        fconfigure $fd \
1400                -blocking 0 \
1401                -buffering full \
1402                -buffersize 512 \
1403                -translation binary
1404        fileevent $fd writable [list \
1405                write_update_index \
1406                $fd \
1407                $pathList \
1408                $totalCnt \
1409                $batch \
1410                $msg \
1411                $after \
1412                ]
1413}
1414
1415proc write_update_index {fd pathList totalCnt batch msg after} {
1416        global update_index_cp ui_status_value
1417        global file_states current_diff
1418
1419        if {$update_index_cp >= $totalCnt} {
1420                close $fd
1421                unlock_index
1422                uplevel #0 $after
1423                return
1424        }
1425
1426        for {set i $batch} \
1427                {$update_index_cp < $totalCnt && $i > 0} \
1428                {incr i -1} {
1429                set path [lindex $pathList $update_index_cp]
1430                incr update_index_cp
1431
1432                switch -glob -- [lindex $file_states($path) 0] {
1433                AD -
1434                MD -
1435                _D {set new DD}
1436
1437                _M -
1438                MM -
1439                M_ {set new M_}
1440
1441                _O -
1442                AM -
1443                A_ {set new A_}
1444
1445                ?? {continue}
1446                }
1447
1448                puts -nonewline $fd $path
1449                puts -nonewline $fd "\0"
1450                display_file $path $new
1451        }
1452
1453        set ui_status_value [format \
1454                "$msg... %i/%i files (%.2f%%)" \
1455                $update_index_cp \
1456                $totalCnt \
1457                [expr {100.0 * $update_index_cp / $totalCnt}]]
1458}
1459
1460######################################################################
1461##
1462## remote management
1463
1464proc load_all_remotes {} {
1465        global gitdir all_remotes repo_config
1466
1467        set all_remotes [list]
1468        set rm_dir [file join $gitdir remotes]
1469        if {[file isdirectory $rm_dir]} {
1470                set all_remotes [concat $all_remotes [glob \
1471                        -types f \
1472                        -tails \
1473                        -nocomplain \
1474                        -directory $rm_dir *]]
1475        }
1476
1477        foreach line [array names repo_config remote.*.url] {
1478                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1479                        lappend all_remotes $name
1480                }
1481        }
1482
1483        set all_remotes [lsort -unique $all_remotes]
1484}
1485
1486proc populate_fetch_menu {m} {
1487        global gitdir all_remotes repo_config
1488
1489        foreach r $all_remotes {
1490                set enable 0
1491                if {![catch {set a $repo_config(remote.$r.url)}]} {
1492                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1493                                set enable 1
1494                        }
1495                } else {
1496                        catch {
1497                                set fd [open [file join $gitdir remotes $r] r]
1498                                while {[gets $fd n] >= 0} {
1499                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1500                                                set enable 1
1501                                                break
1502                                        }
1503                                }
1504                                close $fd
1505                        }
1506                }
1507
1508                if {$enable} {
1509                        $m add command \
1510                                -label "Fetch from $r..." \
1511                                -command [list fetch_from $r] \
1512                                -font font_ui
1513                }
1514        }
1515}
1516
1517proc populate_push_menu {m} {
1518        global gitdir all_remotes repo_config
1519
1520        foreach r $all_remotes {
1521                set enable 0
1522                if {![catch {set a $repo_config(remote.$r.url)}]} {
1523                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1524                                set enable 1
1525                        }
1526                } else {
1527                        catch {
1528                                set fd [open [file join $gitdir remotes $r] r]
1529                                while {[gets $fd n] >= 0} {
1530                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1531                                                set enable 1
1532                                                break
1533                                        }
1534                                }
1535                                close $fd
1536                        }
1537                }
1538
1539                if {$enable} {
1540                        $m add command \
1541                                -label "Push to $r..." \
1542                                -command [list push_to $r] \
1543                                -font font_ui
1544                }
1545        }
1546}
1547
1548proc populate_pull_menu {m} {
1549        global gitdir repo_config all_remotes disable_on_lock
1550
1551        foreach remote $all_remotes {
1552                set rb {}
1553                if {[array get repo_config remote.$remote.url] ne {}} {
1554                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1555                                regexp {^([^:]+):} \
1556                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1557                                        line rb
1558                        }
1559                } else {
1560                        catch {
1561                                set fd [open [file join $gitdir remotes $remote] r]
1562                                while {[gets $fd line] >= 0} {
1563                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1564                                                break
1565                                        }
1566                                }
1567                                close $fd
1568                        }
1569                }
1570
1571                set rb_short $rb
1572                regsub ^refs/heads/ $rb {} rb_short
1573                if {$rb_short ne {}} {
1574                        $m add command \
1575                                -label "Branch $rb_short from $remote..." \
1576                                -command [list pull_remote $remote $rb] \
1577                                -font font_ui
1578                        lappend disable_on_lock \
1579                                [list $m entryconf [$m index last] -state]
1580                }
1581        }
1582}
1583
1584######################################################################
1585##
1586## icons
1587
1588set filemask {
1589#define mask_width 14
1590#define mask_height 15
1591static unsigned char mask_bits[] = {
1592   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1593   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1594   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1595}
1596
1597image create bitmap file_plain -background white -foreground black -data {
1598#define plain_width 14
1599#define plain_height 15
1600static unsigned char plain_bits[] = {
1601   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1602   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1603   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1604} -maskdata $filemask
1605
1606image create bitmap file_mod -background white -foreground blue -data {
1607#define mod_width 14
1608#define mod_height 15
1609static unsigned char mod_bits[] = {
1610   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1611   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1612   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1613} -maskdata $filemask
1614
1615image create bitmap file_fulltick -background white -foreground "#007000" -data {
1616#define file_fulltick_width 14
1617#define file_fulltick_height 15
1618static unsigned char file_fulltick_bits[] = {
1619   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1620   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1621   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1622} -maskdata $filemask
1623
1624image create bitmap file_parttick -background white -foreground "#005050" -data {
1625#define parttick_width 14
1626#define parttick_height 15
1627static unsigned char parttick_bits[] = {
1628   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1629   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1630   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1631} -maskdata $filemask
1632
1633image create bitmap file_question -background white -foreground black -data {
1634#define file_question_width 14
1635#define file_question_height 15
1636static unsigned char file_question_bits[] = {
1637   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1638   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1639   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1640} -maskdata $filemask
1641
1642image create bitmap file_removed -background white -foreground red -data {
1643#define file_removed_width 14
1644#define file_removed_height 15
1645static unsigned char file_removed_bits[] = {
1646   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1647   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1648   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1649} -maskdata $filemask
1650
1651image create bitmap file_merge -background white -foreground blue -data {
1652#define file_merge_width 14
1653#define file_merge_height 15
1654static unsigned char file_merge_bits[] = {
1655   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1656   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1657   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1658} -maskdata $filemask
1659
1660set ui_index .vpane.files.index.list
1661set ui_other .vpane.files.other.list
1662set max_status_desc 0
1663foreach i {
1664                {__ i plain    "Unmodified"}
1665                {_M i mod      "Modified"}
1666                {M_ i fulltick "Included in commit"}
1667                {MM i parttick "Partially included"}
1668
1669                {_O o plain    "Untracked"}
1670                {A_ o fulltick "Added by commit"}
1671                {AM o parttick "Partially added"}
1672                {AD o question "Added (but now gone)"}
1673
1674                {_D i question "Missing"}
1675                {DD i removed  "Removed by commit"}
1676                {DO i removed  "Removed (still exists)"}
1677                {DM i removed  "Removed (but modified)"}
1678
1679                {UM i merge    "Merge conflicts"}
1680                {U_ i merge    "Merge conflicts"}
1681        } {
1682        if {$max_status_desc < [string length [lindex $i 3]]} {
1683                set max_status_desc [string length [lindex $i 3]]
1684        }
1685        if {[lindex $i 1] eq {i}} {
1686                set all_cols([lindex $i 0]) $ui_index
1687        } else {
1688                set all_cols([lindex $i 0]) $ui_other
1689        }
1690        set all_icons([lindex $i 0]) file_[lindex $i 2]
1691        set all_descs([lindex $i 0]) [lindex $i 3]
1692}
1693unset filemask i
1694
1695######################################################################
1696##
1697## util
1698
1699proc is_MacOSX {} {
1700        global tcl_platform tk_library
1701        if {$tcl_platform(platform) eq {unix}
1702                && $tcl_platform(os) eq {Darwin}
1703                && [string match /Library/Frameworks/* $tk_library]} {
1704                return 1
1705        }
1706        return 0
1707}
1708
1709proc bind_button3 {w cmd} {
1710        bind $w <Any-Button-3> $cmd
1711        if {[is_MacOSX]} {
1712                bind $w <Control-Button-1> $cmd
1713        }
1714}
1715
1716proc incr_font_size {font {amt 1}} {
1717        set sz [font configure $font -size]
1718        incr sz $amt
1719        font configure $font -size $sz
1720        font configure ${font}bold -size $sz
1721}
1722
1723proc hook_failed_popup {hook msg} {
1724        global gitdir appname
1725
1726        set w .hookfail
1727        toplevel $w
1728
1729        frame $w.m
1730        label $w.m.l1 -text "$hook hook failed:" \
1731                -anchor w \
1732                -justify left \
1733                -font font_uibold
1734        text $w.m.t \
1735                -background white -borderwidth 1 \
1736                -relief sunken \
1737                -width 80 -height 10 \
1738                -font font_diff \
1739                -yscrollcommand [list $w.m.sby set]
1740        label $w.m.l2 \
1741                -text {You must correct the above errors before committing.} \
1742                -anchor w \
1743                -justify left \
1744                -font font_uibold
1745        scrollbar $w.m.sby -command [list $w.m.t yview]
1746        pack $w.m.l1 -side top -fill x
1747        pack $w.m.l2 -side bottom -fill x
1748        pack $w.m.sby -side right -fill y
1749        pack $w.m.t -side left -fill both -expand 1
1750        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1751
1752        $w.m.t insert 1.0 $msg
1753        $w.m.t conf -state disabled
1754
1755        button $w.ok -text OK \
1756                -width 15 \
1757                -font font_ui \
1758                -command "destroy $w"
1759        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1760
1761        bind $w <Visibility> "grab $w; focus $w"
1762        bind $w <Key-Return> "destroy $w"
1763        wm title $w "$appname ([lindex [file split \
1764                [file normalize [file dirname $gitdir]]] \
1765                end]): error"
1766        tkwait window $w
1767}
1768
1769set next_console_id 0
1770
1771proc new_console {short_title long_title} {
1772        global next_console_id console_data
1773        set w .console[incr next_console_id]
1774        set console_data($w) [list $short_title $long_title]
1775        return [console_init $w]
1776}
1777
1778proc console_init {w} {
1779        global console_cr console_data
1780        global gitdir appname M1B
1781
1782        set console_cr($w) 1.0
1783        toplevel $w
1784        frame $w.m
1785        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1786                -anchor w \
1787                -justify left \
1788                -font font_uibold
1789        text $w.m.t \
1790                -background white -borderwidth 1 \
1791                -relief sunken \
1792                -width 80 -height 10 \
1793                -font font_diff \
1794                -state disabled \
1795                -yscrollcommand [list $w.m.sby set]
1796        label $w.m.s -text {Working... please wait...} \
1797                -anchor w \
1798                -justify left \
1799                -font font_uibold
1800        scrollbar $w.m.sby -command [list $w.m.t yview]
1801        pack $w.m.l1 -side top -fill x
1802        pack $w.m.s -side bottom -fill x
1803        pack $w.m.sby -side right -fill y
1804        pack $w.m.t -side left -fill both -expand 1
1805        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1806
1807        menu $w.ctxm -tearoff 0
1808        $w.ctxm add command -label "Copy" \
1809                -font font_ui \
1810                -command "tk_textCopy $w.m.t"
1811        $w.ctxm add command -label "Select All" \
1812                -font font_ui \
1813                -command "$w.m.t tag add sel 0.0 end"
1814        $w.ctxm add command -label "Copy All" \
1815                -font font_ui \
1816                -command "
1817                        $w.m.t tag add sel 0.0 end
1818                        tk_textCopy $w.m.t
1819                        $w.m.t tag remove sel 0.0 end
1820                "
1821
1822        button $w.ok -text {Close} \
1823                -font font_ui \
1824                -state disabled \
1825                -command "destroy $w"
1826        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1827
1828        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1829        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1830        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1831        bind $w <Visibility> "focus $w"
1832        wm title $w "$appname ([lindex [file split \
1833                [file normalize [file dirname $gitdir]]] \
1834                end]): [lindex $console_data($w) 0]"
1835        return $w
1836}
1837
1838proc console_exec {w cmd {after {}}} {
1839        global tcl_platform
1840
1841        # -- Windows tosses the enviroment when we exec our child.
1842        #    But most users need that so we have to relogin. :-(
1843        #
1844        if {$tcl_platform(platform) eq {windows}} {
1845                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1846        }
1847
1848        # -- Tcl won't let us redirect both stdout and stderr to
1849        #    the same pipe.  So pass it through cat...
1850        #
1851        set cmd [concat | $cmd |& cat]
1852
1853        set fd_f [open $cmd r]
1854        fconfigure $fd_f -blocking 0 -translation binary
1855        fileevent $fd_f readable [list console_read $w $fd_f $after]
1856}
1857
1858proc console_read {w fd after} {
1859        global console_cr console_data
1860
1861        set buf [read $fd]
1862        if {$buf ne {}} {
1863                if {![winfo exists $w]} {console_init $w}
1864                $w.m.t conf -state normal
1865                set c 0
1866                set n [string length $buf]
1867                while {$c < $n} {
1868                        set cr [string first "\r" $buf $c]
1869                        set lf [string first "\n" $buf $c]
1870                        if {$cr < 0} {set cr [expr {$n + 1}]}
1871                        if {$lf < 0} {set lf [expr {$n + 1}]}
1872
1873                        if {$lf < $cr} {
1874                                $w.m.t insert end [string range $buf $c $lf]
1875                                set console_cr($w) [$w.m.t index {end -1c}]
1876                                set c $lf
1877                                incr c
1878                        } else {
1879                                $w.m.t delete $console_cr($w) end
1880                                $w.m.t insert end "\n"
1881                                $w.m.t insert end [string range $buf $c $cr]
1882                                set c $cr
1883                                incr c
1884                        }
1885                }
1886                $w.m.t conf -state disabled
1887                $w.m.t see end
1888        }
1889
1890        fconfigure $fd -blocking 1
1891        if {[eof $fd]} {
1892                if {[catch {close $fd}]} {
1893                        if {![winfo exists $w]} {console_init $w}
1894                        $w.m.s conf -background red -text {Error: Command Failed}
1895                        $w.ok conf -state normal
1896                        set ok 0
1897                } elseif {[winfo exists $w]} {
1898                        $w.m.s conf -background green -text {Success}
1899                        $w.ok conf -state normal
1900                        set ok 1
1901                }
1902                array unset console_cr $w
1903                array unset console_data $w
1904                if {$after ne {}} {
1905                        uplevel #0 $after $ok
1906                }
1907                return
1908        }
1909        fconfigure $fd -blocking 0
1910}
1911
1912######################################################################
1913##
1914## ui commands
1915
1916set starting_gitk_msg {Please wait... Starting gitk...}
1917
1918proc do_gitk {} {
1919        global tcl_platform ui_status_value starting_gitk_msg
1920
1921        set ui_status_value $starting_gitk_msg
1922        after 10000 {
1923                if {$ui_status_value eq $starting_gitk_msg} {
1924                        set ui_status_value {Ready.}
1925                }
1926        }
1927
1928        if {$tcl_platform(platform) eq {windows}} {
1929                exec sh -c gitk &
1930        } else {
1931                exec gitk &
1932        }
1933}
1934
1935proc do_repack {} {
1936        set w [new_console "repack" "Repacking the object database"]
1937        set cmd [list git repack]
1938        lappend cmd -a
1939        lappend cmd -d
1940        console_exec $w $cmd
1941}
1942
1943set is_quitting 0
1944
1945proc do_quit {} {
1946        global gitdir ui_comm is_quitting repo_config
1947
1948        if {$is_quitting} return
1949        set is_quitting 1
1950
1951        # -- Stash our current commit buffer.
1952        #
1953        set save [file join $gitdir GITGUI_MSG]
1954        set msg [string trim [$ui_comm get 0.0 end]]
1955        if {[$ui_comm edit modified] && $msg ne {}} {
1956                catch {
1957                        set fd [open $save w]
1958                        puts $fd [string trim [$ui_comm get 0.0 end]]
1959                        close $fd
1960                }
1961        } elseif {$msg eq {} && [file exists $save]} {
1962                file delete $save
1963        }
1964
1965        # -- Stash our current window geometry into this repository.
1966        #
1967        set cfg_geometry [list]
1968        lappend cfg_geometry [wm geometry .]
1969        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1970        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1971        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1972                set rc_geometry {}
1973        }
1974        if {$cfg_geometry ne $rc_geometry} {
1975                catch {exec git repo-config gui.geometry $cfg_geometry}
1976        }
1977
1978        destroy .
1979}
1980
1981proc do_rescan {} {
1982        rescan {set ui_status_value {Ready.}}
1983}
1984
1985proc remove_helper {txt paths} {
1986        global file_states current_diff
1987
1988        if {![lock_index begin-update]} return
1989
1990        set pathList [list]
1991        set after {}
1992        foreach path $paths {
1993                switch -glob -- [lindex $file_states($path) 0] {
1994                A? -
1995                M? -
1996                D? {
1997                        lappend pathList $path
1998                        if {$path eq $current_diff} {
1999                                set after {reshow_diff;}
2000                        }
2001                }
2002                }
2003        }
2004        if {$pathList eq {}} {
2005                unlock_index
2006        } else {
2007                update_indexinfo \
2008                        $txt \
2009                        $pathList \
2010                        [concat $after {set ui_status_value {Ready.}}]
2011        }
2012}
2013
2014proc do_remove_selection {} {
2015        global current_diff selected_paths
2016
2017        if {[array size selected_paths] > 0} {
2018                remove_helper \
2019                        {Removing selected files from commit} \
2020                        [array names selected_paths]
2021        } elseif {$current_diff ne {}} {
2022                remove_helper \
2023                        "Removing [short_path $current_diff] from commit" \
2024                        [list $current_diff]
2025        }
2026}
2027
2028proc include_helper {txt paths} {
2029        global file_states current_diff
2030
2031        if {![lock_index begin-update]} return
2032
2033        set pathList [list]
2034        set after {}
2035        foreach path $paths {
2036                switch -- [lindex $file_states($path) 0] {
2037                AM -
2038                AD -
2039                MM -
2040                UM -
2041                U_ -
2042                _M -
2043                _D -
2044                _O {
2045                        lappend pathList $path
2046                        if {$path eq $current_diff} {
2047                                set after {reshow_diff;}
2048                        }
2049                }
2050                }
2051        }
2052        if {$pathList eq {}} {
2053                unlock_index
2054        } else {
2055                update_index \
2056                        $txt \
2057                        $pathList \
2058                        [concat $after {set ui_status_value {Ready to commit.}}]
2059        }
2060}
2061
2062proc do_include_selection {} {
2063        global current_diff selected_paths
2064
2065        if {[array size selected_paths] > 0} {
2066                include_helper \
2067                        {Including selected files} \
2068                        [array names selected_paths]
2069        } elseif {$current_diff ne {}} {
2070                include_helper \
2071                        "Including [short_path $current_diff]" \
2072                        [list $current_diff]
2073        }
2074}
2075
2076proc do_include_all {} {
2077        global file_states
2078
2079        set paths [list]
2080        foreach path [array names file_states] {
2081                switch -- [lindex $file_states($path) 0] {
2082                AM -
2083                AD -
2084                MM -
2085                _M -
2086                _D {lappend paths $path}
2087                }
2088        }
2089        include_helper \
2090                {Including all modified files} \
2091                $paths
2092}
2093
2094proc do_signoff {} {
2095        global ui_comm
2096
2097        set me [committer_ident]
2098        if {$me eq {}} return
2099
2100        set sob "Signed-off-by: $me"
2101        set last [$ui_comm get {end -1c linestart} {end -1c}]
2102        if {$last ne $sob} {
2103                $ui_comm edit separator
2104                if {$last ne {}
2105                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2106                        $ui_comm insert end "\n"
2107                }
2108                $ui_comm insert end "\n$sob"
2109                $ui_comm edit separator
2110                $ui_comm see end
2111        }
2112}
2113
2114proc do_select_commit_type {} {
2115        global commit_type selected_commit_type
2116
2117        if {$selected_commit_type eq {new}
2118                && [string match amend* $commit_type]} {
2119                create_new_commit
2120        } elseif {$selected_commit_type eq {amend}
2121                && ![string match amend* $commit_type]} {
2122                load_last_commit
2123
2124                # The amend request was rejected...
2125                #
2126                if {![string match amend* $commit_type]} {
2127                        set selected_commit_type new
2128                }
2129        }
2130}
2131
2132proc do_commit {} {
2133        commit_tree
2134}
2135
2136proc do_options {} {
2137        global appname gitdir font_descs
2138        global repo_config global_config
2139        global repo_config_new global_config_new
2140
2141        array unset repo_config_new
2142        array unset global_config_new
2143        foreach name [array names repo_config] {
2144                set repo_config_new($name) $repo_config($name)
2145        }
2146        load_config 1
2147        foreach name [array names repo_config] {
2148                switch -- $name {
2149                gui.diffcontext {continue}
2150                }
2151                set repo_config_new($name) $repo_config($name)
2152        }
2153        foreach name [array names global_config] {
2154                set global_config_new($name) $global_config($name)
2155        }
2156        set reponame [lindex [file split \
2157                [file normalize [file dirname $gitdir]]] \
2158                end]
2159
2160        set w .options_editor
2161        toplevel $w
2162        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2163
2164        label $w.header -text "$appname Options" \
2165                -font font_uibold
2166        pack $w.header -side top -fill x
2167
2168        frame $w.buttons
2169        button $w.buttons.restore -text {Restore Defaults} \
2170                -font font_ui \
2171                -command do_restore_defaults
2172        pack $w.buttons.restore -side left
2173        button $w.buttons.save -text Save \
2174                -font font_ui \
2175                -command [list do_save_config $w]
2176        pack $w.buttons.save -side right
2177        button $w.buttons.cancel -text {Cancel} \
2178                -font font_ui \
2179                -command [list destroy $w]
2180        pack $w.buttons.cancel -side right
2181        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2182
2183        labelframe $w.repo -text "$reponame Repository" \
2184                -font font_ui \
2185                -relief raised -borderwidth 2
2186        labelframe $w.global -text {Global (All Repositories)} \
2187                -font font_ui \
2188                -relief raised -borderwidth 2
2189        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2190        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2191
2192        foreach option {
2193                {b partialinclude {Allow Partially Included Files}}
2194                {b pullsummary {Show Pull Summary}}
2195                {b trustmtime  {Trust File Modification Timestamps}}
2196                {i diffcontext {Number of Diff Context Lines}}
2197                } {
2198                set type [lindex $option 0]
2199                set name [lindex $option 1]
2200                set text [lindex $option 2]
2201                foreach f {repo global} {
2202                        switch $type {
2203                        b {
2204                                checkbutton $w.$f.$name -text $text \
2205                                        -variable ${f}_config_new(gui.$name) \
2206                                        -onvalue true \
2207                                        -offvalue false \
2208                                        -font font_ui
2209                                pack $w.$f.$name -side top -anchor w
2210                        }
2211                        i {
2212                                frame $w.$f.$name
2213                                label $w.$f.$name.l -text "$text:" -font font_ui
2214                                pack $w.$f.$name.l -side left -anchor w -fill x
2215                                spinbox $w.$f.$name.v \
2216                                        -textvariable ${f}_config_new(gui.$name) \
2217                                        -from 1 -to 99 -increment 1 \
2218                                        -width 3 \
2219                                        -font font_ui
2220                                pack $w.$f.$name.v -side right -anchor e
2221                                pack $w.$f.$name -side top -anchor w -fill x
2222                        }
2223                        }
2224                }
2225        }
2226
2227        set all_fonts [lsort [font families]]
2228        foreach option $font_descs {
2229                set name [lindex $option 0]
2230                set font [lindex $option 1]
2231                set text [lindex $option 2]
2232
2233                set global_config_new(gui.$font^^family) \
2234                        [font configure $font -family]
2235                set global_config_new(gui.$font^^size) \
2236                        [font configure $font -size]
2237
2238                frame $w.global.$name
2239                label $w.global.$name.l -text "$text:" -font font_ui
2240                pack $w.global.$name.l -side left -anchor w -fill x
2241                eval tk_optionMenu $w.global.$name.family \
2242                        global_config_new(gui.$font^^family) \
2243                        $all_fonts
2244                spinbox $w.global.$name.size \
2245                        -textvariable global_config_new(gui.$font^^size) \
2246                        -from 2 -to 80 -increment 1 \
2247                        -width 3 \
2248                        -font font_ui
2249                pack $w.global.$name.size -side right -anchor e
2250                pack $w.global.$name.family -side right -anchor e
2251                pack $w.global.$name -side top -anchor w -fill x
2252        }
2253
2254        bind $w <Visibility> "grab $w; focus $w"
2255        bind $w <Key-Escape> "destroy $w"
2256        wm title $w "$appname ($reponame): Options"
2257        tkwait window $w
2258}
2259
2260proc do_restore_defaults {} {
2261        global font_descs default_config repo_config
2262        global repo_config_new global_config_new
2263
2264        foreach name [array names default_config] {
2265                set repo_config_new($name) $default_config($name)
2266                set global_config_new($name) $default_config($name)
2267        }
2268
2269        foreach option $font_descs {
2270                set name [lindex $option 0]
2271                set repo_config(gui.$name) $default_config(gui.$name)
2272        }
2273        apply_config
2274
2275        foreach option $font_descs {
2276                set name [lindex $option 0]
2277                set font [lindex $option 1]
2278                set global_config_new(gui.$font^^family) \
2279                        [font configure $font -family]
2280                set global_config_new(gui.$font^^size) \
2281                        [font configure $font -size]
2282        }
2283}
2284
2285proc do_save_config {w} {
2286        if {[catch {save_config} err]} {
2287                error_popup "Failed to completely save options:\n\n$err"
2288        }
2289        reshow_diff
2290        destroy $w
2291}
2292
2293proc do_windows_shortcut {} {
2294        global gitdir appname argv0
2295
2296        set reponame [lindex [file split \
2297                [file normalize [file dirname $gitdir]]] \
2298                end]
2299
2300        if {[catch {
2301                set desktop [exec cygpath \
2302                        --windows \
2303                        --absolute \
2304                        --long-name \
2305                        --desktop]
2306                }]} {
2307                        set desktop .
2308        }
2309        set fn [tk_getSaveFile \
2310                -parent . \
2311                -title "$appname ($reponame): Create Desktop Icon" \
2312                -initialdir $desktop \
2313                -initialfile "Git $reponame.bat"]
2314        if {$fn != {}} {
2315                if {[catch {
2316                                set fd [open $fn w]
2317                                set sh [exec cygpath \
2318                                        --windows \
2319                                        --absolute \
2320                                        --long-name \
2321                                        /bin/sh]
2322                                set me [exec cygpath \
2323                                        --unix \
2324                                        --absolute \
2325                                        $argv0]
2326                                set gd [exec cygpath \
2327                                        --unix \
2328                                        --absolute \
2329                                        $gitdir]
2330                                regsub -all ' $me "'\\''" me
2331                                regsub -all ' $gd "'\\''" gd
2332                                puts -nonewline $fd "\"$sh\" --login -c \""
2333                                puts -nonewline $fd "GIT_DIR='$gd'"
2334                                puts -nonewline $fd " '$me'"
2335                                puts $fd "&\""
2336                                close $fd
2337                        } err]} {
2338                        error_popup "Cannot write script:\n\n$err"
2339                }
2340        }
2341}
2342
2343proc do_macosx_app {} {
2344        global gitdir appname argv0 env
2345
2346        set reponame [lindex [file split \
2347                [file normalize [file dirname $gitdir]]] \
2348                end]
2349
2350        set fn [tk_getSaveFile \
2351                -parent . \
2352                -title "$appname ($reponame): Create Desktop Icon" \
2353                -initialdir [file join $env(HOME) Desktop] \
2354                -initialfile "Git $reponame.app"]
2355        if {$fn != {}} {
2356                if {[catch {
2357                                set Contents [file join $fn Contents]
2358                                set MacOS [file join $Contents MacOS]
2359                                set exe [file join $MacOS git-gui]
2360
2361                                file mkdir $MacOS
2362
2363                                set fd [open [file join $Contents Info.plist] w]
2364                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2365<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2366<plist version="1.0">
2367<dict>
2368        <key>CFBundleDevelopmentRegion</key>
2369        <string>English</string>
2370        <key>CFBundleExecutable</key>
2371        <string>git-gui</string>
2372        <key>CFBundleIdentifier</key>
2373        <string>org.spearce.git-gui</string>
2374        <key>CFBundleInfoDictionaryVersion</key>
2375        <string>6.0</string>
2376        <key>CFBundlePackageType</key>
2377        <string>APPL</string>
2378        <key>CFBundleSignature</key>
2379        <string>????</string>
2380        <key>CFBundleVersion</key>
2381        <string>1.0</string>
2382        <key>NSPrincipalClass</key>
2383        <string>NSApplication</string>
2384</dict>
2385</plist>}
2386                                close $fd
2387
2388                                set fd [open $exe w]
2389                                set gd [file normalize $gitdir]
2390                                set ep [file normalize [exec git --exec-path]]
2391                                regsub -all ' $gd "'\\''" gd
2392                                regsub -all ' $ep "'\\''" ep
2393                                puts $fd "#!/bin/sh"
2394                                foreach name [array names env] {
2395                                        if {[string match GIT_* $name]} {
2396                                                regsub -all ' $env($name) "'\\''" v
2397                                                puts $fd "export $name='$v'"
2398                                        }
2399                                }
2400                                puts $fd "export PATH='$ep':\$PATH"
2401                                puts $fd "export GIT_DIR='$gd'"
2402                                puts $fd "exec [file normalize $argv0]"
2403                                close $fd
2404
2405                                file attributes $exe -permissions u+x,g+x,o+x
2406                        } err]} {
2407                        error_popup "Cannot write icon:\n\n$err"
2408                }
2409        }
2410}
2411
2412proc toggle_or_diff {w x y} {
2413        global file_states file_lists current_diff ui_index ui_other
2414        global last_clicked selected_paths
2415
2416        set pos [split [$w index @$x,$y] .]
2417        set lno [lindex $pos 0]
2418        set col [lindex $pos 1]
2419        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2420        if {$path eq {}} {
2421                set last_clicked {}
2422                return
2423        }
2424
2425        set last_clicked [list $w $lno]
2426        array unset selected_paths
2427        $ui_index tag remove in_sel 0.0 end
2428        $ui_other tag remove in_sel 0.0 end
2429
2430        if {$col == 0} {
2431                if {$current_diff eq $path} {
2432                        set after {reshow_diff;}
2433                } else {
2434                        set after {}
2435                }
2436                switch -glob -- [lindex $file_states($path) 0] {
2437                A_ -
2438                M_ -
2439                DD -
2440                D_ {
2441                        update_indexinfo \
2442                                "Removing [short_path $path] from commit" \
2443                                [list $path] \
2444                                [concat $after {set ui_status_value {Ready.}}]
2445                }
2446                ?? {
2447                        update_index \
2448                                "Including [short_path $path]" \
2449                                [list $path] \
2450                                [concat $after {set ui_status_value {Ready.}}]
2451                }
2452                }
2453        } else {
2454                show_diff $path $w $lno
2455        }
2456}
2457
2458proc add_one_to_selection {w x y} {
2459        global file_lists
2460        global last_clicked selected_paths
2461
2462        set pos [split [$w index @$x,$y] .]
2463        set lno [lindex $pos 0]
2464        set col [lindex $pos 1]
2465        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2466        if {$path eq {}} {
2467                set last_clicked {}
2468                return
2469        }
2470
2471        set last_clicked [list $w $lno]
2472        if {[catch {set in_sel $selected_paths($path)}]} {
2473                set in_sel 0
2474        }
2475        if {$in_sel} {
2476                unset selected_paths($path)
2477                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2478        } else {
2479                set selected_paths($path) 1
2480                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2481        }
2482}
2483
2484proc add_range_to_selection {w x y} {
2485        global file_lists
2486        global last_clicked selected_paths
2487
2488        if {[lindex $last_clicked 0] ne $w} {
2489                toggle_or_diff $w $x $y
2490                return
2491        }
2492
2493        set pos [split [$w index @$x,$y] .]
2494        set lno [lindex $pos 0]
2495        set lc [lindex $last_clicked 1]
2496        if {$lc < $lno} {
2497                set begin $lc
2498                set end $lno
2499        } else {
2500                set begin $lno
2501                set end $lc
2502        }
2503
2504        foreach path [lrange $file_lists($w) \
2505                [expr {$begin - 1}] \
2506                [expr {$end - 1}]] {
2507                set selected_paths($path) 1
2508        }
2509        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2510}
2511
2512######################################################################
2513##
2514## config defaults
2515
2516set cursor_ptr arrow
2517font create font_diff -family Courier -size 10
2518font create font_ui
2519catch {
2520        label .dummy
2521        eval font configure font_ui [font actual [.dummy cget -font]]
2522        destroy .dummy
2523}
2524
2525font create font_uibold
2526font create font_diffbold
2527
2528set M1B M1
2529set M1T M1
2530if {$tcl_platform(platform) eq {windows}} {
2531        set M1B Control
2532        set M1T Ctrl
2533} elseif {[is_MacOSX]} {
2534        set M1B M1
2535        set M1T Cmd
2536}
2537
2538proc apply_config {} {
2539        global repo_config font_descs
2540
2541        foreach option $font_descs {
2542                set name [lindex $option 0]
2543                set font [lindex $option 1]
2544                if {[catch {
2545                        foreach {cn cv} $repo_config(gui.$name) {
2546                                font configure $font $cn $cv
2547                        }
2548                        } err]} {
2549                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2550                }
2551                foreach {cn cv} [font configure $font] {
2552                        font configure ${font}bold $cn $cv
2553                }
2554                font configure ${font}bold -weight bold
2555        }
2556}
2557
2558set default_config(gui.trustmtime) false
2559set default_config(gui.pullsummary) true
2560set default_config(gui.partialinclude) false
2561set default_config(gui.diffcontext) 5
2562set default_config(gui.fontui) [font configure font_ui]
2563set default_config(gui.fontdiff) [font configure font_diff]
2564set font_descs {
2565        {fontui   font_ui   {Main Font}}
2566        {fontdiff font_diff {Diff/Console Font}}
2567}
2568load_config 0
2569apply_config
2570
2571######################################################################
2572##
2573## ui construction
2574
2575# -- Menu Bar
2576#
2577menu .mbar -tearoff 0
2578.mbar add cascade -label Project -menu .mbar.project
2579.mbar add cascade -label Edit -menu .mbar.edit
2580.mbar add cascade -label Commit -menu .mbar.commit
2581if {!$single_commit} {
2582        .mbar add cascade -label Fetch -menu .mbar.fetch
2583        .mbar add cascade -label Pull -menu .mbar.pull
2584        .mbar add cascade -label Push -menu .mbar.push
2585}
2586. configure -menu .mbar
2587
2588# -- Project Menu
2589#
2590menu .mbar.project
2591.mbar.project add command -label Visualize \
2592        -command do_gitk \
2593        -font font_ui
2594if {!$single_commit} {
2595        .mbar.project add command -label {Repack Database} \
2596                -command do_repack \
2597                -font font_ui
2598
2599        if {$tcl_platform(platform) eq {windows}} {
2600                .mbar.project add command \
2601                        -label {Create Desktop Icon} \
2602                        -command do_windows_shortcut \
2603                        -font font_ui
2604        } elseif {[is_MacOSX]} {
2605                .mbar.project add command \
2606                        -label {Create Desktop Icon} \
2607                        -command do_macosx_app \
2608                        -font font_ui
2609        }
2610}
2611.mbar.project add command -label Quit \
2612        -command do_quit \
2613        -accelerator $M1T-Q \
2614        -font font_ui
2615
2616# -- Edit Menu
2617#
2618menu .mbar.edit
2619.mbar.edit add command -label Undo \
2620        -command {catch {[focus] edit undo}} \
2621        -accelerator $M1T-Z \
2622        -font font_ui
2623.mbar.edit add command -label Redo \
2624        -command {catch {[focus] edit redo}} \
2625        -accelerator $M1T-Y \
2626        -font font_ui
2627.mbar.edit add separator
2628.mbar.edit add command -label Cut \
2629        -command {catch {tk_textCut [focus]}} \
2630        -accelerator $M1T-X \
2631        -font font_ui
2632.mbar.edit add command -label Copy \
2633        -command {catch {tk_textCopy [focus]}} \
2634        -accelerator $M1T-C \
2635        -font font_ui
2636.mbar.edit add command -label Paste \
2637        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2638        -accelerator $M1T-V \
2639        -font font_ui
2640.mbar.edit add command -label Delete \
2641        -command {catch {[focus] delete sel.first sel.last}} \
2642        -accelerator Del \
2643        -font font_ui
2644.mbar.edit add separator
2645.mbar.edit add command -label {Select All} \
2646        -command {catch {[focus] tag add sel 0.0 end}} \
2647        -accelerator $M1T-A \
2648        -font font_ui
2649.mbar.edit add separator
2650.mbar.edit add command -label {Options...} \
2651        -command do_options \
2652        -font font_ui
2653
2654# -- Commit Menu
2655#
2656menu .mbar.commit
2657
2658.mbar.commit add radiobutton \
2659        -label {New Commit} \
2660        -command do_select_commit_type \
2661        -variable selected_commit_type \
2662        -value new \
2663        -font font_ui
2664lappend disable_on_lock \
2665        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2666
2667.mbar.commit add radiobutton \
2668        -label {Amend Last Commit} \
2669        -command do_select_commit_type \
2670        -variable selected_commit_type \
2671        -value amend \
2672        -font font_ui
2673lappend disable_on_lock \
2674        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2675
2676.mbar.commit add separator
2677
2678.mbar.commit add command -label Rescan \
2679        -command do_rescan \
2680        -accelerator F5 \
2681        -font font_ui
2682lappend disable_on_lock \
2683        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2684
2685.mbar.commit add command -label {Remove From Commit} \
2686        -command do_remove_selection \
2687        -font font_ui
2688lappend disable_on_lock \
2689        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2690
2691.mbar.commit add command -label {Include In Commit} \
2692        -command do_include_selection \
2693        -font font_ui
2694lappend disable_on_lock \
2695        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696
2697.mbar.commit add command -label {Include All} \
2698        -command do_include_all \
2699        -accelerator $M1T-I \
2700        -font font_ui
2701lappend disable_on_lock \
2702        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2703
2704.mbar.commit add separator
2705
2706.mbar.commit add command -label {Sign Off} \
2707        -command do_signoff \
2708        -accelerator $M1T-S \
2709        -font font_ui
2710
2711.mbar.commit add command -label Commit \
2712        -command do_commit \
2713        -accelerator $M1T-Return \
2714        -font font_ui
2715lappend disable_on_lock \
2716        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2717
2718# -- Transport menus
2719#
2720if {!$single_commit} {
2721        menu .mbar.fetch
2722        menu .mbar.pull
2723        menu .mbar.push
2724}
2725
2726# -- Main Window Layout
2727#
2728panedwindow .vpane -orient vertical
2729panedwindow .vpane.files -orient horizontal
2730.vpane add .vpane.files -sticky nsew -height 100 -width 400
2731pack .vpane -anchor n -side top -fill both -expand 1
2732
2733# -- Index File List
2734#
2735frame .vpane.files.index -height 100 -width 400
2736label .vpane.files.index.title -text {Modified Files} \
2737        -background green \
2738        -font font_ui
2739text $ui_index -background white -borderwidth 0 \
2740        -width 40 -height 10 \
2741        -font font_ui \
2742        -cursor $cursor_ptr \
2743        -yscrollcommand {.vpane.files.index.sb set} \
2744        -state disabled
2745scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2746pack .vpane.files.index.title -side top -fill x
2747pack .vpane.files.index.sb -side right -fill y
2748pack $ui_index -side left -fill both -expand 1
2749.vpane.files add .vpane.files.index -sticky nsew
2750
2751# -- Other (Add) File List
2752#
2753frame .vpane.files.other -height 100 -width 100
2754label .vpane.files.other.title -text {Untracked Files} \
2755        -background red \
2756        -font font_ui
2757text $ui_other -background white -borderwidth 0 \
2758        -width 40 -height 10 \
2759        -font font_ui \
2760        -cursor $cursor_ptr \
2761        -yscrollcommand {.vpane.files.other.sb set} \
2762        -state disabled
2763scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2764pack .vpane.files.other.title -side top -fill x
2765pack .vpane.files.other.sb -side right -fill y
2766pack $ui_other -side left -fill both -expand 1
2767.vpane.files add .vpane.files.other -sticky nsew
2768
2769foreach i [list $ui_index $ui_other] {
2770        $i tag conf in_diff -font font_uibold
2771        $i tag conf in_sel \
2772                -background [$i cget -foreground] \
2773                -foreground [$i cget -background]
2774}
2775unset i
2776
2777# -- Diff and Commit Area
2778#
2779frame .vpane.lower -height 300 -width 400
2780frame .vpane.lower.commarea
2781frame .vpane.lower.diff -relief sunken -borderwidth 1
2782pack .vpane.lower.commarea -side top -fill x
2783pack .vpane.lower.diff -side bottom -fill both -expand 1
2784.vpane add .vpane.lower -stick nsew
2785
2786# -- Commit Area Buttons
2787#
2788frame .vpane.lower.commarea.buttons
2789label .vpane.lower.commarea.buttons.l -text {} \
2790        -anchor w \
2791        -justify left \
2792        -font font_ui
2793pack .vpane.lower.commarea.buttons.l -side top -fill x
2794pack .vpane.lower.commarea.buttons -side left -fill y
2795
2796button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2797        -command do_rescan \
2798        -font font_ui
2799pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2800lappend disable_on_lock \
2801        {.vpane.lower.commarea.buttons.rescan conf -state}
2802
2803button .vpane.lower.commarea.buttons.incall -text {Include All} \
2804        -command do_include_all \
2805        -font font_ui
2806pack .vpane.lower.commarea.buttons.incall -side top -fill x
2807lappend disable_on_lock \
2808        {.vpane.lower.commarea.buttons.incall conf -state}
2809
2810button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2811        -command do_signoff \
2812        -font font_ui
2813pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2814
2815button .vpane.lower.commarea.buttons.commit -text {Commit} \
2816        -command do_commit \
2817        -font font_ui
2818pack .vpane.lower.commarea.buttons.commit -side top -fill x
2819lappend disable_on_lock \
2820        {.vpane.lower.commarea.buttons.commit conf -state}
2821
2822# -- Commit Message Buffer
2823#
2824frame .vpane.lower.commarea.buffer
2825frame .vpane.lower.commarea.buffer.header
2826set ui_comm .vpane.lower.commarea.buffer.t
2827set ui_coml .vpane.lower.commarea.buffer.header.l
2828radiobutton .vpane.lower.commarea.buffer.header.new \
2829        -text {New Commit} \
2830        -command do_select_commit_type \
2831        -variable selected_commit_type \
2832        -value new \
2833        -font font_ui
2834lappend disable_on_lock \
2835        [list .vpane.lower.commarea.buffer.header.new conf -state]
2836radiobutton .vpane.lower.commarea.buffer.header.amend \
2837        -text {Amend Last Commit} \
2838        -command do_select_commit_type \
2839        -variable selected_commit_type \
2840        -value amend \
2841        -font font_ui
2842lappend disable_on_lock \
2843        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2844label $ui_coml \
2845        -anchor w \
2846        -justify left \
2847        -font font_ui
2848proc trace_commit_type {varname args} {
2849        global ui_coml commit_type
2850        switch -glob -- $commit_type {
2851        initial       {set txt {Initial Commit Message:}}
2852        amend         {set txt {Amended Commit Message:}}
2853        amend-initial {set txt {Amended Initial Commit Message:}}
2854        merge         {set txt {Merge Commit Message:}}
2855        *             {set txt {Commit Message:}}
2856        }
2857        $ui_coml conf -text $txt
2858}
2859trace add variable commit_type write trace_commit_type
2860pack $ui_coml -side left -fill x
2861pack .vpane.lower.commarea.buffer.header.amend -side right
2862pack .vpane.lower.commarea.buffer.header.new -side right
2863
2864text $ui_comm -background white -borderwidth 1 \
2865        -undo true \
2866        -maxundo 20 \
2867        -autoseparators true \
2868        -relief sunken \
2869        -width 75 -height 9 -wrap none \
2870        -font font_diff \
2871        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2872scrollbar .vpane.lower.commarea.buffer.sby \
2873        -command [list $ui_comm yview]
2874pack .vpane.lower.commarea.buffer.header -side top -fill x
2875pack .vpane.lower.commarea.buffer.sby -side right -fill y
2876pack $ui_comm -side left -fill y
2877pack .vpane.lower.commarea.buffer -side left -fill y
2878
2879# -- Commit Message Buffer Context Menu
2880#
2881set ctxm .vpane.lower.commarea.buffer.ctxm
2882menu $ctxm -tearoff 0
2883$ctxm add command \
2884        -label {Cut} \
2885        -font font_ui \
2886        -command {tk_textCut $ui_comm}
2887$ctxm add command \
2888        -label {Copy} \
2889        -font font_ui \
2890        -command {tk_textCopy $ui_comm}
2891$ctxm add command \
2892        -label {Paste} \
2893        -font font_ui \
2894        -command {tk_textPaste $ui_comm}
2895$ctxm add command \
2896        -label {Delete} \
2897        -font font_ui \
2898        -command {$ui_comm delete sel.first sel.last}
2899$ctxm add separator
2900$ctxm add command \
2901        -label {Select All} \
2902        -font font_ui \
2903        -command {$ui_comm tag add sel 0.0 end}
2904$ctxm add command \
2905        -label {Copy All} \
2906        -font font_ui \
2907        -command {
2908                $ui_comm tag add sel 0.0 end
2909                tk_textCopy $ui_comm
2910                $ui_comm tag remove sel 0.0 end
2911        }
2912$ctxm add separator
2913$ctxm add command \
2914        -label {Sign Off} \
2915        -font font_ui \
2916        -command do_signoff
2917bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2918
2919# -- Diff Header
2920#
2921set current_diff {}
2922set diff_actions [list]
2923proc trace_current_diff {varname args} {
2924        global current_diff diff_actions file_states
2925        if {$current_diff eq {}} {
2926                set s {}
2927                set f {}
2928                set p {}
2929                set o disabled
2930        } else {
2931                set p $current_diff
2932                set s [mapdesc [lindex $file_states($p) 0] $p]
2933                set f {File:}
2934                set p [escape_path $p]
2935                set o normal
2936        }
2937
2938        .vpane.lower.diff.header.status configure -text $s
2939        .vpane.lower.diff.header.file configure -text $f
2940        .vpane.lower.diff.header.path configure -text $p
2941        foreach w $diff_actions {
2942                uplevel #0 $w $o
2943        }
2944}
2945trace add variable current_diff write trace_current_diff
2946
2947frame .vpane.lower.diff.header -background orange
2948label .vpane.lower.diff.header.status \
2949        -background orange \
2950        -width $max_status_desc \
2951        -anchor w \
2952        -justify left \
2953        -font font_ui
2954label .vpane.lower.diff.header.file \
2955        -background orange \
2956        -anchor w \
2957        -justify left \
2958        -font font_ui
2959label .vpane.lower.diff.header.path \
2960        -background orange \
2961        -anchor w \
2962        -justify left \
2963        -font font_ui
2964pack .vpane.lower.diff.header.status -side left
2965pack .vpane.lower.diff.header.file -side left
2966pack .vpane.lower.diff.header.path -fill x
2967set ctxm .vpane.lower.diff.header.ctxm
2968menu $ctxm -tearoff 0
2969$ctxm add command \
2970        -label {Copy} \
2971        -font font_ui \
2972        -command {
2973                clipboard clear
2974                clipboard append \
2975                        -format STRING \
2976                        -type STRING \
2977                        -- $current_diff
2978        }
2979lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2980bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2981
2982# -- Diff Body
2983#
2984frame .vpane.lower.diff.body
2985set ui_diff .vpane.lower.diff.body.t
2986text $ui_diff -background white -borderwidth 0 \
2987        -width 80 -height 15 -wrap none \
2988        -font font_diff \
2989        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2990        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2991        -state disabled
2992scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2993        -command [list $ui_diff xview]
2994scrollbar .vpane.lower.diff.body.sby -orient vertical \
2995        -command [list $ui_diff yview]
2996pack .vpane.lower.diff.body.sbx -side bottom -fill x
2997pack .vpane.lower.diff.body.sby -side right -fill y
2998pack $ui_diff -side left -fill both -expand 1
2999pack .vpane.lower.diff.header -side top -fill x
3000pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3001
3002$ui_diff tag conf d_@ -font font_diffbold
3003$ui_diff tag conf d_+  -foreground blue
3004$ui_diff tag conf d_-  -foreground red
3005$ui_diff tag conf d_++ -foreground {#00a000}
3006$ui_diff tag conf d_-- -foreground {#a000a0}
3007$ui_diff tag conf d_+- \
3008        -foreground red \
3009        -background {light goldenrod yellow}
3010$ui_diff tag conf d_-+ \
3011        -foreground blue \
3012        -background azure2
3013
3014# -- Diff Body Context Menu
3015#
3016set ctxm .vpane.lower.diff.body.ctxm
3017menu $ctxm -tearoff 0
3018$ctxm add command \
3019        -label {Copy} \
3020        -font font_ui \
3021        -command {tk_textCopy $ui_diff}
3022lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3023$ctxm add command \
3024        -label {Select All} \
3025        -font font_ui \
3026        -command {$ui_diff tag add sel 0.0 end}
3027lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3028$ctxm add command \
3029        -label {Copy All} \
3030        -font font_ui \
3031        -command {
3032                $ui_diff tag add sel 0.0 end
3033                tk_textCopy $ui_diff
3034                $ui_diff tag remove sel 0.0 end
3035        }
3036lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3037$ctxm add separator
3038$ctxm add command \
3039        -label {Decrease Font Size} \
3040        -font font_ui \
3041        -command {incr_font_size font_diff -1}
3042lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3043$ctxm add command \
3044        -label {Increase Font Size} \
3045        -font font_ui \
3046        -command {incr_font_size font_diff 1}
3047lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3048$ctxm add separator
3049$ctxm add command \
3050        -label {Show Less Context} \
3051        -font font_ui \
3052        -command {if {$repo_config(gui.diffcontext) >= 2} {
3053                incr repo_config(gui.diffcontext) -1
3054                reshow_diff
3055        }}
3056lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3057$ctxm add command \
3058        -label {Show More Context} \
3059        -font font_ui \
3060        -command {
3061                incr repo_config(gui.diffcontext)
3062                reshow_diff
3063        }
3064lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3065$ctxm add separator
3066$ctxm add command -label {Options...} \
3067        -font font_ui \
3068        -command do_options
3069bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3070
3071# -- Status Bar
3072#
3073set ui_status_value {Initializing...}
3074label .status -textvariable ui_status_value \
3075        -anchor w \
3076        -justify left \
3077        -borderwidth 1 \
3078        -relief sunken \
3079        -font font_ui
3080pack .status -anchor w -side bottom -fill x
3081
3082# -- Load geometry
3083#
3084catch {
3085set gm $repo_config(gui.geometry)
3086wm geometry . [lindex $gm 0]
3087.vpane sash place 0 \
3088        [lindex [.vpane sash coord 0] 0] \
3089        [lindex $gm 1]
3090.vpane.files sash place 0 \
3091        [lindex $gm 2] \
3092        [lindex [.vpane.files sash coord 0] 1]
3093unset gm
3094}
3095
3096# -- Key Bindings
3097#
3098bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3099bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3100bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3101bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3102bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3103bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3104bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3105bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3106bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3107bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3108bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3109
3110bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3111bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3112bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3113bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3114bind $ui_diff <$M1B-Key-v> {break}
3115bind $ui_diff <$M1B-Key-V> {break}
3116bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3117bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3118bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3119bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3120bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3121bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3122
3123bind .   <Destroy> do_quit
3124bind all <Key-F5> do_rescan
3125bind all <$M1B-Key-r> do_rescan
3126bind all <$M1B-Key-R> do_rescan
3127bind .   <$M1B-Key-s> do_signoff
3128bind .   <$M1B-Key-S> do_signoff
3129bind .   <$M1B-Key-i> do_include_all
3130bind .   <$M1B-Key-I> do_include_all
3131bind .   <$M1B-Key-Return> do_commit
3132bind all <$M1B-Key-q> do_quit
3133bind all <$M1B-Key-Q> do_quit
3134bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3135bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3136foreach i [list $ui_index $ui_other] {
3137        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3138        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3139        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3140}
3141unset i
3142
3143set file_lists($ui_index) [list]
3144set file_lists($ui_other) [list]
3145
3146set HEAD {}
3147set PARENT {}
3148set commit_type {}
3149set empty_tree {}
3150set current_diff {}
3151set selected_commit_type new
3152
3153wm title . "$appname ([file normalize [file dirname $gitdir]])"
3154focus -force $ui_comm
3155if {!$single_commit} {
3156        load_all_remotes
3157        populate_fetch_menu .mbar.fetch
3158        populate_pull_menu .mbar.pull
3159        populate_push_menu .mbar.push
3160}
3161lock_index begin-read
3162after 1 do_rescan