From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 27 Jun 2000 18:13:14 +0000 (+0200)
Subject: patch::: 1.3.65.jcn1
X-Git-Tag: release/1.3.66~3
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a1e33e97acc8dbc811cea5a2747201bf0ed715ee;p=lilypond.git

patch::: 1.3.65.jcn1

1.3.65.jcn1
===========

* Patches from hw
---

diff --git a/CHANGES b/CHANGES
index 48da8c0b8d..79fcef79fa 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,8 @@
+1.3.65.jcn1
+===========
+
+* Patches from hw
+
 1.3.64.uu1
 ==========
 
diff --git a/VERSION b/VERSION
index 3f4a9599f7..4d97db3d86 100644
--- a/VERSION
+++ b/VERSION
@@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond
 MAJOR_VERSION=1
 MINOR_VERSION=3
 PATCH_LEVEL=65
-MY_PATCH_LEVEL=
+MY_PATCH_LEVEL=jcn1
 
 # use the above to send patches: MY_PATCH_LEVEL is always empty for a
 # released version.
diff --git a/lily/slur.cc b/lily/slur.cc
index 05ff6477ea..5f075607aa 100644
--- a/lily/slur.cc
+++ b/lily/slur.cc
@@ -220,10 +220,8 @@ Slur::set_extremities ()
 	  for (SCM s = scm_eval (ly_symbol2scm ("slur-extremity-rules"));
 	       s != SCM_EOL; s = gh_cdr (s))
 	    {
-	      SCM r = scm_eval (scm_listify (gh_caar (s),
-					     this->self_scm_,
-					     gh_int2scm ((int)dir),
-					     SCM_UNDEFINED));
+	      SCM r = gh_call2 (gh_caar (s), this->self_scm_,
+				 gh_int2scm ((int)dir));
 	      if (r != SCM_BOOL_F)
 		{
 		  index_set_cell (get_elt_property ("attachment"), dir,
diff --git a/scm/slur.scm b/scm/slur.scm
index c21ae76db4..3df0bc3ebe 100644
--- a/scm/slur.scm
+++ b/scm/slur.scm
@@ -8,38 +8,41 @@
      stem
      (get-pointer stem 'heads))))
 
+
+;; FIXME: document this.
 (define slur-extremity-rules
-  '(
-    ((lambda (slur dir)
+  (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)
-
-    ((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)
-
-    ((lambda (slur dir) (not (attached-to-stem slur dir))) . loose-end)
+		      (get-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) (not (attached-to-stem slur dir)))  'loose-end)
 
     ;; default case, attach to head
-    ((lambda (x y) #t) . head)
+    (cons (lambda (x y) #t)  'head)
     ))