scripts/auxiliar/lily-git.tcl

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