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