lilycontrib.tcl

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