X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=7a43a7bb54978e4f314b948ebe389e59664c14eb;hb=82e1937780c911be71b439a7d1f2006f058f0490;hp=57f89eeb3bab661fa1661c2dff0b6d8fe3d3c012;hpb=b64dcb418b66fb57b41067381ada9127a0e7e671;p=lilypond.git

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 57f89eeb3b..7a43a7bb54 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -58,7 +58,6 @@
 
     (ly:text-interface::interpret-markup layout props text)))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; beam slope
 
@@ -133,6 +132,33 @@
          (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000)))
     (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg))))
 
+(define (stem-stub::do-calculations grob)
+  (and (ly:grob-property (ly:grob-parent grob X) 'cross-staff)
+       (not (ly:grob-property (ly:grob-parent grob X) 'transparent))))
+
+(define-public (stem-stub::pure-height grob beg end)
+  (if (stem-stub::do-calculations grob)
+      '(0 . 0)
+      '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::width grob)
+  (if (stem-stub::do-calculations grob)
+      (grob::x-parent-width grob)
+      '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::extra-spacing-height grob)
+  (if (stem-stub::do-calculations grob)
+      (let* ((dad (ly:grob-parent grob X))
+             (refp (ly:grob-common-refpoint grob dad Y))
+             (stem_ph (ly:grob-pure-height dad refp 0 1000000))
+             (my_ph (ly:grob-pure-height grob refp 0 1000000))
+             ;; only account for distance if stem is on different staff than stub
+             (dist (if (grob::has-interface refp 'hara-kiri-group-spanner-interface)
+                       0
+                       (- (car my_ph) (car stem_ph)))))
+        (if (interval-empty? (interval-intersection stem_ph my_ph)) #f (coord-translate stem_ph dist)))
+      #f))
+
 (define-public (note-head::calc-duration-log grob)
   (min 2
        (ly:duration-log
@@ -390,6 +416,11 @@ and duration-log @var{log}."
 	   (equal? (ly:item-break-dir g) RIGHT))
       (ly:grob-translate-axis! g 3.5 X)))
 
+(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob)
+  (if (= 1 (ly:item-break-dir grob))
+      (pure-from-neighbor-interface::extra-spacing-height grob)
+      (cons -0.1 0.1)))
+
 (define-public (pure-from-neighbor-interface::extra-spacing-height grob)
   (let* ((height (ly:grob::stencil-height grob))
          (from-neighbors (interval-union
@@ -401,21 +432,17 @@ and duration-log @var{log}."
     (coord-operation - from-neighbors height)))
 
 (define-public (pure-from-neighbor-interface::account-for-span-bar grob)
-  (define (other-op x) (x (cons cdr car)))
   (let* ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
-         (hsb (ly:grob-property grob 'has-span-bar)))
+         (hsb (ly:grob-property grob 'has-span-bar))
+         (ii (interval-intersection esh (cons -1.01 1.01))))
     (if (pair? hsb)
-      (cons-map
-        (lambda (x)
-          (if (and ((other-op x) hsb)
-                   (not (and (eq? x car)
-                             (not (ly:grob-property grob 'allow-span-bar)))))
-              (x esh)
-              0))
-        (cons car cdr))
-      '(0 . 0))))
-
-(define (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
+        (cons (car (if (and (car hsb)
+                       (ly:grob-property grob 'allow-span-bar))
+                       esh ii))
+              (cdr (if (cdr hsb) esh ii)))
+        ii)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
   (let ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
         (to-staff (coord-operation -
                                    (interval-widen
@@ -837,11 +864,6 @@ and duration-log @var{log}."
   (let* ((event (event-cause grob))
 	 (digit (ly:event-property event 'digit)))
 
-    (if (> digit 5)
-	(ly:input-message (ly:event-property event 'origin)
-			  "Warning: Fingering notation for finger number ~a"
-			  digit))
-
     (number->string digit 10)))
 
 (define-public (string-number::calc-text grob)