Andrew's git - gitweb.git/blob

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