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