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