Merge branch 'master' of git.sv.gnu.org:/srv/git/denemo

8 files changed, 150 insertions, 80 deletions

diff --git a/actions/Composer.shortcuts b/actions/Composer.shortcuts
index 00bcd2a0..71135e67 100644
--- a/actions/Composer.shortcuts
+++ b/actions/Composer.shortcuts
@@ -175,14 +175,12 @@
       
       <row>
         <action>JumpUpOctave</action>   
-        <bind>Ctrl+Up</bind>
-        <bind>Ctrl+Shft+Up</bind>
+        <bind>Ctrl+Up</bind>        
       </row>
       
       <row>
         <action>JumpDownOctave</action>
-        <bind>Ctrl+Down</bind>
-        <bind>Ctrl+Shft+Down</bind>
+        <bind>Ctrl+Down</bind>        
       </row>      
       
 	<!-- Staff Navigation -->
@@ -242,6 +240,11 @@
         <action>GoToMeasure</action>
       </row>
       <row>
+		<action>SelectMeasure</action>
+		<bind>Ctrl+Shft+Up</bind>
+		<bind>Ctrl+Shft+Down</bind>
+      </row>
+      <row>
         <action>GoToBeginning</action>
         <hidden>true</hidden>
         <bind>Shft+Home</bind>
@@ -264,6 +267,10 @@
 		<bind>Alt+End</bind>
       </row>
       <row>
+		<action>MoveToPreviousEmptyMeasure</action>
+		<bind>Alt+Home</bind>
+      </row>
+      <row>
 		<action>SelectionToEmptyMeasure</action>
 		<bind>Alt+Shft+End</bind>
       </row>	
diff --git a/actions/Default.commands b/actions/Default.commands
index 04b26953..4bb3a44d 100644
--- a/actions/Default.commands
+++ b/actions/Default.commands
@@ -4402,7 +4402,30 @@ for second and subsequent systems</tooltip>
         <menupath>/ObjectMenu/NotationMagick/GenerateRhythmFromString</menupath>
         <label>Insert reversed string as reversed binary rhythm</label>
         <tooltip>Give a string to generate a rhythm out of its ascii chars in binary encoding. The string gets reversed before converting. The rhythm for each letter gets reversed before inserting.</tooltip>
-      </row>      
+      </row>
+      <row>
+        <action>Off</action>
+        <scheme></scheme>
+        <menupath>/MainMenu/ViewMenu</menupath>
+        <label>Off</label>
+        <tooltip>Off</tooltip>
+      </row>
+      <row>
+        <action>SelectMeasure</action>
+        <after>SelectColumn</after>
+        <scheme></scheme>
+        <menupath>/MainMenu/EditMenu/Select</menupath>
+        <label>Select Measure</label>
+        <tooltip>Create a selection for the entire current measure</tooltip>
+      </row>
+      <row>
+        <action>MoveToPreviousEmptyMeasure</action>
+        <after>GoToEmptyMeasure</after>
+        <scheme></scheme>
+        <menupath>/MainMenu/NavigationMenu/Seek</menupath>
+        <label>Move To Previous Empty Measure</label>
+        <tooltip>Move the cursor left until it finds an empty measure or the staffs beginning</tooltip>
+      </row>
     </map>
   </merge>
 </Denemo>
diff --git a/actions/denemo.scm b/actions/denemo.scm
index 15486740..6cc973b0 100644
--- a/actions/denemo.scm
+++ b/actions/denemo.scm
@@ -153,19 +153,16 @@
 
 ;Next object in selection for all staffs
 (define (NextSelectedObjectAllStaffs)
-	(define remember 1)
+	(define lastposition (GetPosition))
 	(if (and (d-MarkStatus) (d-IsInSelection))
 		(if (d-NextSelectedObject)
 		  #t ; found one. End
-		  (begin (set! remember (d-GetHorizontalPosition)) ; check one staff down and if there is a selection.
-		  	(if (d-MoveToStaffDown) 
+		   (if (d-MoveToStaffDown) ; no selected item left in the current staff. check one down.
 		  		(if (selection::MoveToStaffBeginning) 
 				  	#t ; found a selection in the lower staff
-				  	(begin (d-GoToPosition #f (- (d-GetStaff) 1) #f remember) #f)) ; reset cursor to the last known selection position
-				  #f))) ; no staff below
+				  	(begin (apply d-GoToPosition lastposition ) #f)) ; reset cursor to the last known selection position and end.
+				  #f)) ; no staff below
 	  #f)); no selection or cursor not in selection
-	
-
 
 (define (selection::MoveToStaffBeginning)
 	(define rememberStaff (d-GetStaff))
@@ -178,8 +175,6 @@
 				(begin (apply d-GoToPosition rememberPosition) #f)))
 		#f)) ; no selection at all. 
 
-
-
 ;Find the next object that returns #t from the given test function. Don't write the function in parentheses, just give the name (except you give a function that returns a name :))
 (define (FindNextObjectAllStaffs test?) 
 	(let loopy ()
@@ -197,7 +192,6 @@
 	));loopy end
 
 
-
 ;SingleAndSelectionSwitcher by Nils Gey Jan/2010
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;Automatically applies a script to a whole selection. You can give different commands or command blocks with (begin) for single items or whole selections. You can enter a complete scheme script with (),  arguments and everything you would want to run standalone. Don't forget to escape chars like  \" . You can even use a complete (begin ) block.
@@ -211,24 +205,22 @@
 
 (define* (SingleAndSelectionSwitcher commandsingle #:optional (commandselection commandsingle) (onlyFor "#t")) ; Amazingly commandsingle is already defined on spot so that it can be used again in the same line to define commandselection 
 	(d-PushPosition)
-	(if (and DenemoPref_applytoselection (d-GoToSelectionStart))
-	(begin
-		(if (eval-string onlyFor)
-			(eval-string  commandselection))
-		(let loop ()
-		(if (NextSelectedObjectAllStaffs)
+	(if (and DenemoPref_applytoselection (d-MarkStatus))
+		(begin
+			(d-GoToSelectionStart)
 			(if (eval-string onlyFor)
-				(begin (eval-string  commandselection) (loop))
-				(loop) ; don't process this object, next please.
-			)
-		))
-		(d-GoToSelectionStart)
-		(d-PopPosition)
-		)
-	(begin	
-		(eval-string commandsingle)))) ; End of SingleAndSelectionSwitcher
-
-; MapToSelection is like schemes (map) mixed with ApplyToSelection. Use a proc on all selection items and gather all proc return values in a list.
+				(eval-string  commandselection))
+			(let loop ()
+			(if (NextSelectedObjectAllStaffs)
+				(if (eval-string onlyFor)
+					(begin (eval-string  commandselection) (loop))
+					(loop)))) ; don't process this object, next please.		
+			(d-GoToSelectionStart)
+			(d-PopPosition))
+		(begin	
+			(eval-string commandsingle)))) ; End of SingleAndSelectionSwitcher
+
+; MapToSelection is like schemes (map) mixed with ApplyToSelection. Use a proc on all selection items and gather all proc return values in a list. You can give an optional test, only items which return #t are processed.
 (define* (MapToSelection proc #:optional (onlyFor (lambda () #t)))
 	(define return (list #f))	; prepare return list
 	(define (gather)
@@ -239,12 +231,29 @@
 		(begin 
 			(d-PushPosition)
 			(d-GoToSelectionStart)
-			(gather) ; start one without testing. We already know we have a selection and RepeatProcWhileTest tests first.
+			(gather) ; start one without selection testing. We already know we have a selection and RepeatProcWhileTest tests first which results in ignoring the first selected item.
 			(RepeatProcWhileTest gather NextSelectedObjectAllStaffs) ; Use the proc/gather function on all items in the selection
 			(d-PopPosition)
 			(list-tail return 1))			
 		#f))
 
+;ForEachToSelection applies the command to each item in the selection. The return value is unspecified. Faster than MapToSelection.
+(define* (ForEachToSelection proc #:optional (onlyFor (lambda () #t)))
+	(define (apply)
+		(if (onlyFor) ; test the current item
+			(proc)			
+			#f))
+	(if (and DenemoPref_applytoselection (d-MarkStatus)) ; only if preferences allow it and if there is a selection at all
+		(begin 
+			(d-PushPosition)
+			(d-GoToSelectionStart)
+			(apply) ; start one without selection testing. We already know we have a selection and RepeatProcWhileTest tests first which results in ignoring the first selected item.
+			(RepeatProcWhileTest apply NextSelectedObjectAllStaffs) ; Use the proc/gather function on all items in the selection
+			(d-PopPosition)
+			(if #f #f) ; return unspecified.
+			)			
+		#f))
+
 
 ; A set of simple tests / questions for score objects. 
 (define (Music?) 
diff --git a/actions/menus/MainMenu/EditMenu/Select/SelectMeasure b/actions/menus/MainMenu/EditMenu/Select/SelectMeasure
new file mode 100644
index 00000000..6cc12d93
--- /dev/null
+++ b/actions/menus/MainMenu/EditMenu/Select/SelectMeasure
@@ -0,0 +1,23 @@
+<?xml version="1.0"?>
+<Denemo>
+  <merge>
+    <title>A Denemo Keymap</title>
+    <author>AT, JRR, RTS</author>
+    <map>
+      <row>
+        <after>SelectColumn</after>
+        <action>SelectMeasure</action>
+        <scheme>(if (None?)
+	(d-SetMark)
+	(begin
+		(d-PushPosition)
+		(d-UnsetMark)
+		(GoToMeasureBeginning)
+		(RepeatProcWhileTest d-CursorRight (lambda () (not (Appending?))))
+		(d-PopPosition)))</scheme>
+        <label>Select Measure</label>
+        <tooltip>Create a selection for the entire current measure</tooltip>
+      </row>
+    </map>
+  </merge>
+</Denemo>
diff --git a/actions/menus/MainMenu/EditMenu/Shift/init.scm b/actions/menus/MainMenu/EditMenu/Shift/init.scm
index f26846b3..fca21271 100644
--- a/actions/menus/MainMenu/EditMenu/Shift/init.scm
+++ b/actions/menus/MainMenu/EditMenu/Shift/init.scm
@@ -1,26 +1,17 @@
-(define (ShiftProto method)
  ; Get all notes on cursor position and create a list with new values which then exchanges the current notes on cursor position
-
-(if (Note?) 
-    (ANS::ChangeChordNotes  
-  	(map method (ANS::GetChordNotes))
-  	)
-    #f ; not a note/chord
-  )
-)
+(define (ShiftProto method)
+	(if (Note?) 
+		(ANS::ChangeChordNotes (map method (ANS::GetChordNotes)))
+		#f)) ; not a note/chord
 
 (define (ShiftUp)
- (ShiftProto ANS::CalculateDiatonicStepUp)
-)
+ (ShiftProto ANS::CalculateDiatonicStepUp))
 
 (define (ShiftDown)
- (ShiftProto ANS::CalculateDiatonicStepDown)
-)
+ (ShiftProto ANS::CalculateDiatonicStepDown))
 
 (define (ShiftRealOctaveUp) ;in reality this is not shift but transpose. But there are too many functions with the name transpose already...
- (ShiftProto ANS::CalculateRealOctaveUp)
-)
+ (ShiftProto ANS::CalculateRealOctaveUp))
 
 (define (ShiftRealOctaveDown) ;in reality this is not shift but transpose. But there are too many functions with the name transpose already...
- (ShiftProto ANS::CalculateRealOctaveDown)
-)
+ (ShiftProto ANS::CalculateRealOctaveDown))
diff --git a/actions/menus/MainMenu/NavigationMenu/Cursor/MoveToMovementEnd b/actions/menus/MainMenu/NavigationMenu/Cursor/MoveToMovementEnd
index 44cc3b99..bc32ceb9 100644
--- a/actions/menus/MainMenu/NavigationMenu/Cursor/MoveToMovementEnd
+++ b/actions/menus/MainMenu/NavigationMenu/Cursor/MoveToMovementEnd
@@ -7,8 +7,7 @@
       <row>
         <after>MoveToMovementBeginning</after>
         <action>MoveToMovementEnd</action>
-        <scheme>(let loop ()
-(RepeatUntilFail d-MoveToStaffDown)			
+        <scheme>(RepeatUntilFail d-MoveToStaffDown)			
 (d-MoveToEnd)
 		</scheme>
         <label>Move To Movement End</label>
diff --git a/actions/menus/MainMenu/NavigationMenu/Seek/MoveToPreviousEmptyMeasure b/actions/menus/MainMenu/NavigationMenu/Seek/MoveToPreviousEmptyMeasure
new file mode 100644
index 00000000..eb5c33aa
--- /dev/null
+++ b/actions/menus/MainMenu/NavigationMenu/Seek/MoveToPreviousEmptyMeasure
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+<Denemo>
+  <merge>
+    <title>A Denemo Keymap</title>
+    <author>AT, JRR, RTS</author>
+    <map>
+      <row>
+        <after>GoToEmptyMeasure</after>
+        <action>MoveToPreviousEmptyMeasure</action>
+        <scheme>(RepeatUntilFail (lambda () (and (not (None?)) (d-MoveToMeasureLeft))))</scheme>
+        <label>Move To Previous Empty Measure</label>
+        <tooltip>Move the cursor left until it finds an empty measure or the staffs beginning</tooltip>
+      </row>
+    </map>
+  </merge>
+</Denemo>
diff --git a/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass b/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
index 5858805e..245bb8dc 100644
--- a/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
+++ b/actions/menus/MainMenu/PlaybackMenu/ConvertMidiForBass
@@ -50,7 +50,7 @@
 		    
 		    (define (insert-note name dur)
 		      (let ((base (duration::GuessBaseNoteInTicks dur)))
-			(disp "Note " name " has duration " dur " interpreted as " base "\n")
+			;(disp "Note " name " has duration " dur " interpreted as " base "\n")
 			(if base
 			    (begin
 			      (if (&gt; (- dur base) (- (* 2 base) dur))
@@ -66,10 +66,12 @@
      
                     ;;;;;; take the Notes and seek out bass notes, remove them and form chords, insert chords in staff above
 		    (let () ;;;no loop here we drive it via the loopforbasskey
-                      ;;;;;;;;;;; overlap decides if two notes should be a chord	 
+
+
+                      ;;;;;;;;;;; overlap decides if two notes should be a chord
+		      ;;;;;;;;;;; the criterion is simply if they start close together
 		      (define (overlap n1 n2)
-			(if (list? n1)
-			    (set! n1 (car n1)))
+			
 			(&lt; (abs (- (note.start n1) (note.start n2))) 50))
                       ;;;;;;;;;;;;;;;;;; end of overlap
 		      
@@ -105,7 +107,7 @@
 					    (if (&gt; (length notes) (+ 1 index))
 						(begin
 						  (set! note2 (list-ref notes (+ 1 index)))
-						  (if (overlap note1 (car note2))
+						  (if (overlap (car note1) (car note2))
 						      (begin
 							(list-set! notes index (cons (car note2) note1))
 							(set! notes (delq note2 notes)) ;;so we loop with same index
@@ -116,10 +118,12 @@
 					notes)	
 ;;;;;;; insert-chord takes a list of note structs and puts a chord in the staff above with those notes.		
 				      (define (insert-chord chord duration)
+				      (disp "making a chord " duration "\n")
 						(insert-note (note.name (car chord)) duration)
 							(for-each  add-note (cdr chord)))
 
 				      (define (make-tied)
+				      (disp "tying ...\n")
 					(d-PrevNote)
 					(d-ToggleTie)
 					(d-NextNote))
@@ -132,11 +136,11 @@
 					  (let loop ((index 0))
 					    (if (&gt; (length names) index)
 						(begin
-						  (disp "Notes before " Notes "\n")
+						  ;(disp "Notes before " Notes "\n")
 						  (set! Notes (cons (list (make-note 'name (list-ref names index)
 										     'start thestart
 										     'duration theduration)) Notes))
-						  (disp "Notes after " Notes "\n")
+						  ;(disp "Notes after " Notes "\n")
 						  (loop (+ index 1)))))))
 				      
                                        ;;;;;;; insert-chords takes a list of lists of note structs and the duration of the denemo bass note they have been assigned to. It inserts a chord for each of the lists assigning durations to fit the bass note.If enough of the last chord duration remains a the chord is returned with start and duration modified to suit		
@@ -155,6 +159,12 @@
 						  (set! chord2 (list-ref chords (+ 1 index)));;move this into the init
 						  (set! duration (- (note.start (car chord1)) (note.start (car chord2))))
 						  (set! remaining (- remaining duration))
+						    (if (&lt; remaining 50)
+						      (begin
+							(set! duration (+ duration remaining))
+							(set! remaining 0)))
+							      
+
 						  (disp "Insert chord " chord1 " With duration " duration "\n")
 						  (insert-chord chord1 duration)
 						  (loop (+ index 1)))	     
@@ -162,7 +172,7 @@
 						  (if (= (length chords) (+ 1 index))
 						      (let ((chord (list-ref chords index)) (n2 #f))
 							
-							;(disp "the remaining duration is " remaining " for chord " chord" \n")
+							(disp "the remaining duration is " remaining " for chord " chord" \n")
 							(if (&gt; remaining 0)
 							    (begin 
 							(insert-chord chord remaining)
@@ -177,22 +187,14 @@
 							(d-WarningDialog "We have no chord"))))))))
 				      
 				    
-				      
+				      ;;;;;  procedure "contains" decides if a note n2 belongs to a bass-note, at least in part
+				      ;;;;;  if n2 starts after the bass-note ends then #f
+				      ;;;;;  else if n2 ends before the bass-note ends then #t
+				      ;;;;;  else if overlap of n2 with bass-note is fair proportion of n2 #t  more that one fifth, 0.2, say
+				      ;;;;;  else #f
 				      (define (contains bass-note n2)
-					(let (
-					      (bass-note.end (+ (note.start bass-note) (note.duration bass-note)))
-					      (n2.end (+ (note.start n2) (note.duration n2))))
-					  (disp "contains " bass-note "and " n2 " giving "
-					 (cond
-					   ((&gt; (note.start n2) bass-note.end)
-					    #f)
-					   ((&gt; bass-note.end n2.end)
-					    #t)
-					   ((&gt; (/ (- n2.end  bass-note.end) (note.duration n2)) 0.75)
-					    #t)
-					   (else #f))
-						
-						"\n")
+					(let ((bass-note.end (+ (note.start bass-note) (note.duration bass-note)))
+					      (n2.end (+ (note.start n2) (note.duration n2))))					 
 					  (cond
 					   ((&gt; (note.start n2) bass-note.end)
 					    #f)
@@ -216,7 +218,7 @@
 						  (set! Notes (delq bass-note Notes))
 						  )
 						(loopgetbassnote (+ index 1)))))
-                                           ;;;; if bass-note then that note should have been removed from Notes, next get chord notes
+                                           ;;;; if bass-note then that note will have been removed from Notes, next get chord notes
 				      (set! notes-belonging '())
 				      (if bass-note					    
 					  (let loop ((index 0))
@@ -234,19 +236,19 @@
 				      (d-StaffUp)
 				      (GoToMeasureEnd)				      
 				      (if (&gt; (length notes-belonging) 0)
-					  (begin
-					   
+					  (begin					   
 					;(disp "notes-belonging looks like this: " notes-belonging "\n")
 					    (insert-chords notes-belonging bass-duration)
 					;(disp "insert-chords finished\n")
 					)
 				      
 					  (begin
-					    (eval-string (string-append  "(d-Insert"  (duration::ticks-&gt;denemo bass-duration)")(d-MoveCursorLeft)(d-StagedDelete)"))))
+					    (eval-string (string-append  "(d-Insert"  (duration::ticks-&gt;denemo bass-duration)")(d-MoveCursorLeft)(d-StagedDelete)"))
+					    (disp "Bass note with no accompanying chord" bass-note "sent "  (string-append  "(d-Insert"  (duration::ticks-&gt;denemo bass-duration)")(d-StagedDelete)") "\n" )))
 				      (d-PopPosition)
 				      (if (d-NextObject)
 					  (loopforbasskey)
-					  (d-WarningDialog "Good! finished all notes bass staff")));;;if there is a note in the bass clef
+					  (d-WarningDialog "finished bass staff")));;;if there is a note in the bass clef
 				    (d-WarningDialog "No more bass notes")))))
 		
 		(begin