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 scm_t_bits 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 size_t
  29 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 ("callback", 0);
  44   scm_set_smob_mark (callback_tag, mark_smob);
  45   scm_set_smob_free (callback_tag, free_smob);
  46   scm_set_smob_print (callback_tag, print_smob);
  47   scm_set_smob_equalp (callback_tag, 0);
  48
  49   scm_c_define_gsubr ("c++-function?", 1, 0, 0,
  50                       (Scheme_function_unknown) cxx_function_type_p);
  51 }
  52
  53 SCM
  54 smobify_cxx_function (Cxx_function cb)
  55 {
  56   SCM z;
  57
  58   SCM_NEWCELL (z);
  59   SCM_SETCDR (z, (SCM)cb);
  60   SCM_SETCAR (z, (SCM)callback_tag);
  61
  62   return z;
  63 }
  64
  65
  66 Cxx_function
  67 unsmob_cxx_function (SCM x)
  68 {
  69
  70   if (SCM_NIMP (x) && SCM_CELL_TYPE (x) == callback_tag)
  71     return (Cxx_function) SCM_CELL_WORD_1 (x);
  72   else
  73     return 0;
  74 }
  75