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