Deprecate scm_get_keyword

* libguile/deprecated.c (scm_get_keyword): Deprecate.
* libguile/deprecated.h:
* libguile/goops.c:
* libguile/goops.h:

4 files changed, 15 insertions, 56 deletions

diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 1ca3227a4..4a82e4f5e 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -95,6 +95,8 @@ scm_memory_error (const char *subr)
 
 SCM scm_no_applicable_method = SCM_BOOL_F;
 
+SCM var_get_keyword = SCM_BOOL_F;
+
 SCM scm_class_boolean, scm_class_char, scm_class_pair;
 SCM scm_class_procedure, scm_class_string, scm_class_symbol;
 SCM scm_class_primitive_generic;
@@ -131,6 +133,8 @@ scm_init_deprecated_goops (void)
   scm_no_applicable_method =
     scm_variable_ref (scm_c_lookup ("no-applicable-method"));
 
+  var_get_keyword = scm_c_lookup ("get-keyword");
+
   scm_class_class = scm_variable_ref (scm_c_lookup ("<class>"));
   scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
   scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
@@ -192,6 +196,16 @@ scm_init_deprecated_goops (void)
   scm_smob_class = scm_i_smob_class;
 }
 
+SCM
+scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
+{
+  scm_c_issue_deprecation_warning
+    ("scm_get_keyword is deprecated.  Use `kw-arg-ref' from Scheme instead.");
+
+  return scm_call_3 (scm_variable_ref (var_get_keyword),
+                     kw, initargs, default_value);
+}
+
 #define BUFFSIZE 32		/* big enough for most uses */
 #define SPEC_OF(x) \
   (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 47264cc40..b731e0b84 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -211,6 +211,7 @@ SCM_INTERNAL void scm_init_deprecated_goops (void);
 SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method);
 SCM_DEPRECATED SCM scm_find_method (SCM l);
 SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots);
+SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value);
 
 
 
diff --git a/libguile/goops.c b/libguile/goops.c
index ce07686a2..1ea7a94f4 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -279,59 +279,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-/******************************************************************************
- *
- * initialize-object
- *
- ******************************************************************************/
-
-/*fixme* Manufacture keywords in advance */
-SCM
-scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr)
-{
-  long i;
-
-  for (i = 0; i != len; i += 2)
-    {
-      SCM obj = SCM_CAR (l);
-
-      if (!scm_is_keyword (obj))
-	scm_misc_error (subr, "bad keyword: ~S", scm_list_1 (obj));
-      else if (scm_is_eq (obj, key))
-	return SCM_CADR (l);
-      else
-	l = SCM_CDDR (l);
-    }
-
-  return default_value;
-}
-
-
-SCM_DEFINE (scm_get_keyword, "get-keyword", 3, 0, 0,
-	    (SCM key, SCM l, SCM default_value),
-	    "Determine an associated value for the keyword @var{key} from\n"
-	    "the list @var{l}.  The list @var{l} has to consist of an even\n"
-	    "number of elements, where, starting with the first, every\n"
-	    "second element is a keyword, followed by its associated value.\n"
-	    "If @var{l} does not hold a value for @var{key}, the value\n"
-	    "@var{default_value} is returned.")
-#define FUNC_NAME s_scm_get_keyword
-{
-  long len;
-
-  SCM_ASSERT (scm_is_keyword (key), key, SCM_ARG1, FUNC_NAME);
-  len = scm_ilength (l);
-  if (len < 0 || len % 2 == 1)
-    scm_misc_error (FUNC_NAME, "Bad keyword-value list: ~S", scm_list_1 (l));
-
-  return scm_i_get_keyword (key, l, len, default_value, FUNC_NAME);
-}
-#undef FUNC_NAME
-
-
-SCM_KEYWORD (k_init_keyword, "init-keyword");
-
-
 SCM_DEFINE (scm_sys_init_layout_x, "%init-layout!", 2, 0, 0,
 	    (SCM class, SCM layout),
 	    "")
diff --git a/libguile/goops.h b/libguile/goops.h
index f2655a81a..eec1973fa 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -133,9 +133,6 @@ SCM_API SCM scm_slot_ref (SCM obj, SCM slot_name);
 SCM_API SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value);
 
 SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
-SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
-				    SCM default_value, const char *subr);
-SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
 SCM_API SCM scm_sys_inherit_magic_x (SCM c, SCM dsupers);
 SCM_API SCM scm_instance_p (SCM obj);
 SCM_API int scm_is_generic (SCM x);