3 # GUI interface for common LilyPond git repository commands
4 # Copyright 2009--2012 by Johannes Schindelin and Carl Sorensen
10 proc get_environment_var {var_name default_value} {
12 if [catch {set return_value $env($var_name)}] {
13 set return_value $default_value
17 # set to 1 to set up for translation, to 0 for other
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]
25 # location of lilypond git
26 set lily_dir [get_environment_var LILYPOND_GIT $env(HOME)/lilypond-git]
28 if {$translator == 1} {
30 "LilyPond Translator's Git Interface version $version"
31 set updateButtonText "1. Update translation"
32 set initializeButtonText "1. Get translation"
33 set originHead "lilypond/translation"
34 set pushHead $originHead
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"
48 ## Submits the user data collected using the git config command
50 proc submituserdata {} {
51 exec git config --global user.name "$::username"
52 exec git config --global user.email "$::useremail"
57 ## Request name and email from user
59 proc requestuserdata {} {
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
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
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
75 foreach w [winfo children .b.c] {grid configure $w -padx 5 -pady 5}
77 bind .b <Return> {submituserdata}
80 ## Checks the user's global .gitconfig for name and email and executes requestuserdata if either is not found
82 if {![file exists "$env(HOME)/.gitconfig"]} {
83 set fileholder [open "$env(HOME)/.gitconfig" a+]
85 set fileholder [open "$env(HOME)/.gitconfig" r]
88 set usercheck [split [read $fileholder] "\n"]
90 if {![regexp "name" $usercheck] || ![regexp "email" $usercheck]} then {
95 ## Entry limit routine from jeff at hobbs org, downloaded from
96 ## http://www.purl.org/net/hobbs/tcl/tclet/entrylimit.html
98 ## For those who aren't using Tk4 with these, make a bell noop:
99 if [string match {} [info commands bell]] { proc bell args {} }
101 proc forceLen {len name el op} {
102 global $name ${name}_len
103 if [string comp $el {}] {
104 set old ${name}_len\($el)
109 if {[string length [set $name]] > $len} {
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.
121 ## The order must be:
123 ## 1) textvariable specification
125 ## 4) variable reinit
128 trace variable commit_header w {forceLen 50}
132 ## End of entry limit code
137 proc add_working_branch {} {
140 git checkout $originHead
141 git branch -f $workingBranch
145 set abort_dir "./aborted_edits"
147 proc write_to_output {s} {
148 .output.text insert insert $s
152 proc write_file_to_output {f} {
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"
162 write_to_output [read $f 24]
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]
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"
187 proc config_quiet {args} {
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]} {
197 proc update_lilypond_rebase {} {
202 global commit_message
203 global commit_canceled
204 set commit_canceled 0
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!" \
213 git commit -a -m $commit_message
214 git rebase --whitespace=fix HEAD^
215 set commit_message ""
220 proc commit_amend {} {
221 git commit -a --amend -C HEAD
222 git rebase --whitespace=fix HEAD^
225 proc update_lilypond_norebase {} {
229 proc update_lilypond_with_rebase {} {
231 update_lilypond $rebase
234 proc update_lilypond {rebase} {
241 . config -cursor watch
242 if {![file exists $lily_dir]} {
243 write_to_output "Cloning LilyPond (this can take some time) ...\n"
247 git config core.bare false
248 git remote add -t $originHead \
249 origin git://git.sv.gnu.org/lilypond.git
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 != ""} {
257 git checkout $workingBranch
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
266 .buttons.panic configure -state normal
269 write_to_output "Updating LilyPond...\n"
272 git rebase origin/$originHead $originHead
273 git rebase origin/$originHead $workingBranch
275 git merge origin/$originHead
278 write_to_output "Done.\n"
282 proc patch_from_origin {} {
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?"
291 proc make_patch_from_origin {rebase} {
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"
303 proc push_patch_to_staging {} {
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."
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
329 proc abort_changes {} {
332 set answer [tk_messageBox -type okcancel \
333 -message "This will copy all changed files to $abort_dir and reset the repository." \
337 write_to_output "abort_dir: $abort_dir \n"
338 if {![file exists $abort_dir]} {
339 set return_code [exec mkdir $abort_dir]
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]
349 set return_code [git reset --hard origin/$originHead]
350 write_to_output "Repository reset. \n"
355 proc toggle_rebase {} {
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
365 .buttons.update configure -text $initializeButtonText
369 proc clear_rebase {} {
381 proc commitMessageOK {} {
382 global commit_message
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
389 proc commitMessageCancel {} {
390 global commit_message
391 global commit_canceled
392 set commit_message ""
393 set commit_canceled 1
394 destroy .commitMessage
397 proc pushContinue {} {
399 set push_canceled = 0
400 destroy .gitLogWindow
406 destroy .gitLogWindow
410 # git log output window
411 proc get_git_log {} {
413 toplevel .gitLogWindow
414 frame .gitLogWindow.messageFrame
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]
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 \
431 wm withdraw .gitLogWindow
432 wm title .gitLogWindow "Commits to be pushed"
434 pack .gitLogWindow.messageFrame.leftFrame.label
435 pack .gitLogWindow.messageFrame.leftFrame.ok
436 pack .gitLogWindow.messageFrame.leftFrame.cancel
438 pack .gitLogWindow.messageFrame.leftFrame -side left
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
445 wm transient .gitLogWindow .
446 wm deiconify .gitLogWindow
447 .gitLogWindow.messageFrame.message_body insert insert $log_text
451 # Commit message input window
452 proc get_commit_message {} {
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
464 frame .commitMessage.bottomFrame
465 text .commitMessage.bottomFrame.commit_body \
466 -width 75 -height 10 -relief solid -border 2 -wrap none
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"
478 pack .commitMessage.bottomFrame.leftFrame.label
479 pack .commitMessage.bottomFrame.leftFrame.ok
480 pack .commitMessage.bottomFrame.leftFrame.cancel
482 pack .commitMessage.bottomFrame.leftFrame -side left
483 pack .commitMessage.bottomFrame.commit_body -side left
485 pack .commitMessage.topFrame
486 pack .commitMessage.bottomFrame
488 wm transient .commitMessage .
489 wm deiconify .commitMessage
495 wm title . $windowTitle
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
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
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
526 .buttons.push configure -state disabled
528 .buttons.panic configure -state disabled
533 pack .buttons.update -side left
534 pack .buttons.commitFrame -side left
535 pack .buttons.patch -side left
537 pack .buttons.push -side left
539 pack .buttons.spacer -side left
540 pack .buttons.panic -side right
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
561 # set working branch and push branch
562 set workingBranch [get_environment_var LILYPOND_BRANCH $defaultBranch]
564 puts "\nworkingBranch $workingBranch\n"
566 if {[file exists $lily_dir]} {
568 set branchList [exec git branch]
569 if { $workingBranch != ""} {
570 if {![regexp $workingBranch $branchList]} {
573 git checkout $workingBranch