lilycontrib.tcl, was Re: the "r" in "git pull -r"

[Johannes Schindelin]

Hi,

On Mon, 10 Aug 2009, Johannes Schindelin wrote:

> On Mon, 10 Aug 2009, Graham Percival wrote:
> 
> > On Mon, Aug 10, 2009 at 10:34:11AM +0200, Johannes Schindelin wrote:
> > > On Mon, 10 Aug 2009, Graham Percival wrote:
> > > 
> > > > We've lost 50% of potential contributors to the website because of 
> > > > git.
> > >
> > > Fair enough.  Maybe it is time to suggest an easy interface to Git?  
> > > You could even write a very simple wrapper around Git that _just_ 
> > > downloads the current version of LilyPond, allows the user to edit 
> > > the files and then click another button to send the patch.
> > 
> > Seriously?!  That would be **fantastic**!

Okay, I could not resist, so here is something more capable.  It actually 
only gives you a "Clone/Update" button that makes sure that a local clone 
(hardcoded to $HOME/lilypond) is up-to-date, but at least it has a 
progress bar, and I verified that it works even on Windows (what with its 
ridiculous insistence to put everything into directories containing 
spaces).

>From here, it should be _relatively_ easy to extend (read: I will be 
available for assistance, but I do not plan to work further on this, at 
least not alone):

-- snipsnap --
#!/usr/bin/wish

package require Tk

# create the GUI

wm title . "LilyPond Contributor's GUI"
button .update -text "Clone/Update LilyPond" -command update_lilypond
panedwindow .output
text .output.text -width 80 -height 15 \
        -xscrollcommand [list .output.horizontal set] \
        -yscrollcommand [list .output.vertical set]
scrollbar .output.horizontal -orient h -command [list .output.text xview]
scrollbar .output.vertical -orient v -command [list .output.text yview]
pack .output.horizontal -side bottom -fill x
pack .output.vertical -side right -fill y
pack .output.text -expand true -anchor nw -fill both
pack .update .output

# the callbacks

set lily_dir $env(HOME)/lilypond

proc write_to_output {f} {
        if {[eof $f]} {
                global git_command
                fconfigure $f -blocking true
                if {[catch {close $f} err]} {
                        tk_messageBox -type ok -message "Git aborted: $err"
                }
                unset git_command
        } else {
                .output.text insert insert [read $f 24]
                .output.text see end
        }
}

# naming this function "git" allows cute calls: they look like shell
proc git {args} {
        global lily_dir git_command
        set git_command [linsert $args 0 "|git" "--git-dir=$lily_dir/.git"]
        set git_command "$git_command 2>@1"
        #.output.text insert end "$git_command\n"
        set git [open $git_command r]
        fconfigure $git -blocking false
        fileevent $git readable [list write_to_output $git]
        vwait git_command
}

proc update_lilypond {} {
        global lily_dir
        if {![file exists $lily_dir]} {
                file mkdir $lily_dir
                git init
                git config core.bare false
                git remote add -t master \
                        origin git://repo.or.cz/lilypond.git
                git fetch --depth 1
                git checkout -b master origin/master
        } else {
                git pull
        }
}