patch::: 1.3.65.jcn1

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

* Patches from hw

diff --git a/CHANGES b/CHANGES
index 48da8c0b8d44b1fc8be3f4695d2b35b6e752f38f..79fcef79fa3142eae01e6121c9344d811b04b141 100644 (file)
--- 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 3f4a9599f7d0be8211cf57fa8ed94f3aabed1a6e..4d97db3d86ee8c5f7c0fe8983b67beea9ef0862e 100644 (file)
--- 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 05ff6477eafef83fbbf80becce13cd5acf83393e..5f075607aa2354c97c2627e4818d37b6c56d083c 100644 (file)
--- 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 c21ae76db46b2ee00b883092a105fb7e5402ac55..3df0bc3ebe811c74d78bf7b8790b93464291bca0 100644 (file)
--- 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)
     ))