From 0a1980b54f8e72888ff1e31ee9f82111b6ca4fed Mon Sep 17 00:00:00 2001
From: fred <fred>
Date: Fri, 30 Jun 2000 10:38:15 +0000
Subject: [PATCH] lilypond-1.3.67

---
 lily/score-element.cc | 36 ++++++++++++++++++++++++----
 scm/slur.scm          | 66 +++++++++++++++++++++++++--------------------------
 2 files changed, 64 insertions(+), 38 deletions(-)

diff --git a/lily/score-element.cc b/lily/score-element.cc
index 0761c5e51e..5e929206f4 100644
--- 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 58a1b2b99f..540ce7ac7f 100644
--- 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.
-- 
2.11.4.GIT