Issue 5167/6: Changes: show \markup xxx = ... \etc assignments

[lilypond.git] / lily / lily-guile.cc

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 06018c4c9c48502dde6b90eedd16fd05c17c6acf..f37380f024fc4b65fc9b368564c26dd3dd4a3190 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -1,7 +1,7 @@
 /*
   This file is part of LilyPond, the GNU music typesetter.
 
-  Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+  Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
   Han-Wen Nienhuys <hanwen@xs4all.nl>
 
   LilyPond is free software: you can redistribute it and/or modify
@@ -40,6 +40,7 @@ using namespace std;
 #include "source-file.hh"
 #include "version.hh"
 #include "warn.hh"
+#include "lily-imports.hh"
 
 /*
   symbols/strings.
@@ -144,7 +145,7 @@ ly_string2scm (string const &str)
 char *
 ly_scm2str0 (SCM str)
 {
-  return scm_to_locale_string (str);
+  return scm_to_utf8_string (str);
 }
 
 /*
@@ -401,13 +402,13 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
 {
 
   // If undefined, some internal function caused it...should never happen.
-  assert (val != SCM_UNDEFINED);
+  assert (!SCM_UNBNDP (val));
   if (!scm_is_symbol (sym))
     return false;
 
   SCM type = scm_object_property (sym, type_symbol);
 
-  if (type != SCM_EOL && !ly_is_procedure (type))
+  if (!scm_is_null (type) && !ly_is_procedure (type))
     {
       warning (_f ("cannot find property type-check for `%s' (%s).",
                    ly_symbol2string (sym).c_str (),
@@ -429,16 +430,15 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
 
     TODO: should remove #f from allowed vals?
   */
-  if (val == SCM_EOL || val == SCM_BOOL_F)
+  if (scm_is_null (val) || scm_is_false (val))
     return true;
 
-  if (val != SCM_EOL
+  if (!scm_is_null (val)
       && ly_is_procedure (type)
-      && scm_call_1 (type, val) == SCM_BOOL_F)
+      && scm_is_false (scm_call_1 (type, val)))
     {
-      SCM typefunc = ly_lily_module_constant ("type-name");
-      SCM type_name = scm_call_1 (typefunc, type);
-      
+      SCM type_name = Lily::type_name (type);
+
       warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'",
                    ly_symbol2string (sym).c_str (),
                    print_scm_val (val),
@@ -449,6 +449,23 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
   return true;
 }
 
+void
+ly_wrong_smob_arg (bool pred (SCM), SCM var, int number, const char *fun)
+{
+  string type = predicate_to_typename ((void *) pred);
+  if (pred (var))
+    {
+      // Uh oh.  unsmob<T> delivered 0, yet
+      // unsmob<T> delivers true.  This means that unsmob<T> is a
+      // matching check from a base class of T, but var is of an
+      // incompatible derived type.
+      type = string (_ ("Wrong kind of ")).append (type);
+    }
+  scm_wrong_type_arg_msg (mangle_cxx_identifier (fun).c_str (),
+                          number, var, type.c_str ());
+}
+
+
 /* some SCM abbrevs
 
 zijn deze nou handig?
@@ -512,6 +529,18 @@ display_list (SCM s)
   return SCM_UNSPECIFIED;
 }
 
+// Needed as complement to int_list_to_slice since scm_c_memq refuses
+// to work with dotted lists.
+
+SCM
+ly_memv (SCM v, SCM l)
+{
+  for (; scm_is_pair (l); l = scm_cdr (l))
+    if (scm_is_true (scm_eqv_p (v, scm_car (l))))
+      return l;
+  return SCM_BOOL_F;
+}
+
 Slice
 int_list_to_slice (SCM l)
 {
@@ -564,7 +593,7 @@ robust_scm2string (SCM k, const string &s)
 int
 robust_scm2int (SCM k, int o)
 {
-  if (scm_integer_p (k) == SCM_BOOL_T)
+  if (scm_is_integer (k))
     o = scm_to_int (k);
   return o;
 }
@@ -572,7 +601,7 @@ robust_scm2int (SCM k, int o)
 vsize
 robust_scm2vsize (SCM k, vsize o)
 {
-  if (scm_integer_p (k) == SCM_BOOL_T)
+  if (scm_is_integer (k))
     {
       int i = scm_to_int (k);
       if (i >= 0)
@@ -655,8 +684,7 @@ alist_to_hashq (SCM alist)
 SCM
 ly_hash2alist (SCM tab)
 {
-  SCM func = ly_lily_module_constant ("hash-table->alist");
-  return scm_call_1 (func, tab);
+  return Lily::hash_table_to_alist (tab);
 }
 
 /*