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