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