scripts/auxiliar/lily-git.tcl

   1 #!/usr/bin/wish
   2
   3 # GUI interface for common LilyPond git repository commands
   4 # Copyright 2009 by Johannes Schindelin and Carl Sorensen
   5 #
   6
   7 set version 0.64
   8
   9 # set to 1 to set up for translation, to 0 for other
  10 set translator 0
  11
  12 if {$translator == 1} {
  13         set windowTitle \
  14           "LilyPond Translator's Git Interface version $version"
  15         set updateButtonText "1. Update translation"
  16         set initializeButtonText "1. Get translation"
  17         set originHead "lilypond/translation"
  18         set rebase 0
  19 } else {
  20         set windowTitle \
  21           "LilyPond Contributor's Git Interface version $version"
  22         set updateButtonText "1. Update source"
  23         set initializeButtonText "1. Get source"
  24         set originHead "master"
  25         set rebase 1
  26 }
  27 package require Tk
  28
  29
  30 ##  Entry limit routine from jeff at hobbs org, downloaded from
  31 ##  http://www.purl.org/net/hobbs/tcl/tclet/entrylimit.html
  32
  33 ## For those who aren't using Tk4 with these, make a bell noop:
  34 if [string match {} [info commands bell]] { proc bell args {} }
  35
  36 proc forceLen {len name el op} {
  37     global $name ${name}_len
  38     if [string comp $el {}] {
  39         set old  ${name}_len\($el)
  40         set name $name\($el)
  41     } else { set old ${name}_len }
  42     if {[string length [set $name]] > $len} {
  43         set $name [set $old]
  44         bell; return
  45     }
  46     set $old [set $name]
  47 }
  48
  49 ## entryLimit - a convenience proc for managing traces on entry widgets
  50 ## Perhaps to make this even nicer, it could create a textvar for the
  51 ## user with the name the same as the entry?
  52 # ARGS: entry           - the entry widget to trace
  53 #       traceProc       - trace procedure
  54 #       init            - initial value to use, defaults to {}
  55 ## If traceProc=={}, then all write traces on the entry's textvar are
  56 ## deleted.  This doesn't delete array traces.
  57 ##
  58 proc entryLimit {entry traceProc {init {}}} {
  59     if [string match {} [set var [$entry cget -textvariable]]] {
  60         return -code error "-textvariable not set for entry \"$entry\""
  61     }
  62
  63     if {[string compare $traceProc {}]} {
  64         ## TextVars are always considered global
  65         uplevel \#0 [list set $var $init]
  66         uplevel \#0 [list trace variable $var w $traceProc]
  67         if {[catch {uplevel \#0 [list set $var $init]} err]} {
  68             ## If this errors out, the $init value was bad, or
  69             ## something was wrong with the traceProc
  70             return -code error "an error was received setting the initial\
  71                     value of \"$var\" to \"$init\".  Make sure the value is\
  72                     valid and the traceProc is functional:\n$err"
  73         } else {
  74             ## Do you really want to delete the trace when
  75             ## destroying the entry?
  76             #bind $entry <Destroy> [list + trace vdelete $var w $traceProc]
  77             return
  78         }
  79     }
  80     foreach p [uplevel \#0 [list trace vinfo $var]] {
  81         if {[string match w [lindex $p 0]]} {
  82             uplevel \#0 trace vdelete [list $var] $p
  83         }
  84     }
  85 }
  86
  87 set commit_header {}
  88 trace variable commit_header w {forceLen 50}
  89 set commit_header {}
  90
  91
  92 ## End of entry limit code
  93
  94
  95 # Helper functions
  96
  97 set lily_dir $env(HOME)/lilypond-git
  98 if {[file exists $lily_dir]} {
  99         cd $lily_dir
 100 }
 101
 102 set abort_dir "./aborted_edits"
 103
 104 proc write_to_output {s} {
 105         .output.text insert insert $s
 106         .output.text see end
 107 }
 108
 109 proc write_file_to_output {f} {
 110         if {[eof $f]} {
 111                 global git_command
 112                 fconfigure $f -blocking true
 113                 if {[catch {close $f} err]} {
 114                         tk_messageBox -type ok -message \
 115                           "Command returned an error: $err\n\nCheck output text for details"
 116                 }
 117                 unset git_command
 118         } else {
 119                 write_to_output [read $f 24]
 120         }
 121 }
 122
 123 proc git {args} {
 124         global lily_dir git_command
 125         set git_command [linsert $args 0 "|git" "--git-dir=$lily_dir/.git"]
 126         set git_command "$git_command 2>@1"
 127         .output.text insert end "$git_command\n"
 128         set git [open $git_command r]
 129         fconfigure $git -blocking false
 130         fileevent $git readable [list write_file_to_output $git]
 131         vwait git_command
 132 }
 133
 134 proc config {args} {
 135         global lily_dir
 136         set p [open [linsert $args 0 "|git" --git-dir=$lily_dir/.git config] r]
 137         set result [regsub "\n\$" [read $p] ""]
 138         if {[catch {close $p} err]} {
 139                 tk_messageBox -type ok -message "config failed: $err"
 140         }
 141         return $result
 142 }
 143
 144 proc config_quiet {args} {
 145         global lily_dir
 146         set p [open [linsert $args 0 "|git" --git-dir=$lily_dir/.git config] r]
 147         set result [regsub "\n\$" [read $p] ""]
 148         if {[catch {close $p} err]} {
 149                 set result ""
 150         }
 151         return $result
 152 }
 153
 154 proc update_lilypond_rebase {} {
 155   update_lilypond 1
 156 }
 157
 158 proc commit {} {
 159   global commit_message
 160   global commit_canceled
 161   set commit_canceled 0
 162   get_commit_message
 163   tkwait visibility .commitMessage
 164   tkwait window .commitMessage
 165   if {$commit_canceled != 1} {
 166     if {$commit_message == ""} {
 167       tk_messageBox -message "You must enter a commit message!" \
 168       -type ok -icon error
 169     } else {
 170       git commit -a -m $commit_message
 171       git rebase --whitespace=fix HEAD^
 172     set commit_message "2
 173     }
 174   }
 175 }
 176
 177 proc commit_amend {} {
 178   git commit -a --amend -C HEAD
 179   git rebase --whitespace=fix HEAD^
 180 }
 181
 182 proc update_lilypond_norebase {} {
 183   update_lilypond 0
 184 }
 185
 186 proc update_lilypond_with_rebase {} {
 187   global rebase
 188   update_lilypond $rebase
 189 }
 190
 191 proc update_lilypond {rebase} {
 192         global lily_dir
 193         global originHead
 194         global translator
 195         . config -cursor watch
 196         if {![file exists $lily_dir]} {
 197                 write_to_output "Cloning LilyPond (this can take some time) ...\n"
 198                 file mkdir $lily_dir
 199                 cd $lily_dir
 200                 git init
 201                 git config core.bare false
 202                 git remote add -t $originHead \
 203                         origin git://git.sv.gnu.org/lilypond.git
 204                 if {$translator == 1} {
 205                   git fetch
 206                 } else {
 207                   git fetch --depth 1
 208                 }
 209                 git reset --hard origin/$originHead
 210                 git config branch.$originHead.remote origin
 211                 git config branch.$originHead.merge refs/heads/$originHead
 212                 .buttons.commitFrame.commit configure -state normal
 213                 .buttons.commitFrame.amend configure -state normal
 214                 .buttons.update configure -text buttonUpdateText
 215                 .buttons.patch configure -state normal
 216                 .buttons.panic configure -state normal
 217                 toggle_rebase
 218         } else {
 219                 write_to_output "Updating LilyPond...\n"
 220                 git fetch origin
 221                 if {$rebase} {
 222                         git rebase origin/$originHead
 223                 } else {
 224                         git merge origin/$originHead
 225                 }
 226         }
 227         write_to_output "Done.\n"
 228         . config -cursor ""
 229 }
 230
 231 proc patch_from_origin {} {
 232   global rebase
 233   make_patch_from_origin $rebase
 234   if {![llength [glob -nocomplain 0*.patch]]} {
 235         tk_messageBox -type ok -message \
 236                 "No patches created; did you make a local commit?"
 237   }
 238 }
 239
 240 proc make_patch_from_origin {rebase} {
 241   global lily_dir
 242   global originHead
 243   . config -cursor watch
 244   update_lilypond $rebase
 245   write_to_output "Creating patch...\n"
 246   git format-patch origin/$originHead
 247   write_to_output "Done.\n"
 248   . config -cursor ""
 249 }
 250
 251 proc abort_changes {} {
 252   global abort_dir
 253   global originHead
 254   set answer [tk_messageBox -type okcancel \
 255                -message "This will copy all changed files to $abort_dir and reset the repository." \
 256                -default cancel]
 257   switch -- $answer {
 258     ok {
 259       write_to_output "abort_dir: $abort_dir \n"
 260       if {![file exists $abort_dir]} {
 261         set return_code [exec mkdir $abort_dir]
 262       }
 263       set return_code [catch {exec git diff origin/$originHead} gitdiff]
 264       set return_code [regexp {diff --git a/(\S*)} $gitdiff match modified_file]
 265       while {$return_code != 0} {
 266         write_to_output "Copying $modified_file to $abort_dir.\n"
 267         set return_code [catch {exec cp $modified_file $abort_dir} result]
 268         set return_code [regsub {diff --git a/(\S*)} $gitdiff "" gitdiff]
 269         set return_code [regexp {diff --git a/(\S*)} $gitdiff match modified_file]
 270       }
 271       set return_code [git reset --hard origin/$originHead]
 272       write_to_output "Repository reset. \n"
 273     }
 274   }
 275 }
 276
 277 proc toggle_rebase {} {
 278         global rebase
 279         global lily_dir
 280         global originHead
 281         global updateButtonText
 282         global initializeButtonText
 283         if {[file exists $lily_dir]} {
 284           config --bool branch.$originHead.rebase $rebase
 285           .buttons.update configure -text $updateButtonText
 286         } else {
 287           .buttons.update configure -text $initializeButtonText
 288         }
 289 }
 290
 291 proc clear_rebase {} {
 292   global rebase
 293   set rebase 0
 294   toggle_rebase
 295 }
 296
 297 proc set_rebase {} {
 298   global rebase
 299   set rebase 1
 300   toggle_rebase
 301 }
 302
 303 proc commitMessageOK {} {
 304   global commit_message
 305   global commit_header
 306   set commit_body [.commitMessage.bottomFrame.commit_body get 1.0 end]
 307   set commit_message "$commit_header\n\n$commit_body"
 308   destroy .commitMessage
 309 }
 310
 311 proc commitMessageCancel {} {
 312   global commit_message
 313   global commit_canceled
 314   set commit_message ""
 315   set commit_canceled 1
 316   destroy .commitMessage
 317 }
 318
 319
 320 # Commit message input window
 321 proc get_commit_message {} {
 322   global commit_header
 323   set commit_header ""
 324   toplevel .commitMessage
 325   frame .commitMessage.topFrame
 326   label .commitMessage.topFrame.label \
 327       -text "Enter commit message header:\n(50 chars max = width of box)"
 328   entry .commitMessage.topFrame.commit_header \
 329             -width 50 -relief solid -border 2 -textvariable commit_header
 330   pack   .commitMessage.topFrame.label -side left
 331   pack   .commitMessage.topFrame.commit_header -side left
 332
 333   frame  .commitMessage.bottomFrame
 334   text   .commitMessage.bottomFrame.commit_body \
 335             -width 75  -height 10 -relief solid -border 2 -wrap none
 336
 337   frame .commitMessage.bottomFrame.leftFrame
 338   label .commitMessage.bottomFrame.leftFrame.label \
 339       -text "Enter commit message body:\n(No limit -- Full description)"
 340   button .commitMessage.bottomFrame.leftFrame.ok \
 341            -text OK -default active -command commitMessageOK
 342   button .commitMessage.bottomFrame.leftFrame.cancel -text Cancel -default active \
 343           -command commitMessageCancel
 344   wm withdraw .commitMessage
 345   wm title .commitMessage "Git Commit Message"
 346
 347   pack .commitMessage.bottomFrame.leftFrame.label
 348   pack .commitMessage.bottomFrame.leftFrame.ok
 349   pack .commitMessage.bottomFrame.leftFrame.cancel
 350
 351   pack .commitMessage.bottomFrame.leftFrame -side left
 352   pack .commitMessage.bottomFrame.commit_body -side left
 353
 354   pack .commitMessage.topFrame
 355   pack .commitMessage.bottomFrame
 356
 357   wm transient .commitMessage .
 358   wm deiconify .commitMessage
 359 }
 360
 361
 362 # GUI
 363
 364 wm title . $windowTitle
 365
 366 # Buttons
 367
 368 panedwindow .buttons
 369
 370 frame  .buttons.commitFrame
 371 button .buttons.commitFrame.commit -text "2a. New local commit" -command commit
 372 button .buttons.commitFrame.amend -text "2b. Amend previous commit" -command commit_amend
 373 pack .buttons.commitFrame.commit -fill x
 374 pack .buttons.commitFrame.amend -fill x
 375
 376 button .buttons.update -text $updateButtonText \
 377           -command update_lilypond_with_rebase
 378 button .buttons.patch -text "3. Make patch set" \
 379           -command patch_from_origin
 380 toggle_rebase
 381 button .buttons.panic -text "Abort changes -- Reset to origin" \
 382           -command abort_changes -fg Blue -bg Red
 383 label   .buttons.spacer -text "                         "
 384 if {![file exists $lily_dir]} {
 385         .buttons.update configure \
 386             -text $initializeButtonText
 387         .buttons.commitFrame.commit configure -state disabled
 388         .buttons.commitFrame.amend configure -state disabled
 389         .buttons.patch configure -state disabled
 390         .buttons.panic configure -state disabled
 391 }
 392
 393 #  Operating buttons
 394
 395 pack .buttons.update -side left
 396 pack .buttons.commitFrame -side left
 397 pack .buttons.patch -side left
 398 pack .buttons.spacer -side left
 399 pack .buttons.panic -side right
 400
 401
 402 # Output text box
 403
 404 panedwindow .output
 405 label .output.label -text "Command output:"
 406 text .output.text -width 80 -height 15 \
 407         -xscrollcommand [list .output.horizontal set] \
 408         -yscrollcommand [list .output.vertical set] \
 409         -relief solid -border 2
 410 scrollbar .output.horizontal -orient h -command [list .output.text xview]
 411 scrollbar .output.vertical -orient v -command [list .output.text yview]
 412 pack .output.label -side left
 413 pack .output.horizontal -side bottom -fill x
 414 pack .output.vertical -side right -fill y
 415 pack .output.text -expand true -anchor nw -fill both
 416
 417 pack .buttons
 418 pack .output
 419
 420 #grid .buttons -row 2 -column 1
 421 #grid .output -row 3 -column 1 -sticky "w"