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