lily/cxx-function-smob.cc

   1 /*
   2   grob-callback.cc --  implement Callback smob.
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2000--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "cxx-function-smob.hh"
  11 #include "ly-smobs.icc"
  12
  13 static long callback_tag;
  14
  15 static
  16 SCM mark_smob (SCM)
  17 {
  18   return SCM_EOL;
  19 }
  20
  21 static int
  22 print_smob (SCM, SCM port, scm_print_state *)
  23 {
  24   scm_puts ("#<encapsulated C++ function>", port);
  25   return 1;
  26 }
  27
  28 static
  29 scm_sizet free_smob (SCM)
  30 {
  31   return 0;
  32 }
  33
  34
  35 SCM
  36 cxx_function_type_p (SCM x)
  37 {
  38   return (SCM_CELL_TYPE (x) == callback_tag) ? SCM_BOOL_T : SCM_BOOL_F;
  39 }
  40
  41 void init_cxx_function_smobs ()
  42 {
  43   callback_tag = scm_make_smob_type_mfpe ("callback", 0,
  44                                           mark_smob, free_smob,
  45                                           print_smob, 0);
  46
  47   scm_make_gsubr ("c++-function?", 1, 0, 0, (Scheme_function_unknown) cxx_function_type_p);
  48 }
  49
  50 SCM
  51 smobify_cxx_function (Cxx_function cb)
  52 {
  53   SCM z;
  54
  55   SCM_NEWCELL (z);
  56   SCM_SETCDR (z, (SCM)cb);
  57   SCM_SETCAR (z, (SCM)callback_tag);
  58
  59   return z;
  60 }
  61
  62
  63 Cxx_function
  64 unsmob_cxx_function (SCM x)
  65 {
  66
  67   if (SCM_NIMP (x) && SCM_CELL_TYPE (x) == callback_tag)
  68     return (Cxx_function) SCM_CELL_WORD_1 (x);
  69   else
  70     return 0;
  71 }
  72