scripts/auxiliar/lily-git.tcl

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