From 6c09371dbceaba5a2ca168008b25dfbb1f8c18ae Mon Sep 17 00:00:00 2001
From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Wed, 12 Mar 2008 23:33:27 -0300
Subject: [PATCH] Fix #339.

Introduce prefer-dotted-right property.
---
 .../collision-dots-up-space-dotted.ly         | 19 ++++++++++
 lily/note-collision.cc                        | 36 ++++++++++++-------
 scm/define-grob-properties.scm                |  2 +-
 scm/define-grobs.scm                          |  1 +
 4 files changed, 44 insertions(+), 14 deletions(-)
 create mode 100644 input/regression/collision-dots-up-space-dotted.ly

diff --git a/input/regression/collision-dots-up-space-dotted.ly b/input/regression/collision-dots-up-space-dotted.ly
new file mode 100644
index 0000000000..4175fba2db
--- /dev/null
+++ b/input/regression/collision-dots-up-space-dotted.ly
@@ -0,0 +1,19 @@
+\header {
+
+  texidoc = "For collisions where the upper note is dotted and in a
+  space, the upper is moved to right.  This behavior can be tuned by
+  prefer-dotted-right."
+
+  }
+
+\version "2.10.20"
+
+\paper{ ragged-right=##t }
+
+\new Staff \relative c' <<
+  { fis4.
+    \override Staff.NoteCollision #'prefer-dotted-right = ##f
+    fis4. }
+  \\
+  { \autoBeamOff e8 e e e e e e }
+>> 
diff --git a/lily/note-collision.cc b/lily/note-collision.cc
index b4e353d978..ab15741288 100644
--- a/lily/note-collision.cc
+++ b/lily/note-collision.cc
@@ -279,12 +279,20 @@ check_meshing_chords (Grob *me,
     {
       Grob *staff = Staff_symbol_referencer::get_staff_symbol (me);
       if (!Staff_symbol_referencer::on_line (staff, ups[0]))
-	{
-	  Grob *d = unsmob_grob (head_up->get_object ("dot"));
-	  Grob *parent = d->get_parent (X_AXIS);
-	  if (Dot_column::has_interface (parent))
-	    Side_position_interface::add_support (parent, head_down);
-	}
+	/*
+	  TODO: consider junking the else body.
+	*/
+	if (to_boolean (me->get_property ("prefer-dotted-right")))
+	  {
+	    shift_amount = 0.5;
+	  }
+	else
+	  {
+	    Grob *d = unsmob_grob (head_up->get_object ("dot"));
+	    Grob *parent = d->get_parent (X_AXIS);
+	    if (Dot_column::has_interface (parent))
+	      Side_position_interface::add_support (parent, head_down);
+	  }
     }
 
   /* For full or close half collisions, the right hand head may
@@ -333,30 +341,30 @@ Note_collision_interface::calc_positioning_done (SCM smob)
   Grob *me = unsmob_grob (smob);
   me->set_property ("positioning-done", SCM_BOOL_T);
   
-  Drul_array<vector<Grob*> > cg = get_clash_groups (me);
+  Drul_array<vector<Grob*> > clash_groups = get_clash_groups (me);
 
   Direction d = UP;
   do
     {
-      for (vsize i = cg[d].size (); i--; )
+      for (vsize i = clash_groups[d].size (); i--; )
 	{
 	  /*
 	    Trigger positioning
 	   */
-	  cg[d][i]->extent (me, X_AXIS);
+	  clash_groups[d][i]->extent (me, X_AXIS);
 	}
     }
   while (flip (&d) != UP);
 
-  SCM autos (automatic_shift (me, cg));
+  SCM autos (automatic_shift (me, clash_groups));
   SCM hand (forced_shift (me));
 
   Real wid = 0.0;
   do
     {
-      if (cg[d].size ())
+      if (clash_groups[d].size ())
 	{
-	  Grob *h = cg[d][0];
+	  Grob *h = clash_groups[d][0];
 	  Grob *fh = Note_column::first_head (h);
 	  if (fh)
 	    wid = fh->extent (h, X_AXIS).length ();
@@ -579,4 +587,6 @@ ADD_INTERFACE (Note_collision_interface,
 	       /* properties */
 	       "merge-differently-dotted "
 	       "merge-differently-headed "
-	       "positioning-done ");
+	       "positioning-done "
+	       "prefer-dotted-right "
+	       );
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 4ec267019c..089a1ada23 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -415,7 +415,7 @@ whether to put a page turn at this column.  Can be @code{force} or
 
 For slurs, this value selects which slur candidate
 to use; if extreme positions are requested, the closest one is taken.")
-
+     (prefer-dotted-right ,boolean? "For note collisions, prefer to shift dotted up-note to the right, rather than shifting just the dot.")
      (ratio ,number? "Parameter for slur shape.  The higher this
 number, the quicker the slur attains its @code{height-limit}.")
      (remove-empty ,boolean? "If set, remove group if it contains no
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index 14f57fedd6..d81c37d3c9 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -1149,6 +1149,7 @@
 	(axes . (,X ,Y))
 	(X-extent . ,ly:axis-group-interface::width)
 	(Y-extent . ,ly:axis-group-interface::height)
+	(prefer-dotted-right . #t)
 	(positioning-done . ,ly:note-collision-interface::calc-positioning-done)
 	(meta . ((class . Item)
 		 (interfaces . (note-collision-interface
-- 
2.39.5