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