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