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