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