lilycontrib.tcl

   1 #!/usr/bin/wish
   2
   3 package require Tk
   4
   5 # Helper functions
   6
   7 set lily_dir $env(HOME)/lilypond
   8 cd $lily_dir
   9
  10 proc write_to_output {s} {
  11         .output.text insert insert $s
  12         .output.text see end
  13 }
  14
  15 proc write_file_to_output {f} {
  16         if {[eof $f]} {
  17                 global git_command
  18                 fconfigure $f -blocking true
  19                 if {[catch {close $f} err]} {
  20                         tk_messageBox -type ok -message "Git aborted: $err"
  21                 }
  22                 unset git_command
  23         } else {
  24                 write_to_output [read $f 24]
  25         }
  26 }
  27
  28 proc git {args} {
  29         global lily_dir git_command
  30         file mkdir $lily_dir
  31         set git_command [linsert $args 0 "|git" "--git-dir=$lily_dir/.git"]
  32         set git_command "$git_command 2>@1"
  33         #.output.text insert end "$git_command\n"
  34         set git [open $git_command r]
  35         fconfigure $git -blocking false
  36         fileevent $git readable [list write_file_to_output $git]
  37         vwait git_command
  38 }
  39
  40 proc config {args} {
  41         global lily_dir
  42         set p [open [linsert $args 0 "|git" --git-dir=$lily_dir/.git config] r]
  43         set result [regsub "\n\$" [read $p] ""]
  44         if {[catch {close $p} err]} {
  45                 tk_messageBox -type ok -message "config failed: $err"
  46         }
  47         return $result
  48 }
  49
  50 proc config_quiet {args} {
  51         global lily_dir
  52         set p [open [linsert $args 0 "|git" --git-dir=$lily_dir/.git config] r]
  53         set result [regsub "\n\$" [read $p] ""]
  54         if {[catch {close $p} err]} {
  55                 set result ""
  56         }
  57         return $result
  58 }
  59
  60 proc update_lilypond {} {
  61         global lily_dir
  62         . config -cursor watch
  63         if {![file exists $lily_dir]} {
  64                 write_to_output "Cloning LilyPond (this can take some time) ...\n"
  65                 file mkdir $lily_dir
  66                 git init
  67                 git config core.bare false
  68                 git remote add -t master \
  69                         origin git://repo.or.cz/lilypond.git
  70                 git fetch --depth 1
  71                 git reset --hard origin/master
  72                 git config branch.master.remote origin
  73                 git config branch.master.merge refs/heads/master
  74                 .update configure -text "Update LilyPond"
  75         } else {
  76                 global rebase
  77                 write_to_output "Updating LilyPond...\n"
  78                 git fetch origin
  79                 if {$rebase} {
  80                         git rebase origin/master
  81                 } else {
  82                         git merge origin/master
  83                 }
  84         }
  85         write_to_output "Done.\n"
  86         . config -cursor ""
  87 }
  88
  89 proc toggle_rebase {} {
  90         global rebase
  91         config --bool branch.master.rebase $rebase
  92 }
  93
  94 # GUI
  95
  96 wm title . "LilyPond Contributor's GUI"
  97
  98 # Buttons
  99
 100 panedwindow .buttons
 101 button .buttons.update -text "Update LilyPond" -command update_lilypond
 102 label .buttons.rebase_label -text "Rebase"
 103 if {![file exists $lily_dir]} {
 104         .update configure -text "Clone LilyPond"
 105 }
 106 set rebase 0
 107 if {[config_quiet --bool branch.master.rebase] == true} {
 108         set rebase 1
 109 }
 110 checkbutton .buttons.rebase -variable rebase -command toggle_rebase
 111 pack .buttons.update -side left
 112 pack .buttons.rebase -side right
 113 pack .buttons.rebase_label -side right
 114
 115 # Output
 116
 117 panedwindow .output
 118 text .output.text -width 80 -height 15 \
 119         -xscrollcommand [list .output.horizontal set] \
 120         -yscrollcommand [list .output.vertical set]
 121 scrollbar .output.horizontal -orient h -command [list .output.text xview]
 122 scrollbar .output.vertical -orient v -command [list .output.text yview]
 123 pack .output.horizontal -side bottom -fill x
 124 pack .output.vertical -side right -fill y
 125 pack .output.text -expand true -anchor nw -fill both
 126
 127 pack .buttons .output