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