lilypond-1.3.67

diff --git a/lily/score-element.cc b/lily/score-element.cc
index 0761c5e51ec93857e7906091c4f9623fa011181d..5e929206f41e8093d5c256f4f06613bd54de4cf9 100644 (file)
--- a/lily/score-element.cc
+++ b/lily/score-element.cc
@@ -789,16 +789,42 @@ Score_element::ly_get_elt_property (SCM elt, SCM sym)
 }
 
 
+void
+Score_element::discretionary_processing()
+{
+}
+
+
+SCM
+spanner_get_bound (SCM slur, SCM dir)
+{
+  return dynamic_cast<Spanner*> (unsmob_element (slur))->get_bound (to_dir (dir))->self_scm_;
+}
+
+SCM
+score_element_get_pointer (SCM se, SCM name)
+{
+  SCM s = scm_assq (name, unsmob_element (se)->pointer_alist_);
+  return (s == SCM_BOOL_F) ? SCM_UNDEFINED : gh_cdr (s); 
+}
+
+SCM
+score_element_get_property (SCM se, SCM name)
+{
+  SCM s = scm_assq (name, unsmob_element (se)->property_alist_);
+  return (s == SCM_BOOL_F) ? SCM_UNDEFINED : gh_cdr (s); 
+}
+
+
 static void
 init_functions ()
 {
   scm_make_gsubr ("ly-get-elt-property", 2, 0, 0, (SCM(*)(...))Score_element::ly_get_elt_property);
   scm_make_gsubr ("ly-set-elt-property", 3, 0, 0, (SCM(*)(...))Score_element::ly_set_elt_property);
+  scm_make_gsubr ("ly-get-elt-pointer", 2 , 0, 0,  
+                 (SCM(*)(...)) score_element_get_pointer);
+  scm_make_gsubr ("ly-get-spanner-bound", 2 , 0, 0,  
+                 (SCM(*)(...)) spanner_get_bound);
 }
-
 ADD_SCM_INIT_FUNC(scoreelt, init_functions);
 
-void
-Score_element::discretionary_processing()
-{
-}

diff --git a/scm/slur.scm b/scm/slur.scm
index 58a1b2b99f316141b4cddac78c9ecc67dba72dde..540ce7ac7f3a21307a600e575b74fd689b768cc9 100644 (file)
--- a/scm/slur.scm
+++ b/scm/slur.scm
@@ -1,12 +1,12 @@
 
 (define (attached-to-stem slur dir)
-  (let* ((note-columns (get-pointer slur 'note-columns))
+  (let* ((note-columns (ly-get-elt-pointer slur 'note-columns))
         (col (if (= dir 1) (car note-columns) (car (reverse note-columns))))
-        (stem (get-pointer col 'stem)))
+        (stem (ly-get-elt-pointer col 'stem)))
     (and
-     (eq? col (get-bound slur dir))
+     (eq? col (ly-get-spanner-bound slur dir))
      stem
-     (get-pointer stem 'heads))))
+     (ly-get-elt-pointer stem 'heads))))
 
 
 ;; Slur-extremity-rules is a list of rules.  Each rule is a pair 
@@ -25,38 +25,38 @@
 
 (define slur-extremity-rules
   (list
-    (cons (lambda (slur dir)
-       ;; urg, code dup
-       (let* ((note-columns (get-pointer slur 'note-columns))
-        (col (if (= dir 1) (car note-columns) (car (reverse note-columns))))
-        (stem (get-pointer col 'stem)))
-        (and stem
-             (not (= (get-property slur 'direction) 
-                     (get-property stem 'direction))))))  'head)
+   (cons (lambda (slur dir)
+          ;; urg, code dup
+          (let* ((note-columns (ly-get-elt-pointer slur 'note-columns))
+                 (col (if (= dir 1) (car note-columns) (car (reverse note-columns))))
+                 (stem (ly-get-elt-pointer col 'stem)))
+            (and stem
+                 (not (= (ly-get-elt-property slur 'direction) 
+                         (ly-get-elt-property stem 'direction))))))  'head)
 
-    (cons (lambda (slur dir)
-           ;; if attached-to-stem
-           (and (attached-to-stem slur dir)
-                ;; and got beam
-                ;; urg, code dup
-                (let* ((note-columns (get-pointer slur 'note-columns))
-                       (col (if (= dir 1) (car note-columns) (car (reverse note-columns))))
-                       (stem (get-pointer col 'stem)))
-                  (and stem
-                       (get-pointer stem 'beam)
-                       ;; and beam on same side as slur
-                       (let ((beaming (get-property stem 'beaming)))
-                         (if (pair? beaming)
-                             (<= 1
-                                 (if (= dir -1) (car beaming) (cdr beaming)))
-                             #f))))))
-         'stem)
+   (cons (lambda (slur dir)
+          ;; if attached-to-stem
+          (and (attached-to-stem slur dir)
+               ;; and got beam
+               ;; urg, code dup
+               (let* ((note-columns (ly-get-elt-pointer slur 'note-columns))
+                      (col (if (= dir 1) (car note-columns) (car (reverse note-columns))))
+                      (stem (ly-get-elt-pointer col 'stem)))
+                 (and stem
+                      (ly-get-elt-pointer stem 'beam)
+                      ;; and beam on same side as slur
+                      (let ((beaming (ly-get-elt-property stem 'beaming)))
+                        (if (pair? beaming)
+                            (<= 1
+                                (if (= dir -1) (car beaming) (cdr beaming)))
+                            #f))))))
+        'stem)
 
-    (cons (lambda (slur dir) (not (attached-to-stem slur dir)))  'loose-end)
+   (cons (lambda (slur dir) (not (attached-to-stem slur dir)))  'loose-end)
 
-    ;; default case, attach to head
-    (cons (lambda (x y) #t)  'head)
-    ))
+   ;; default case, attach to head
+   (cons (lambda (x y) #t)  'head)
+   ))
 
 
 ;; This list defines the offsets for each type of attachment.